#!/usr/bin/perl

# descalc - desktop calculator

# simple modular reverse polish notition calculator
# by Shiar <shiar.org>

use strict;
use warnings;
use utf8;

use Data::Dumper;

our $VERSION = "1.14";


use vars qw(@stack %val %set %alias %action %hook @menu);

%set = (
	base     => 10,  # decimal; set using commands bin/oct/dec/hex/base
#	numb     =>  0,  # fixed scientific engineering

	height   =>  4,  # stack depth (lines of stack plus one)
	width    => 42,  # limit value precision, stetch menu
); # %set

%alias = (' '=>"enter", "\004"=>"quit");  # rudimentary default key bindings

%action = (
	"enter" => [ 0, sub {
		local $_ = defined $val{i} ? $val{i} : $stack[0];
		undef %val;
		return defined $_ ? $_ : ();
	}], # duplication

	"chs"   => [ 1, sub { -$_[0] }], # negative

	"drop"  => [ 1, sub { defined $val{i} ? '' : () }], # drop
	"back"  => [ 1, sub { () }], # drop essentially
	"clear" => [ 0, sub { @stack = (); undef %val; () }], # clear all

	"version" => [-2, sub {
		error("Desktop Calculator Thingy $VERSION by Shiar"); ()
	}], # version
); # %action

%hook = map {$_=>[]} qw(
	showerror showall showmenu showstack showentry
	postentry precmd postcmd preaction postaction init
);

my %redraw = (all=>1);  # set flag to refresh whole screen

my %menus = (
	main => [qw(0 prog> mode>mode)], # main
	mode => [qw(0 number_format angle_measure coord_system)], #1 mode
); # %menus

@menu = ($menus{main});  # current menu tree


sub redraw(%) {
	my %obj = @_;
	while (my ($obj, $level) = each %obj) {
		$redraw{$obj} = $level;# if $level>$redraw{$obj};
	} # queue redraw of given objects
} # redraw

sub error($) {
	$_->($_[0]) for @{$hook{showerror}};
	redraw(all=>1);
} # error

sub addmenu {
	my ($parent, $menuname) = (shift, shift);
	$menus{$menuname} = [0];  # create new menu
	push @{$menus{$parent}}, "$menuname>$menuname";  # link from parent
	ref $_ ? addmenu($menuname, @$_) : push @{$menus{$menuname}}, $_
		for @_;  # add menu items (which can be sub-submenus)
	return $menuname;
} # addmenu

sub showval;
sub showval {
	my ($val, $base, $baseexp) = @_;
	return '' unless defined $val;
	return $val if $base==10;  # perl can do the decimal values (much faster)

	$_ = '';  # string to output

	my $sign = $val<0 and $val = abs $val;
	my $int = int $val;

	my $exp = $val{ex} || 0;
	while ($int>$base**10) {
		$int /= $base;
		$exp++;
	} # exponent part

	my $frac = $val-$int;
	while ($int>=1) {
		my $char = $int%$base;
		$_ = ($char<10 ? $char : chr($char+55)) . $_;  # add digit [0-9A-Z]
		$int /= $base;
	} # integer part
	$_ .= '.' if $frac>0;
	for (my $i = 0; length $_<$set{width}-2 && $frac>0; $i++) {
		$frac *= $base;
		my $char = int $frac;
		$frac -= $char;
		$_ .= $char<10 ? $char : chr($char+55);
	} # fraction part

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

	return $_;
} # showval


sub draw {
	if (%redraw) {
		my @obj = qw(all menu stack);  # all possible redraw hooks
		@obj = grep $redraw{$_}, @obj  # keep stuff specified in %redraw
			unless $redraw{all};  # all keeps everything
		$_->() for map @{$hook{"show$_"}}, @obj;  # call show$obj hooks
		%redraw = ();
	} # do necessary redrawing (queued by &redraw)

	{
		my $entry = showval($val{i}, $set{base}, $val{ex});
		$entry .= $_->() for @{$hook{postentry}};  # additional text after val
		$entry .= $val{alpha} if exists $val{alpha};  # manual command
		$_->($entry) for @{$hook{showentry}};
	} # show entry
} # draw

sub onkey($) {
	my $key = shift;  # key pressed
	# command to run into $_ (alias maps keys to commands)
	$_ = exists $alias{$key} ? $alias{$key} : $key;
	# manual command entered - make that the new command
	$_ eq "enter" and exists $val{alpha} and $_ = delete $val{alpha};

	for my $cmd (@{$hook{precmd}}) {
		$cmd->() and return;  # command was handled by function if returns true
	} # precmd functions

	exit if $_ eq "quit";  # break out of loop

	if ($_ eq "refresh") {
		redraw(all=>1);
	} # refresh

	elsif (/^\033?[A-Z]$/ or exists $val{alpha}) {
		if (defined $val{i}) {
			unshift @stack, $val{i};
			undef %val;
			redraw(stack=>1);
		} # enter present value

		if ($_ eq "back") {
			$val{alpha} = substr $val{alpha}, 0, -1 or delete $val{alpha};
		} # backspace
		elsif ($_ eq "drop") {
			delete $val{alpha};
		} # drop
		else {
			$val{alpha} .= $key =~ /^\033(.)/ ? uc $1 : lc $key;
		} # add character
	} # manual command entry

	elsif (/^[\da-f]$/) {
		m/^[a-z]$/ and $_ = ord($_)-87;  # digit>9
		$val{i} = 0 unless defined $val{i};
		$_ = -$_ if $val{i}<0;  # substract from negative value
		$val{i} = ($val{frac} and $val{frac} *= 10)
			? $val{i}+$_/$val{frac}  # add digit to fraction
			: defined $val{ex}
				? $val{ex} = $val{ex}*$set{base}+$_  # digit to exponent
				: $val{i}*$set{base}+$_;  # add digit to integer part
	} # digit
	elsif ($_ eq '.') {
		$val{i} = 0 unless defined $val{i};
		$val{frac} = 1;
	} # decimal point
	elsif ($_ eq "eex") {
		$val{i} = 1 unless defined $val{i};
		$val{ex} = 0;
	} # exponent
	elsif ($_ eq "chs" and defined $val{i}) {
		$val{i} = -$val{i};
	} # change sign
	elsif ($_ eq "back" and defined $val{i}) {
		$val{i} = ($val{frac} and $val{frac} = int $val{frac}/10)
			? int($val{i}*$val{frac})/$val{frac}  # backspace fraction digit
			: int $val{i}/$set{base}  # backspace digit in integer part
	} # backspace

	elsif (/>([\w ]+)$/) {
		unshift @menu, $menus{$1};  # go to submenu
		redraw(menu=>1);
	} # goto submenu

	elsif (exists $action{$_}) {
		my ($action, $type, $cmd) = ($_, @{$action{$_}});
		unshift @stack, $action{enter}[1]->()
			if $type>0 and defined $val{i};  # auto enter

		if ($type>0 and $type>@stack) {
			error("insufficient stack arguments for operation");
			next;
		} # insufficient arguments

		$_->($type, $action) for @{$hook{preaction}};
		# put return value(s) of stack-modifying operations (type>=0) at stack
		$type<0 ? $cmd->() : unshift @stack, $cmd->(splice @stack, 0, $type);
		$_->($type, $action) for @{$hook{postaction}};

		redraw(stack=>1) if $type>=-1;  # redraw stack
	} # some operation

	else {
		$_ = m/^\w*$/ ? qq{"$_"} : join ' ', map ord, split //, $_;
		error("unrecognised command: $_");  # show string or character codes
	} # error
} # onkey


our %modules;  # loaded modules
{
	my %modskip;
	$modskip{substr $_, 1}++ for grep /^-/, @ARGV;

	require Cwd;
	our $path = Cwd::abs_path($0);  # resolve symlinks first
	    $path = substr($path, 0, rindex($path, '/')+1) || './';
	# or just use FindBin
	opendir my($moddir), $path;
	for my $module (sort readdir $moddir) { # glob "*.pm"
		$module =~ /^\d{2}_([a-z0-9-]+)(?:_(\w+))?\.pm$/ or next;
		# files named 00_class_name.pm; ($1, $2) = (class, name)
		next if exists $modskip{$1} or $2 && exists $modskip{$2};
		next if defined $modules{$1};  # no such module already loaded

#		defined ($_ = do $module)  # return value means no errors
#		? (ref $_ and $modules{$1} = $_, $modules{$1}{name} = $2 || "")
#		: print STDERR $@, "error loading $module\n\n";
		defined($_ = eval {do $path.$module})  # return value means no errors
		? (ref $_ and $modules{$1} = $_, $modules{$1}{name} = $2 || "")
		: print STDERR $@, "error loading $path$module\n";
	} # load modules
	closedir $moddir;
} # find external modules

printf STDERR "descalc %s by Shiar (%s)\n", $VERSION, join "; ",
	map join(" ", grep $_, $_, $modules{$_}{name}, $modules{$_}{version}),
	keys %modules;


$_->() for @{$hook{init}};
$menus{main}[10] = "quit";

$hook{main}->(); #todo: error if nothing loaded

