From ca2e1ff106e7e71cca06067106f500313b18e669 Mon Sep 17 00:00:00 2001
From: Shiar <shiar@shiar.org>
Date: Wed, 4 Aug 2004 14:57:21 +0200
Subject: [PATCH] release 1.04

- error dialog (don't mess up screen)
- manual command input using capital letters
- ^L redraws screen
---
 sdc.pl | 428 ++++++++++++++++++++++++++++++++++-----------------------
 1 file changed, 257 insertions(+), 171 deletions(-)

diff --git a/sdc.pl b/sdc.pl
index 09541a0..c6a82af 100644
--- a/sdc.pl
+++ b/sdc.pl
@@ -1,5 +1,13 @@
 #!/usr/bin/perl
 
+### curses rpn desktop calculator ###
+
+# by Shiar <shiar.org>
+
+# 06-18       - start
+# 06-25       -
+# 08-04 14:45 - error dialog (don't mess up screen)
+
 use strict;
 use warnings;
 
@@ -9,34 +17,224 @@ use Curses;
 initscr;
 ReadMode 3;
 
-my $height = $LINES-3;
-my $width = 42; #COLS
+my $height = $LINES-3 || 4;
+my $width = $COLS || 42;
 
+my @val = (0, 0); # val, frac
+my $nopush = 1; # 0=push and reset next; 1=reset next; 2=do nothing
 my @stack;
-my @val;
-my $nopush; # 0=push and reset next; 1=reset next; 2=do nothing
-my $base = 10;
+my %var;
 my @menu;
+my %set = (
+	base  => 10,
+	numb  => 0, # fixed scientific engineering
+	card  => 1, # degrees radians grades
+	coord => 0, # cartesian polar spherical
+	complex => 0, # real complex
+	menushow => 12,
+); # %set
+
+my @menus = (
+	[qw(quit base>1 math>8 mode>7)],
+	[qw(main>0 dec bin oct hex logic>3 bit>4)], #1 base
+	[qw(main>0 log alog ln exp sin cos tan 0 asin acos atan)], #2 math
+	[qw(base>1 and or xor not)], #3 base logic
+	[qw(base>1 rl sl asr sr rr)], #4 base bit
+	[qw(base>1 rlb slb srb rrb)], #5 base byte
+	[qw(main>0 sq sqrt ^ xroot)], #6
+	[qw(main>0 number_format angle_measure coord_system)], #7 mode
+	[qw(main>0
+		vector> matrix> list> hyperbolic>9 real>10 base>1
+		probability> fft> complex> constants>
+	)], #8 math
+	[qw(math>8
+		sinh cosh tanh asinh acosh atanh
+		expm lnp1
+	)], #9 math hyperbolic
+	[qw(math>8
+		% %ch %t min max mod
+		abs sign mant xpon ip fp
+		rnd trnc floor ceil r>d d>r
+	)], #10 math real
+	[qw(main>0
+		tools> length> area> volume> time> speed>
+		mass> force> energy> power> pressure> temperature>
+		electric_current> angle> light> radiation> viscosity>
+	)], #11 units
+); # @menus
+@menu = @{$menus[0]};
+
+my %falias = (
+	"\033"                         =>  0, # esc
+	"\033\117\120"                 =>  1, # f1
+	"\033\133\061\061\176"         =>  1, # f1
+	"\033\117\121"                 =>  2, # f2
+	"\033\133\061\062\176"         =>  2, # f2
+	"\033\117\122"                 =>  3, # f3
+	"\033\133\061\063\176"         =>  3, # f3
+	"\033\117\123"                 =>  4, # f4
+	"\033\133\061\064\176"         =>  4, # f4
+	"\033\133\061\065\176"         =>  5, # f5
+	"\033\133\061\067\176"         =>  6, # f6
+	"\033\133\061\070\176"         =>  7, # f7
+	"\033\133\061\071\176"         =>  8, # f8
+	"\033\133\062\060\176"         =>  9, # f9
+	"\033\133\062\061\176"         => 10, # f10
+	"\033\133\062\063\176"         => 11, # f11/F1
+	"\033\133\062\064\176"         => 12, # f12/F2
+	"\033\133\062\065\176"         => 13, # F3
+	"\033\133\062\066\176"         => 14, # F4
+	"\033\133\062\070\176"         => 15, # F5
+	"\033\133\062\071\176"         => 16, # F6
+	"\033\133\063\061\176"         => 17, # F7
+	"\033\133\063\062\176"         => 18, # F8
+	"\033\133\063\063\176"         => 19, # F9
+	"\033\133\063\064\176"         => 20, # F10
+	"\033\133\062\063\073\062\176" => 21, # F11
+	"\033\133\062\064\073\062\176" => 22, # F12
+); # %falias
+
+my %alias = (
+	chr 4 => 'quit', # ^D
+	'q' => 'quit', # quit
+	'_' => 'chs', # change sign
+	'e' => 'eex', # exponent
+	"\033\133\062\176" => 'swap', # ins
+	chr(27).chr(91).chr(51).chr(126) => 'clx', # del
+	chr 127 => '<-', # backspace
+	chr 8 => '<-', # backspace
+	"\014" => 'refresh', # ^L
+	"\033\133\110" => 'refresh', # home
+
+	'&' => 'and',
+	'|' => 'or',
+	'#' => 'xor',
+	'~' => 'not',
+
+	        's' => 'sin',
+	chr(27).'s' => 'asin',
+	        'u' => 'cos',
+	chr(27).'u' => 'acos',
+	        't' => 'tan',
+	chr(27).'t' => 'atan',
+	        'l' => 'log',
+	chr(27).'l' => 'alog',
+	        'n' => 'ln',
+	chr(27).'n' => 'exp',
+	        'x' => 'xroot',
+
+); # %alias
 
-INIT: {
+my %action = (
+#	'digit' => [-2, sub {
+#		if ($val[1] *= 10) {
+#			$val[0] += $_/$val[1];
+#		} # fraction
+#		else {
+#			$val[0] = $val[0]*10+$_;
+#		} # integer
+#	}],
+	'digit'=> [-2, sub { $val[0] = ($val[1] *= 10) ? $val[0]+$_/$val[1] : $val[0]*10+$_ }],
+	'.'    => [-2, sub { $val[1] = 1 }], # decimal point
+	'eex'  => [-2, sub {}], # exponent
+	'chs'  => [1, sub {$val[0] = -$val[0]}], # negative
+
+	'<-'   => [-1, sub {
+		$val[0] = ($val[1] = int $val[1]/10)
+			? int($val[0]*$val[1])/$val[1] : int $val[0]/10
+	}], # backspace
+	'clx'  => [0, sub {@stack = (); @val = (0, 0); $nopush = 1}], # clear all
+
+	chr 13 => [0, sub {
+		unshift @stack, $val[0];
+		$nopush = 1;
+	}], # duplication
+
+	'swap' => [1, sub {($val[0], $stack[0]) = ($stack[0], $val[0])}], # swap x<->y
+
+	'='    => [1, sub {$var{a} = $val[0]}], # copy
+	'>'    => [1, sub {$var{a} = $val[0]; $val[0] = shift @stack}], # assign
+
+	'+'    => [2, sub {$val[0] += shift @stack}], # addition
+	'-'    => [2, sub {$val[0] = shift(@stack) - $val[0]}], # substraction
+	'*'    => [2, sub {$val[0] *= shift @stack}], # multiplication
+	'/'    => [2, sub {$val[0] = shift(@stack) / $val[0]}], # division
+	'mod'  => [2, sub {$val[0] = shift(@stack) % $val[0]}], # modulo
+
+	'sqrt' => [1, sub {$val[0] = sqrt $val[0]}], # square root
+	'sq'   => [1, sub {$val[0] *= $val[0]}], # squared
+	'^'    => [2, sub {$val[0] = shift(@stack) ** $val[0]}], # exponentiation
+	'xroot'=> [2, sub {$val[0] = shift(@stack) ** (1/$val[0])}], # x-root of y
+
+	'log'  => [1, sub {$val[0] = log($val[0]) / log(10)}], # logarithm
+	'alog' => [1, sub {$val[0] = 10 ** $val[0]}], # 10^x
+	'ln'   => [1, sub {$val[0] = log $val[0]}], # natural logaritm
+	'lnp1' => [1, sub {$val[0] = log($val[0]+1)}], # ln(x+1)
+	'exp'  => [1, sub {$val[0] = exp($val[0])}], # e^x
+	'expm' => [1, sub {$val[0] = exp($val[0])-1}], # exp(x)-1
+
+	'sin'  => [1, sub {$val[0] = sin $val[0]}], # sine
+	'asin' => [1, sub {$val[0] = atan2($val[0], sqrt(1 - $val[0]*$val[0]))}], # inverse sine
+	'cos'  => [1, sub {$val[0] = cos $val[0]}], # cosine
+	'acos' => [1, sub {$val[0] = atan2(sqrt(1 - $val[0]*$val[0]), $val[0])}], # inverse cosine
+	'tan'  => [1, sub {$val[0] = sin($val[0]) / cos($val[0])}], # tangent
+#	'atan' => [1, sub {}], # arctangent
+
+	'%'    => [2, sub {$val[0] /= shift(@stack)}], # percentage
+	'%ch'  => [2, sub {$val[0] = 100*(shift(@stack)-$val[0])/$val[0]}], # percentage change
+	'%t'   => [2, sub {$val[0] = 100*$val[0]/shift(@stack)}], # percentage total
+
+	'and'  => [2, sub {$val[0] = shift(@stack) & $val[0]}], # bitwise and
+	'or'   => [2, sub {$val[0] = shift(@stack) | $val[0]}], # bitwise or
+	'xor'  => [2, sub {$val[0] = shift(@stack) ^ $val[0]}], # bitwise xor
+	'not'  => [2, sub {$val[0] = ~$val[0]}], # bitwise not
+
+	'abs'  => [1, sub {$val[0] = abs $val[0]}], # absolute #todo
+	'sign' => [1, sub {$val[0] = $val[0] <=> 0}], # sign
+	'ip'   => [1, sub {$val[0] = int $val[0]}], # integer part
+	'fp'   => [1, sub {$val[0] -= int $val[0]}], # fractional part
+
+	'rnd'  => [1, sub {local $_ = 10**shift @stack; $val[0] = int(($val[0]+.5)*$_)/$_}], # round
+	'trnc' => [1, sub {local $_ = 10**shift @stack; $val[0] = int($val[0]*$_)/$_}], # truncate
+	'floor'=> [1, sub {$val[0] = int $val[0]}], # floor
+	'ceil' => [1, sub {$val[0] = int $val[0]+.9999}], # ceil
+
+	'min'  => [2, sub {
+		local $_ = shift @stack;
+		$val[0] = $_ if $_<$val[0];
+	}], # minimum
+	'max'  => [2, sub {
+		local $_ = shift @stack;
+		$val[0] = $_ if $_>$val[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
+	'base36' => [0, sub {$set{base} = 36}], # alphanumerical
+); # %action
 
-@stack = ();
-@val = (0, 0); # val, frac
-$nopush = 1;
 
+sub showval($$);
 sub showval($$) {
 	my ($val, $base) = @_;
 	return $val if $base==10;
 
 	my $int = int $val;
 	my $frac = $val-$int;
+	my $exp = 0;
 
 	my $txt = '';
+	while ($int>$base**10) {
+		$int /= $base;
+		$exp++;
+	} # exponent part
 	while ($int>=1) {
 		my $char = $int%$base;
 		$txt = ($char<10 ? $char : chr($char+55)).$txt;
 		$int /= $base;
-	}
+	} # integer part
 
 	$txt .= '.' if $frac>0;
 	for (my $i = 0; length $txt<$width-2 && $frac>0; $i++) {
@@ -44,148 +242,42 @@ sub showval($$) {
 		my $char = int $frac;
 		$frac -= $char;
 		$txt .= $char<10 ? $char : chr($char+55);
-	}
+	} # fraction part
+
+	$txt .= 'e'.showval($exp, $base) if $exp;
 
 	return $txt;
 } # showval
 
 sub showstack() {
 	for (0..@stack-1) {
-		addstr($height-$_, 1, "$_: ".showval($stack[$_], $base));
+		addstr($height-$_, 1, "$_: ".showval($stack[$_], $set{base}));
 		clrtoeol;
 	} # show stack
 	clrtoeol($height-$#stack-1, 1);
 } # showstack
 
-sub showmenu($) {
-	my @menus = ([qw(xroot log alog)], [qw(dec bin oct hex)]);
-	@menu = @{$menus[shift]};
-	attron(A_REVERSE);
-	addstr($height+2, $width/6*$_+1, join " ", $menu[$_]) for grep exists $menu[$_], 0..5;
-	attroff(A_REVERSE);
-	clrtoeol;
-	addstr($height+2, $width/6*$_, $_+1) for grep exists $menu[$_], 0..5;
+sub showmenu() {
+	clrtoeol($height+2, 1);
+	for (grep exists $menu[$_], 1..$set{menushow}) {
+		my $sub = (my $s = $menu[$_]) =~ s/>\d+$//;
+		addstr($height+2, $width/$set{menushow}*($_-1), $_);
+		attron(A_REVERSE);
+		addstr($s);
+		attroff(A_REVERSE);
+		addch('>') if $sub;
+	} # display menu txts
 } # showmenu
 
-my %falias = (
-	chr(27).chr(79).chr(80)                  =>  0, # F1
-	chr(27).chr(79).chr(81)                  =>  1, # F2
-	chr(27).chr(79).chr(82)                  =>  2, # F3
-	chr(27).chr(79).chr(83)                  =>  3, # F4
-	chr(27).chr(91).chr(49).chr(53).chr(126) =>  4, # F5
-	chr(27).chr(91).chr(49).chr(55).chr(126) =>  5, # F6
-	chr(27).chr(91).chr(49).chr(56).chr(126) =>  6, # F7
-	chr(27).chr(91).chr(49).chr(57).chr(126) =>  7, # F8
-	chr(27).chr(91).chr(50).chr(48).chr(126) =>  8, # F9
-	chr(27).chr(91).chr(50).chr(49).chr(126) =>  9, # F10
-	chr(27).chr(91).chr(50).chr(51).chr(126) => 10, # F11
-	chr(27).chr(91).chr(50).chr(52).chr(126) => 10, # F12
-); # %falias
-
-my %alias = (
-	q     => chr 4,   # quit
-	s     => 'sin',
-	c     => 'cos',
-	t     => 'tan',
-	l     => 'log',
-	x     => 'xroot',
-	chr 8 => chr 127, # backspace
-); # %alias
-
-my %action = (
-	chr 13 => sub {
-		unshift @stack, $stack[0];
-		$nopush = 1;
-	}, # duplication
-
-	'+' => sub {
-		$stack[1] += shift @stack;
-	}, # addition
-	'-' => sub {
-		$stack[1] -= shift @stack;
-	}, # substraction
-	'*' => sub {
-		$stack[1] *= shift @stack;
-	}, # multiplication
-	'/' => sub {
-		$stack[1] /= shift @stack;
-	}, # division
-	'%' => sub {
-		$stack[1] %= shift @stack;
-	}, # modulus
-
-	'^' => sub {
-		$stack[1] **= shift @stack;
-	}, # exponentiation
-	'xroot' => sub {
-		$stack[1] **= 1/shift @stack;
-	}, # x-root of y
-
-	'&' => sub {
-		$stack[1] &= shift @stack;
-	}, # bitwise and
-	'|' => sub {
-		$stack[1] |= shift @stack;
-	}, # bitwise or
-	'#' => sub {
-		$stack[1] ^= shift @stack;
-	}, # bitwise xor
-	'~' => sub {
-		unshift @stack, ~(shift @stack);
-	}, # bitwise not
-
-	'log' => sub {
-		unshift @stack, log shift @stack;
-	}, # logarithm
-	'alog' => sub {
-		unshift @stack, 10 ** shift @stack;
-	}, # 10^x
-
-	'sin' => sub {
-		unshift @stack, sin shift @stack;
-	}, # sine
-	'cos' => sub {
-		unshift @stack, cos shift @stack;
-	}, # cosine
-	'tan' => sub {
-		local $_ = shift @stack;
-		unshift @stack, sin($_) / cos($_);
-	}, # tangent
-
-	'abs' => sub {
-		unshift @stack, abs shift @stack;
-	}, # absolute
-	'_' => sub {
-		unshift @stack, -shift @stack;
-	}, # negative
-	'min' => sub {
-		local $_ = shift @stack;
-		$stack[1] = $_ if $_<$stack[1];
-	}, # minimum
-
-	'dec' => sub {
-		$base = 10;
-	}, # decimal
-	'bin' => sub {
-		$base = 2;
-	}, # binary
-	'oct' => sub {
-		$base = 8;
-	}, # octal
-	'hex' => sub {
-		$base = 16;
-	}, # hexadecimal
-	'base36' => sub {
-		$base = 36;
-	}, # alphanumerical
-); # %action
 
+DRAW:
 clear;
-showmenu(0);
+showmenu();
+showstack();
 addstr($height+1, 0, "> ");
 
 while (1) {
-	addstr($height+1, 2, showval($val[0], $base));
+	addstr($height+1, 2, showval($val[0], $set{base}));
 	clrtoeol;
 	refresh;
 
@@ -199,48 +291,42 @@ while (1) {
 	exists $alias{$_}  and $_ = $alias{$_};
 	exists $falias{$_} and $_ = $menu[$falias{$_}];
 
-	if ($_ eq chr 4) {
-		last INIT;
-	} # ^D
-	elsif ($_ eq chr 27) {
-		redo INIT;
-	} # escape
-
-	elsif (/^[\d.]$/) {
-		unshift @stack, $val[0] and showstack() unless $nopush;
-		@val = (0, 0) if $nopush<2; # replace current
-		$nopush = 2;
-		if ($_ eq '.') {
-			$val[1] = 1;
-		} # dot
-		elsif ($val[1] *= 10) {
-			$val[0] += $_/$val[1];
-		} # fraction
-		else {
-			$val[0] = $val[0]*10+$_;
-		} # integer
-	} # number
-	elsif ($_ eq chr 127) {
-		if ($val[1] = int $val[1]/10) {
-			$val[0] = int($val[0]*$val[1])/$val[1];
-		} else {
-			$val[0] = int $val[0]/10
-		}
-	} # backspace
-
-	elsif (exists $action{$_}) {
-		unshift @stack, $val[0];
-		$nopush = 0;
-		$action{$_}();
-		$val[0] = shift @stack;
-		showstack();
+	if (exists $action{$_} or /^\d$/) {
+		my ($type, $cmd) = @{ $action{$_} || $action{digit} };
+		if ($type==-2) {
+			unshift @stack, $val[0] and showstack() unless $nopush;
+			@val = (0, 0) if $nopush<2; # replace current
+			$nopush = 2;
+		} # modify value
+		$cmd->();
+		$nopush = 0 if $type>0;
+		showstack() if $type>=0;
 	} # some operation
 
+	elsif ($_ eq 'quit') {
+		last;
+	} # quit
+	elsif ($_ eq 'refresh') {
+		goto DRAW;
+	} # refresh
+
+	elsif (/>(\d+)$/) {
+		@menu = @{ $menus[$1] };
+		showmenu();
+	} # submenu
+
 	else {
-		print "\n* error: ", join(' ', map ord, split //, $_), "\n";
+		attron(A_REVERSE);
+		addstr($height+1, 0, "* error: ".join(' ', map ord, split //, $_)." *");
+		attroff(A_REVERSE);
+		clrtoeol;
+		refresh;
+
+		ReadKey; # wait for confirm
+		1 while defined (ReadKey -1); # clear key buffer
+		goto DRAW; # screen messed up
 	}
 } # input loop
-}
 
 ReadMode 0;
 endwin;
-- 
2.30.0