#!/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;
use utf8;

use Term::ReadKey;
use Curses;

initscr;
ReadMode 3;  # cbreak mode
END {
	ReadMode 0;
	endwin;
} # restore terminal on quit

my $height = $LINES<3 ? 4 : $LINES-3;  # stack depth (lines of stack plus one)
my $width = $COLS || 42;  # limit value precision, stetch menu

my %val = qw(i 0  frac 0);  # i, frac
my @stack;
my %var;
my @menu;
my $menumin;
my %set = (
	base     => 10,
	numb     =>  0,  # fixed scientific engineering
	card     =>  1,  # degrees radians grades
	coord    =>  0,  # cartesian polar spherical
	complex  =>  0,  # real complex
	menushow =>  6,
); # %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;

my %falias = (
	"\033"                         =>  0, # esc
	"\033\117\120"                 =>  1, # f1
	"\033\133\061\061\176"         =>  1, # f1
	"\033\133\061\062\176"         =>  2, # f2
	"\033\133\061\063\176"         =>  3, # f3
	"\033\133\061\064\176"         =>  4, # f4
	"\033\117\121"                 =>  2, # f2
	"\033\117\122"                 =>  3, # f3
	"\033\117\123"                 =>  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
	chr 9 => 'more', # tab
	'_' => 'chs', # change sign; 48: y
	'e' => 'eex', # exponent; 48: z
#	"\033\133\062\176" => 'swap', # ins
	chr(27).chr(91).chr(51).chr(126) => 'clear', # del
	chr 127 => 'drop', # backspace
	chr 8 => 'drop', # backspace
	chr 13 => ' ', # enter
	"\014" => 'refresh', # ^L
#	"\033\133\110" => 'refresh', # home

#	"\033\133\101" => '', # up; 48: k (stack)
#	"\033\133\104" => '', # left; 48: p (picture)
#	"\033\133\102" => '', # down; 48: q (view)
	"\033\133\103" => 'swap', # right; 48: r (swap)

	'&' => 'and',
	'|' => 'or',
	'#' => 'xor',
	'~' => 'not',

	        's' => 'sin',
	chr(27).'s' => 'asin',
	        'c' => 'cos',
	chr(27).'c' => 'acos',
	        't' => 'tan',
	chr(27).'t' => 'atan',
	        'l' => 'log',
	chr(27).'l' => 'alog',
	        'n' => 'ln',
	chr(27).'n' => 'exp',
	        'q' => 'sq',
	chr(27).'q' => 'sqrt',
	chr(27).'^' => 'xroot',
); # %alias

=cut
HP48 keys:
    S     T     U      V     W     X
 -  sin   cos   tan    sqrt  ^     1/x
 <  asin  acos  atan   sq    alog  exp
 >  [a]   ∫     ∑      xroot log   ln
=cut

my %action = (
	'more' => [0, 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

	'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

	' '    => [0, sub {
		unshift @stack, $val{i};
		%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

	'+'    => [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

	'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

	'%'    => [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

	'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

	'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
	'base36' => [0, sub {$set{base} = 36}], # alphanumerical
); # %action

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


sub showval($$);
sub showval($$) {
	my ($val, $base) = @_;
	return '' unless defined $val;
	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++) {
		$frac *= $base;
		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[$_], $set{base}));
		clrtoeol;
	} # show stack
	clrtoeol($height-$#stack-1, 1);
} # showstack

sub showmenu() {
	clrtoeol($height+2, 1);
	my $nr = 0;
	for (grep exists $menu[$_], $menumin+1..$menumin+$set{menushow}) {
		my $sub = (my $s = $menu[$_]) =~ s/>\d+$//;
		addstr($height+2, $width/$set{menushow}*($nr++), $_);
		attron(A_REVERSE);
		addstr($s);
		attroff(A_REVERSE);
		addch('>') if $sub;
	} # display menu txts
} # showmenu


DRAW:
clear;
showmenu();
showstack();
addstr($height+1, 0, "> ");

while (1) {
	addstr($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
	} # escape sequence

	exists $alias{$_}  and $_ = $alias{$_};
	exists $falias{$_} and $_ = $menu[$falias{$_}];

	$_ = delete $val{bla} if exists $val{bla} and $_ eq ' ';

	if ($_ eq 'quit') {
		last;
	} # quit
	elsif ($_ eq 'refresh') {
		goto DRAW;
	} # refresh

	elsif (/>(\d+)$/) {
		@menu = @{ $menus[$1] };
		$menumin = 0;
		showmenu();
	} # submenu

	elsif (exists $val{bla} or /^[A-Z]$/) {
		if (defined $val{i}) {
			unshift @stack, $val{i};
			%val = (i=>undef, frac=>0);
			showstack();
		}
		$val{bla} .= lc $_;
	} # manual command

	elsif (exists $action{$_} or /^\d$/) {
		my ($type, $cmd) = @{ $action{$_} || $action{digit} };
		if ($type==-2) {
			$val{i} = 0 unless defined $val{i};
		} # modify value
		if ($type>0 and defined $val{i}) {
			unshift @stack, $val{i};
			%val = (i=>undef, frac=>0);
		} # auto enter
		$cmd->();
		showstack() if $type>=0;
	} # some operation

	elsif ($_ =~ /^_/) {{
		$_ = $unit{substr $_, 1} or next;
		if (exists $val{unit} and $val{unit}{type}==$_->{type}) {
			unshift @stack, $val{i} and showstack() if defined $val{i};
			$stack[0] *= delete($val{unit})->{val} / $_->{val};
			%val = (i=>undef, frac=>0);
		} # convert
		else {
			$val{unit} = $_;
		} # set source unit
	}} # conversion

	else {
		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
	} # error
} # input loop

