#!/usr/bin/perl

use strict;
use warnings;

use Term::ReadKey;
use Curses;

initscr;
ReadMode 3;

my $height = $LINES-3;
my $width = 42; #COLS

my @stack;
my @val;
my $nopush; # 0=push and reset next; 1=reset next; 2=do nothing
my $base = 10;
my @menu;

INIT: {

@stack = ();
@val = (0, 0); # val, frac
$nopush = 1;

sub showval($$) {
	my ($val, $base) = @_;
	return $val if $base==10;

	my $int = int $val;
	my $frac = $val-$int;

	my $txt = '';
	while ($int>=1) {
		my $char = $int%$base;
		$txt = ($char<10 ? $char : chr($char+55)).$txt;
		$int /= $base;
	}

	$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);
	}

	return $txt;
} # showval

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

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

while (1) {
	addstr($height+1, 2, showval($val[0], $base));
	clrtoeol;
	refresh;

	$_ = ReadKey;
	if ($_ eq chr 27) {
		while (defined (my $key = ReadKey -1)) {
			$_ .= $key;
		} # read additional keys
	} # escape

	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();
	} # some operation

	else {
		print "\n* error: ", join(' ', map ord, split //, $_), "\n";
	}
} # input loop
}

ReadMode 0;
endwin;

