X-Git-Url: http://git.shiar.nl/descalc.git/blobdiff_plain/7db84757c6ba80836bc8c2cc9de326f16862a2cd..4e1d9535fda6685e53ce570ca4e4cd6c260f55d3:/08_disp_tk.pm

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",
+};
+