X-Git-Url: http://git.shiar.net/descalc.git/blobdiff_plain/4e1d9535fda6685e53ce570ca4e4cd6c260f55d3:/dct.pl..090ac304afe801cb3e72ced0941ff2a874a98cc9:/descalc.pl

diff --git a/dct.pl b/descalc.pl
similarity index 56%
rename from dct.pl
rename to descalc.pl
index d871555..e3366e7 100755
--- a/dct.pl
+++ b/descalc.pl
@@ -1,6 +1,6 @@
 #!/usr/bin/perl
 
-# DCT - desktop calculator thingy
+# descalc - desktop calculator
 
 # simple modular reverse polish notition calculator
 # by Shiar <shiar.org>
@@ -11,9 +11,10 @@ use utf8;
 
 use Data::Dumper;
 
-our $VERSION = "1.12.1";
+our $VERSION = "1.14";
 
-use vars qw(@stack %val %set %alias %action %hook);
+
+use vars qw(@stack %val %set %alias %action %hook @menu);
 
 %set = (
 	base     => 10,  # decimal; set using commands bin/oct/dec/hex/base
@@ -38,39 +39,54 @@ use vars qw(@stack %val %set %alias %action %hook);
 	"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
 
+%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
 
-my $redraw = 2;  # set flag to refresh whole screen
 
-sub redraw($) {
-	# queue a redraw of level $_[0]
-	$redraw = $_[0] if $_[0]>$redraw;
+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(2);
+	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;
+	return $val if $base==10;  # perl can do the decimal values (much faster)
 
-	my $txt = '';
+	$_ = '';  # string to output
 
 	my $sign = $val<0 and $val = abs $val;
 	my $int = int $val;
@@ -84,45 +100,47 @@ sub showval {
 	my $frac = $val-$int;
 	while ($int>=1) {
 		my $char = $int%$base;
-		$txt = ($char<10 ? $char : chr($char+55)) . $txt;
+		$_ = ($char<10 ? $char : chr($char+55)) . $_;  # add digit [0-9A-Z]
 		$int /= $base;
 	} # integer part
-	$txt .= '.' if $frac>0;
-	for (my $i = 0; length $txt<$set{width}-2 && $frac>0; $i++) {
+	$_ .= '.' if $frac>0;
+	for (my $i = 0; length $_<$set{width}-2 && $frac>0; $i++) {
 		$frac *= $base;
 		my $char = int $frac;
 		$frac -= $char;
-		$txt .= $char<10 ? $char : chr($char+55);
+		$_ .= $char<10 ? $char : chr($char+55);
 	} # fraction part
 
-	$txt = "-".$txt if $sign;
-	$txt .= 'e'.showval($exp, $base) if $exp;
+	$_ = '-'.$_ if $sign;
+	$_ .= 'e'.showval($exp, $base) if $exp;
 
-	return $txt;
+	return $_;
 } # showval
 
 
 sub draw {
-	if ($redraw) {
-		if ($redraw>1) {
-			$_->() for @{$hook{refresh}};
-		}
-		$_->() for @{$hook{showstack}};
-		$redraw = 0;
-	} # do necessary redrawing
+	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}};
-		$entry .= $val{alpha} if exists $val{alpha};
+		$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;
-	$_ = 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
+	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
@@ -131,14 +149,14 @@ sub onkey($) {
 	exit if $_ eq "quit";  # break out of loop
 
 	if ($_ eq "refresh") {
-		redraw(2);
+		redraw(all=>1);
 	} # refresh
 
 	elsif (/^\033?[A-Z]$/ or exists $val{alpha}) {
 		if (defined $val{i}) {
 			unshift @stack, $val{i};
 			undef %val;
-			redraw(1);
+			redraw(stack=>1);
 		} # enter present value
 
 		if ($_ eq "back") {
@@ -158,8 +176,9 @@ sub onkey($) {
 		$_ = -$_ 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
+			: 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};
@@ -178,9 +197,15 @@ sub onkey($) {
 			: 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
+		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");
@@ -192,41 +217,49 @@ sub onkey($) {
 		$type<0 ? $cmd->() : unshift @stack, $cmd->(splice @stack, 0, $type);
 		$_->($type, $action) for @{$hook{postaction}};
 
-		redraw(1) if $type>=-1;  # redraw stack
+		redraw(stack=>1) if $type>=-1;  # redraw stack
 	} # some operation
 
 	else {
-		error(
-			"unrecognised command: "  # show string or character codes
-			. (m/^\w*$/ ? qq{"$_"} : join ' ', map ord, split //, $_)
-		);
+		$_ = m/^\w*$/ ? qq{"$_"} : join ' ', map ord, split //, $_;
+		error("unrecognised command: $_");  # show string or character codes
 	} # error
 } # onkey
 
 
-our %modules;
+our %modules;  # loaded modules
 {
 	my %modskip;
 	$modskip{substr $_, 1}++ for grep /^-/, @ARGV;
-	opendir my $moddir, ".";
+
+	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
+
+#		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 $module\n\n";
+		: print STDERR $@, "error loading $path$module\n";
 	} # load modules
 	closedir $moddir;
 } # find external modules
 
-printf STDERR "DCT %s by Shiar (%s)\n", $VERSION, join "; ",
+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}->();
+$hook{main}->(); #todo: error if nothing loaded