From: Shiar <shiar@shiar.org>
Date: Thu, 4 Nov 2004 00:00:05 +0000 (+0100)
Subject: release 1.12.1
X-Git-Url: http://git.shiar.net/descalc.git/commitdiff_plain/4e1d9535fda6685e53ce570ca4e4cd6c260f55d3

release 1.12.1

- all I/O from main script; main loop defined in modules
- use readdir instead of glob (quite a bit faster)
- commandline arguments with leading - will skip modules of that name/group
---

diff --git a/05_disp_curses.pm b/03_disp_curses.pm
similarity index 69%
rename from 05_disp_curses.pm
rename to 03_disp_curses.pm
index e88f667..8f94960 100644
--- a/05_disp_curses.pm
+++ b/03_disp_curses.pm
@@ -1,5 +1,6 @@
 # ncurses output for DCT, by Shiar
 
+# 1.12.0 200410312200 - define main loop (get input from Term::ReadKey)
 # 1.11.0 200410152225 - uses class in filename instead of $set{display} check
 # 1.10.0 200410140120 - all output functions seperated from main
 
@@ -7,10 +8,16 @@ use strict;
 use warnings;
 
 use Curses;
+use Term::ReadKey;
 
 push @{$hook{init}}, sub {
 	initscr;
-	END { endwin; } # restore terminal on quit
+	ReadMode 3;  # cbreak mode
+
+	END {
+		ReadMode 0;
+		endwin;
+	} # restore terminal on quit
 
 	$set{height} = $LINES-2 if $LINES>=3;
 	$set{width} = $COLS if $COLS;
@@ -46,9 +53,22 @@ push @{$hook{showentry}}, sub {
 	refresh;
 }; # showentry
 
+$hook{main} = sub {
+	while (1) {
+		draw();
+
+		my $key = ReadKey;  # wait for user input
+		if ($key eq chr 27) {
+			$key .= $_ while defined ($_ = ReadKey(-1));  # read additional keys
+		} # escape sequence
+
+		onkey($key);
+	} # input loop
+}; # main
+
 return {
 	author  => "Shiar",
 	title   => "curses output",
-	version => "1.11",
+	version => "1.12",
 };
 
diff --git a/06_disp_slang.pm b/04_disp_slang.pm
similarity index 67%
rename from 06_disp_slang.pm
rename to 04_disp_slang.pm
index 4fa569d..90dccf6 100644
--- a/06_disp_slang.pm
+++ b/04_disp_slang.pm
@@ -1,11 +1,13 @@
 # s-lang output for DCT, by Shiar
 
+# 1.12.0 200411032145 - define main loop
+#                     - use slang key reading functions
 # 1.11.0 200410291300 - 
 
 use strict;
 use warnings;
 
-use Term::Slang qw(:common :screen :term :CONSTANTS);
+use Term::Slang qw(:all);
 
 push @{$hook{init}}, sub {
 	SLtt_get_terminfo and exit;
@@ -26,8 +28,8 @@ push @{$hook{showerror}}, sub {
 	SLsmg_write_string(" $error ");
 	SLsmg_refresh;
 
-	ReadKey; # wait for confirm
-	1 while defined ReadKey(-1); # clear key buffer
+	SLang_getkey;  # wait for confirm
+	SLang_getkey while SLang_input_pending(0)==1; # clear key buffer
 }; # showerror
 
 push @{$hook{showstack}}, sub {
@@ -53,9 +55,22 @@ push @{$hook{showentry}}, sub {
 	SLsmg_refresh;
 }; # showentry
 
+$hook{main} = sub {
+	while (1) {
+		draw();
+
+		my $key = chr SLang_getkey;  # wait for user input
+		if ($key eq chr 27) {
+			$key .= chr SLang_getkey while SLang_input_pending(0)==1;  # read additional keys
+		} # escape sequence
+#		error(join " ", map ord, split //, $key); #debug
+		onkey($key);
+	} # input loop
+}; # main
+
 return {
 	author  => "Shiar",
 	title   => "slang output",
-	version => "1.11",
+	version => "1.12",
 };
 
diff --git a/08_disp_stdout.pm b/05_disp_stdout.pm
similarity index 73%
rename from 08_disp_stdout.pm
rename to 05_disp_stdout.pm
index 41614e1..07be1da 100644
--- a/08_disp_stdout.pm
+++ b/05_disp_stdout.pm
@@ -1,5 +1,6 @@
 # console output for DCT, by Shiar
 
+# 1.12.0 200411032130 - handle input via Term::ReadKey; define main loop
 # 1.11.0 200410152225 - class in file name, so check is not needed anymore
 # 1.10.1 200410142200 - startup message omitted (now shown by main)
 # 1.10.0 200410140120 - never clear screen (just let it scroll)
@@ -10,13 +11,17 @@
 use strict;
 use warnings;
 
-#return 0 if $set{display};
-#$set{display} = "stdout";
+use Term::ReadKey;
 
 push @{$hook{init}}, sub {
+	ReadMode 3;  # cbreak mode
+
 #	print "\ec";  # reset (clear screen, go home)
 #	print "\e[4mDCT $::VERSION\e[24m ";  # print intro (underlined)
-	END { print "\n"; }
+	END {
+		ReadMode 0;
+		print "\n";
+	}
 
 	$set{height} = $ENV{LINES}-2 if $ENV{LINES} and $ENV{LINES}>=3;
 	$set{width} = $ENV{COLUMNS} if $ENV{COLUMNS};
@@ -37,9 +42,21 @@ push @{$hook{showentry}}, sub {
 	print "\e[3G\e[K", $_[0];  # cursor to column #3; erase line
 }; # showentry
 
+$hook{main} = sub {
+	while (1) {
+		draw();
+
+		my $key = ReadKey;  # wait for user input
+		if ($key eq chr 27) {
+			$key .= $_ while defined ($_ = ReadKey(-1));  # read additional keys
+		} # escape sequence
+		onkey($key);
+	} # input loop
+}; # main
+
 return {
 	author  => "Shiar",
 	title   => "console output",
-	version => "1.11",
+	version => "1.12",
 };
 
diff --git a/08_disp_tk.pm b/08_disp_tk.pm
new file mode 100644
index 0000000..918b77f
--- /dev/null
+++ b/08_disp_tk.pm
@@ -0,0 +1,102 @@
+# Tk I/O for DCT, by Shiar
+
+# not usable
+# 1.12.0 200410312115 - test
+
+use strict;
+use warnings;
+
+use Tk;
+use Term::ReadKey;
+
+my $main;
+
+push @{$hook{init}}, sub {
+	$main = new MainWindow;
+	$main->Label(-text=>"test")->pack;
+	ReadMode 3;  # cbreak mode
+
+	END {
+		ReadMode 0;
+	} # restore terminal on quit
+
+#	$set{height} = $LINES-2 if $LINES>=3;
+#	$set{width} = $COLS if $COLS;
+}; # init
+
+=cut
+push @{$hook{showerror}}, sub {
+	attron(A_REVERSE);
+	addstr(0, 0, shift);
+	attroff(A_REVERSE);
+	clrtoeol;
+	refresh;
+
+	ReadKey; # wait for confirm
+	1 while defined ReadKey(-1); # clear key buffer
+}; # showerror
+=cut
+
+push @{$hook{showstack}}, sub {
+	my $box = $main->Listbox(
+		-relief => 'sunken', 
+		-width => -1,  # shrink to fit
+		-height => 5,
+		-setgrid => 'yes',
+	);
+print Dumper \@stack;
+	for (0..@stack-1) {
+		$box->insert('end', "$_: ".showval($stack[$_], $set{base}));
+print $_;
+	}
+	$box->pack(-side => 'left', -fill => 'both', -expand => 'yes');
+#	for (0..@stack-1) {
+#		addstr($set{height}-$_, 1, "$_: ".showval($stack[$_], $set{base}));
+#		clrtoeol;
+#	} # show stack
+#	clrtoeol($set{height}-@stack, 1);
+}; # showstack
+
+push @{$hook{refresh}}, sub {
+#	clear;
+#	addstr($set{height}+1, 0, "> ");  # prompt
+	$main->Label(-text=>"> ")->pack;
+}; # refresh
+
+push @{$hook{showentry}}, sub {
+	$main->Label(-text=>$_[0])->pack;
+#	addstr($set{height}+1, 2, $_[0]);
+#	clrtoeol;
+#	refresh;
+}; # showentry
+
+$hook{main} = sub {
+	my $in = $main->Entry(-width=>10);
+	$in->pack;
+	$main->Button(
+		-text=>'test', 
+		-command => sub {
+			onkey($_) for split //, $in->get;
+			onkey("enter");
+		}
+	)->pack;
+
+	MainLoop;
+#	while (1) {
+#		draw();
+#
+#		my $key = ReadKey;  # wait for user input
+#		if ($key eq chr 27) {
+#			$key .= $_ while defined ($_ = ReadKey(-1));  # read additional keys
+#		} # escape sequence
+#
+#		onkey($key);
+#	} # input loop
+}; # main
+
+return {
+	author  => "Shiar",
+	title   => "tk output",
+	version => "1.12",
+};
+
diff --git a/09_disp_qt.pm b/09_disp_qt.pm
new file mode 100644
index 0000000..e055729
--- /dev/null
+++ b/09_disp_qt.pm
@@ -0,0 +1,111 @@
+# Qt I/O for DCT, by Shiar
+
+# just fiddling, long way from working
+# 1.12.0 200411032045 - test
+
+use strict;
+use warnings;
+
+use Qt;
+use Term::ReadKey;
+
+=cut
+my $main;
+
+push @{$hook{init}}, sub {
+	$main = new MainWindow;
+	$main->Label(-text=>"test")->pack;
+	ReadMode 3;  # cbreak mode
+
+	END {
+		ReadMode 0;
+	} # restore terminal on quit
+
+#	$set{height} = $LINES-2 if $LINES>=3;
+#	$set{width} = $COLS if $COLS;
+}; # init
+
+= cut
+push @{$hook{showerror}}, sub {
+	attron(A_REVERSE);
+	addstr(0, 0, shift);
+	attroff(A_REVERSE);
+	clrtoeol;
+	refresh;
+
+	ReadKey; # wait for confirm
+	1 while defined ReadKey(-1); # clear key buffer
+}; # showerror
+= cut
+
+push @{$hook{showstack}}, sub {
+	my $box = $main->Listbox(
+		-relief => 'sunken', 
+		-width => -1,  # shrink to fit
+		-height => 5,
+		-setgrid => 'yes',
+	);
+print Dumper \@stack;
+	for (0..@stack-1) {
+		$box->insert('end', "$_: ".showval($stack[$_], $set{base}));
+print $_;
+	}
+	$box->pack(-side => 'left', -fill => 'both', -expand => 'yes');
+#	for (0..@stack-1) {
+#		addstr($set{height}-$_, 1, "$_: ".showval($stack[$_], $set{base}));
+#		clrtoeol;
+#	} # show stack
+#	clrtoeol($set{height}-@stack, 1);
+}; # showstack
+
+push @{$hook{refresh}}, sub {
+#	clear;
+#	addstr($set{height}+1, 0, "> ");  # prompt
+	$main->Label(-text=>"> ")->pack;
+}; # refresh
+
+push @{$hook{showentry}}, sub {
+	$main->Label(-text=>$_[0])->pack;
+#	addstr($set{height}+1, 2, $_[0]);
+#	clrtoeol;
+#	refresh;
+}; # showentry
+=cut
+
+$hook{main} = sub {
+	my $a = Qt::Application;
+	my $hello = Qt::PushButton("Hello World!", undef);
+	$hello->show;
+	$a->setMainWidget($hello);	
+	exit $a->exec;
+
+=cut
+	my $in = $main->Entry(-width=>10);
+	$in->pack;
+	$main->Button(
+		-text=>'test', 
+		-command => sub {
+			onkey($_) for split //, $in->get;
+			onkey("enter");
+		}
+	)->pack;
+=cut
+
+#	while (1) {
+#		draw();
+#
+#		my $key = ReadKey;  # wait for user input
+#		if ($key eq chr 27) {
+#			$key .= $_ while defined ($_ = ReadKey(-1));  # read additional keys
+#		} # escape sequence
+#
+#		onkey($key);
+#	} # input loop
+}; # main
+
+return {
+	author  => "Shiar",
+	title   => "qt output",
+	version => "1.12",
+};
+
diff --git a/15_menu.pm b/15_menu.pm
index 7af32db..9ae8c03 100644
--- a/15_menu.pm
+++ b/15_menu.pm
@@ -9,6 +9,12 @@
 # 1.09.1 200410112150 - everything related to menus moved here
 # 1.06.1 200409152332 - moved @menus from 1.6 main
 
+#todo: merge basics back into main; i/o functions in display modules
+#      (menu can also be disabled at this level, without too high cost)
+#todo: always remember parent menus (so no need to store back-item (0)
+#      and ability to show higher levels)
+#todo: also store menu hash (to add additional items to a specific submenu)
+
 use strict;
 use warnings;
 
diff --git a/33_trig.pm b/33_trig.pm
index 7736e2d..fbfd46a 100644
--- a/33_trig.pm
+++ b/33_trig.pm
@@ -1,5 +1,6 @@
 # trigonometry for DCT, by Shiar
 
+# 1.11.2 200411032120 - check for menu module before addmenu()
 # 1.11.1 200410282330 - cardial mode setting; rad/deg to switch to radians/degrees
 #                     - convert from/to radians for trig commands if rad mode set
 # 1.11.0 200410152320 - a?(sin|cos|tan)h? actions from math; links in main submenu trig
@@ -51,11 +52,11 @@ addmenu(["main", 0], "trig", #todo: in math, not in main
 	qw(sin cos tan asin acos atan),
 	qw(sinh cosh tanh asinh acosh atanh),
 	qw(expm lnp1),
-);
+) if defined &addmenu;
 
 return {
 	author  => "Shiar",
 	title   => "trigonometry",
-	version => "1.11.1",
+	version => "1.11.2",
 };
 
diff --git a/CHANGES b/CHANGES
index 2e8eefa..396d657 100644
--- a/CHANGES
+++ b/CHANGES
@@ -1,3 +1,9 @@
+200411032300	1.12.1
+	- commandline arguments with leading - will skip modules of that name/group
+	- use readdir instead of glob (quite a bit faster)
+200410312300	1.12.0
+	- all I/O from main script; main loop defined in modules
+
 200410291000	1.11.2
 	- global redraw() to queue a stack/screen refresh
 200410282330	1.11.1
diff --git a/dct.pl b/dct.pl
index d2e411c..d871555 100755
--- a/dct.pl
+++ b/dct.pl
@@ -10,18 +10,14 @@ use warnings;
 use utf8;
 
 use Data::Dumper;
-use Term::ReadKey;
 
-our $VERSION = "1.11.2";
+our $VERSION = "1.12.1";
 
 use vars qw(@stack %val %set %alias %action %hook);
-my $redraw = 2;  # set flag to refresh whole screen
 
 %set = (
 	base     => 10,  # decimal; set using commands bin/oct/dec/hex/base
 #	numb     =>  0,  # fixed scientific engineering
-#	coord    =>  0,  # cartesian polar spherical
-#	complex  =>  0,  # real complex
 
 	height   =>  4,  # stack depth (lines of stack plus one)
 	width    => 42,  # limit value precision, stetch menu
@@ -56,6 +52,8 @@ my $redraw = 2;  # set flag to refresh whole screen
 ); # %action
 
 
+my $redraw = 2;  # set flag to refresh whole screen
+
 sub redraw($) {
 	# queue a redraw of level $_[0]
 	$redraw = $_[0] if $_[0]>$redraw;
@@ -104,32 +102,14 @@ sub showval {
 } # showval
 
 
-our %modules;
-for my $module (sort glob "*.pm") {
-	next unless $module =~ /^\d{2}_([a-z0-9-]+)(?:_(\w+))?\.pm$/;  # filename 00_class_name.pm
-	next if defined $modules{$1};  # no such module already loaded
-#	next if $1 eq "disp" and $2 eq "curses";
-	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
-
-printf STDERR "DCT %s by Shiar (%s)\n", $VERSION, join "; ",
-	map join(" ", grep $_, $_, $modules{$_}{name}, $modules{$_}{version}), keys %modules;
-
-ReadMode 3;  # cbreak mode
-END { ReadMode 0; } # restore terminal on quit
-
-$_->() for @{$hook{init}};
-
-LOOP: while (1) {
+sub draw {
 	if ($redraw) {
 		if ($redraw>1) {
 			$_->() for @{$hook{refresh}};
 		}
 		$_->() for @{$hook{showstack}};
 		$redraw = 0;
-	} # refresh
+	} # do necessary redrawing
 
 	{
 		my $entry = showval($val{i}, $set{base}, $val{ex});
@@ -137,21 +117,20 @@ LOOP: while (1) {
 		$entry .= $val{alpha} if exists $val{alpha};
 		$_->($entry) for @{$hook{showentry}};
 	} # show entry
+} # draw
 
-	my $key = ReadKey;  # wait for user input
-	if ($key eq chr 27) {
-		$key .= $_ while defined ($_ = ReadKey(-1));  # read additional keys
-	} # escape sequence
+sub onkey($) {
+	my $key = shift;
 	$_ = exists $alias{$key} ? $alias{$key} : $key;  # command (alias maps keys to commands)
-	$_ = delete $val{alpha} if $_ eq "enter" and exists $val{alpha};  # use manual command
+	$_ eq "enter" and exists $val{alpha} and $_ = delete $val{alpha};  # use manual command
 
 	for my $cmd (@{$hook{precmd}}) {
-		$cmd->() and next LOOP;  # command was handled by function if returns true
+		$cmd->() and return;  # command was handled by function if returns true
 	} # precmd functions
 
-	last if $_ eq 'quit';  # break out of loop
+	exit if $_ eq "quit";  # break out of loop
 
-	if ($_ eq 'refresh') {
+	if ($_ eq "refresh") {
 		redraw(2);
 	} # refresh
 
@@ -222,5 +201,32 @@ LOOP: while (1) {
 			. (m/^\w*$/ ? qq{"$_"} : join ' ', map ord, split //, $_)
 		);
 	} # error
-} # input loop
+} # 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}->();