#!/usr/bin/perl

# DCT - desktop calculator thingy

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

use strict;
use warnings;
use utf8;

use Data::Dumper;

our $VERSION = "1.12.1";

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

%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

	"swap"  => [ 2, sub { reverse @_ }], # swap x<->y
	"stack" => [-2, sub {
		my $stackpos if 0;
		$stackpos = 0 unless $stackpos;  # initialize
		$stackpos %= @stack;  # cycle
		$val{i} = $stack[$stackpos++];
	}], # stack

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


my $redraw = 2;  # set flag to refresh whole screen

sub redraw($) {
	# queue a redraw of level $_[0]
	$redraw = $_[0] if $_[0]>$redraw;
} # redraw

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

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

	my $txt = '';

	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;
		$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 draw {
	if ($redraw) {
		if ($redraw>1) {
			$_->() for @{$hook{refresh}};
		}
		$_->() for @{$hook{showstack}};
		$redraw = 0;
	} # do necessary redrawing

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

sub onkey($) {
	my $key = shift;
	$_ = exists $alias{$key} ? $alias{$key} : $key;  # command (alias maps keys to commands)
	$_ eq "enter" and exists $val{alpha} and $_ = delete $val{alpha};  # use manual command

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

	elsif (/^\033?[A-Z]$/ or exists $val{alpha}) {
		if (defined $val{i}) {
			unshift @stack, $val{i};
			undef %val;
			redraw(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 (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(1) if $type>=-1;  # redraw stack
	} # some operation

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


our %modules;
{
	my %modskip;
	$modskip{substr $_, 1}++ for grep /^-/, @ARGV;
	opendir my $moddir, ".";
	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";
	} # load modules
	closedir $moddir;
} # find external modules

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


$_->() for @{$hook{init}};

$hook{main}->();

