From 905da7ac2077425ebb7ed7507f2ae8d00f4a5beb Mon Sep 17 00:00:00 2001
From: Shiar <shiar@shiar.org>
Date: Sat, 25 Sep 2004 00:21:45 +0200
Subject: [PATCH] release 1.07

- menu contents in SDC::Menu module
- new commands: a?(sin|cos|tan)h, inv, !, rand
- x and v shortkeys

- 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 ( )
---
 sdc.pl | 227 +++++++++++++++++++++------------------------------------
 1 file changed, 83 insertions(+), 144 deletions(-)

diff --git a/sdc.pl b/sdc.pl
index 02ec1e3..f1692ed 100755
--- a/sdc.pl
+++ b/sdc.pl
@@ -1,13 +1,22 @@
 #!/usr/bin/perl
 
-### curses rpn desktop calculator ###
-
+### SDC - small desktop calculator ###
+# reverse polish notition calculator using curses
 # by Shiar <shiar.org>
 
-# 06-18       - start
-# 06-25       -
-# 08-04 14:45 - error dialog (don't mess up screen)
-# 09-10 19:45 - hp48-like drop (bs); argument checking; command backspacing
+# 1.01 06-18       - start
+# 1.03 06-25       -
+# 1.04 08-04 14:45 - error dialog (don't mess up screen)
+# 1.05 09-10 19:45 - hp48-like drop (backspace but not editing value)
+#                  - argument checking
+#                  - command backspacing
+# 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 ( )
 
 use strict;
 use warnings;
@@ -15,6 +24,7 @@ use utf8;
 
 use Term::ReadKey;
 use Curses;
+use SDC::Menu 1.006;
 
 initscr;
 ReadMode 3;  # cbreak mode
@@ -40,90 +50,6 @@ my %set = (
 	menushow => 12,
 ); # %set
 
-my @menus = (
-	[qw(refresh math>8 prog> mode>7 unit>11)],
-	[qw(main>0 log alog ln exp sin cos tan 0 asin acos atan)], #1 math
-	[qw(main>0 dec bin oct hex logic>3 bit>4)], #2 base
-	[qw(base>2 and or xor not)], #3 base logic
-	[qw(base>2 rl sl asr sr rr)], #4 base bit
-	[qw(base>2 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>2
-		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>12 area>13 volume>14 time>15 speed>16
-		mass>17 force>18 energy>19 power>20 pressure>21 temperature>22
-		electric_current>23 angle>24 light>25 radiation>26 viscosity>27
-	)], #11 units
-#		mm cm m in ft yd km mile mmile lt-yr mil Ang fermi rod fath)],
-	[qw(unit>11
-		_m _cm _mm _yd _ft _in _Mpc _pc _lyr _au _km _mi
-		_nmi _miUS _chain _rd _fath _ftUS _Mil _μ _Å _fermi
-	)], #12 length
-	[qw(unit>11
-		_m^2 _cm^2 _b _yd^2 _ft^2 _in^2
-		_km^2 _ha _a _mi^2 _miUS^2 _acre
-	)], #13 area
-	[qw(unit>11
-		_m^3 _st _cm^3 _yd^3 _ft^3 _in^3
-		_l _galUK _galC _gal _qt _pt
-		_ml _cu _ozfl _ozUK _tbsp _tsp
-		_bbl _bu _pk _fbm
-	)], #14 volume
-	[qw(unit>11
-		_yr _d _h _min _s _Hz
-	)], #15 time
-	[qw(unit>11
-		_m/s _cm/s _ft/s _kph _mph _knot
-		_c _ga
-	)], #16 speed
-	[qw(unit>11
-		_kg _g _Lb _oz _slug _lbt
-		_ton _tonUS _t _ozt _ct _grain
-		_u _mol
-	)], #17 mass
-	[qw(unit>11
-		_N _dyn _gf _kip _lbf _pdl
-	)], #18 force
-	[qw(unit>11
-		_J _erg _Kcal _Cal _Btu _ftxlbf
-		_therm _MeV _eV
-	)], #19 energy
-	[qw(unit>11
-		_W _hp
-	)], #20 power
-	[qw(unit>11
-		_Pa _atm _bar _psi _torr _mmHg
-		_inHg _inH2O
-	)], #21 pressure
-	[qw(unit>11
-	)], #22 temperature
-	[qw(unit>11
-	)], #23 electric_current
-	[qw(unit>11
-	)], #24 angle
-	[qw(unit>11
-	)], #25 light
-	[qw(unit>11
-	)], #26 radiation
-	[qw(unit>11
-	)], #27 viscosity
-
-
-
-); # @menus
 @menu = @{$menus[0]};
 $menumin = 0;
 
@@ -162,7 +88,7 @@ my %alias = (
 	chr 9 => 'more', # tab
 	'_'   => 'chs', # change sign; 48: y
 	'e'   => 'eex', # exponent; 48: z
-#	"\033\133\062\176" => 'swap', # ins
+	"\033\133\062\176" => 'eex', # ins
 	"\033\133\063\176" => "clear", # del
 	chr 127 => 'drop', # backspace
 	chr 8   => 'drop', # backspace
@@ -172,7 +98,7 @@ my %alias = (
 #	"\033\133\110" => 'refresh', # home
 
 #	"\033\133\101" => '', # up; 48: k (stack)
-#	"\033\133\104" => '', # left; 48: p (picture)
+	"\033\133\104" => 'undo', # left; 48: p (picture)
 #	"\033\133\102" => '', # down; 48: q (view)
 	"\033\133\103" => 'swap', # right; 48: r (swap)
 
@@ -180,20 +106,25 @@ my %alias = (
 	'|' => 'or',
 	'#' => 'xor',
 	'~' => 'not',
-
-	    "s" => 'sin',
-	"\033s" => 'asin',
-	    "c" => 'cos',
-	"\033c" => 'acos',
-	    "t" => 'tan',
-	"\033t" => 'atan',
-	    "l" => 'log',
-	"\033l" => 'alog',
-	    "n" => 'ln',
-	"\033n" => 'exp',
-	    "q" => 'sq',
-	"\033q" => 'sqrt',
-	"\033^" => 'xroot',
+	'(' => 'sl',
+	')' => 'sr',
+
+	    "s" => "sin",
+	"\033s" => "asin",
+	    "c" => "cos",
+	"\033c" => "acos",
+	    "t" => "tan",
+	"\033t" => "atan",
+	    "l" => "log",
+	"\033l" => "alog",
+	    "n" => "ln",
+	"\033n" => "exp",
+	    "q" => "sq",
+	"\033q" => "sqrt",
+	    "x" => "^",
+	"\033x" => "xroot",
+	"\033^" => "xroot",
+	    "v" => "inv",
 ); # %alias
 
 =cut
@@ -205,44 +136,25 @@ HP48 keys:
 =cut
 
 my %action = (
-	'more' => [0, sub {
+	'more' => [-1, sub {
 		$menumin += $set{menushow};
 		$menumin = 0 if $menumin>=$#menu;
 		showmenu();
 	}], # tab
-	'digit'=> [-2, sub { $val{i} = ($val{frac} *= 10) ? $val{i}+$_/$val{frac} : $val{i}*10+$_ }],
-	'.'    => [-2, sub { $val{frac} = 1 }], # decimal point
-	'eex'  => [-2, sub {}], # exponent
-	'chs'  => [0, sub {
-		if (defined $val{i}) {
-			$val{i} = -$val{i};
-		} else {
-			$stack[0] = -$stack[0];
-		}
-	}], # negative
+	'chs'  => [0, sub {$stack[0] = -$stack[0]}], # negative
 
-	'drop' => [0, sub {
-		if (defined $val{i}) {
-			$val{i} = ($val{frac} = int $val{frac}/10)
-				? int($val{i}*$val{frac})/$val{frac} : int $val{i}/10
-		} else {
-			shift @stack;
-		}
-	}], # backspace
-	'clear'=> [0, sub {
-		#todo: if (val{i}) delete char after cursor
-		@stack = (); %val = (i=>undef, frac=>0)
-	}], # clear all
+	'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
 
 	'enter'=> [0, sub {
-		unshift @stack, $val{i};
+		unshift @stack, defined $val{i} ? $val{i} : $stack[0];
 		%val = (i=>undef, frac=>0);
 	}], # duplication
 
 	'swap' => [1, sub {@stack[0, 1] = @stack[1, 0]}], # swap x<->y
 
 	'='    => [1, sub {$var{a} = $stack[0]}], # copy
-	'>'    => [1, sub {$var{a} = shift @stack}], # assign
+	'?'    => [1, sub {$var{a} = shift @stack}], # assign
 
 	'+'    => [2, sub {$stack[1] += shift @stack}], # addition
 	'-'    => [2, sub {$stack[1] -= shift @stack}], # substraction
@@ -250,6 +162,7 @@ my %action = (
 	'/'    => [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
@@ -269,6 +182,13 @@ my %action = (
 	'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}], # 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
@@ -277,6 +197,8 @@ my %action = (
 	'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
@@ -288,20 +210,19 @@ my %action = (
 	'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
+	'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
+
+	'undo' => [0, sub {@stack = @{ $var{undo} }}], # undo
 ); # %action
 
 my %unit;
@@ -444,18 +365,35 @@ while (1) {
 			showstack();
 		} # enter present value
 		if ($_ eq "drop") {
-			$val{bla} = substr $val{bla}, 0, -1;
+			$val{bla} = substr $val{bla}, 0, -1 or delete $val{bla};
 		} # backspace
 		else {
 			$val{bla} .= lc $_;
 		} # add character
 	} # manual command
 
+	elsif (/^\d$/) {
+		$val{i} = 0 unless defined $val{i};
+		$val{i} = ($val{frac} *= 10) ? $val{i}+$_/$val{frac} : $val{i}*10+$_;
+	}
+	elsif ($_ eq '.') {
+		$val{i} = 0 unless defined $val{i};
+		$val{frac} = 1;
+	} # decimal point
+	elsif ($_ eq 'eex') {
+		$val{i} = 1 unless defined $val{i};
+		#todo
+	} # exponent
+	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
+	} # backspace
+
 	elsif (exists $action{$_} or /^\d$/) {
-		my ($type, $cmd) = @{ $action{$_} || $action{digit} };
-		if ($type==-2) {
-			$val{i} = 0 unless defined $val{i};
-		} # modify value
+		my ($type, $cmd) = @{ $action{$_} };
 		if ($type>0 and defined $val{i}) {
 			unshift @stack, $val{i};
 			%val = (i=>undef, frac=>0);
@@ -464,6 +402,7 @@ while (1) {
 			error("* insufficient stack arguments for operation *");
 			goto DRAW;
 		} # insufficient arguments
+		$var{undo} = [@stack] if $type>=0 and $_ ne 'undo';
 		$cmd->();
 		showstack() if $type>=0;
 	} # some operation
-- 
2.30.0