#!/usr/bin/perl

# DCT - desktop calculator thingy

# reverse polish notition calculator using curses
# 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 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

my %val = qw(i 0  frac 0);  # i, frac
my @stack;
my %var;

my %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
); # %set

#%alias = (' '=>'enter', "\004"=>'quit', 'q'=>'quit') unless %alias;  # rudimentary defaults

my @menu = @{$menus[0]};
my $menumin = 0;

my %action = (
	'more' => [-1, sub {
		$menumin += $set{menushow};
		$menumin = 0 if $menumin>=$#menu;
		showmenu();
	}], # tab
	'chs'  => [0, sub {$stack[0] = -$stack[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

	'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 {
		$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

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 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
} # error

sub showval($$);
sub showval($$) {
	my ($val, $base) = @_;
	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 = '';

	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<$set{width}-2 && $frac>0; $i++) {
		$frac *= $base;
		my $char = int $frac;
		$frac -= $char;
		$txt .= $char<10 ? $char : chr($char+55);
	} # fraction part

	$txt = "-".$txt if $sign;
	$txt .= 'e'.showval($exp, $base) if $exp;

	return $txt;
} # showval

sub showstack() {
	for (0..@stack-1) {
		addstr($set{height}-$_, 1, "$_: ".showval($stack[$_], $set{base}));
		clrtoeol;
	} # show stack
	clrtoeol($set{height}-$#stack-1, 1);
} # 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
	} # escape sequence

	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;
	} # refresh

	elsif (exists $val{bla} or /^[A-Z]$/) {
		if (defined $val{i}) {
			unshift @stack, $val{i};
			%val = (i=>undef, frac=>0);
			showstack();
		} # enter present value
		if ($_ eq "drop") {
			$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};
		$_ = -$_ if $val{i}<0;
		$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{$_} };
		if ($type>0 and defined $val{i}) {
			unshift @stack, $val{i};
			%val = (i=>undef, frac=>0);
		} # auto enter
		if ($type>0 and $type>@stack) {
			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

	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

	else {
		error("* unrecognised command: ".join(' ', map ord, split //, $_)." *");
		goto DRAW; # screen messed up
	} # error
} # input loop

