# 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
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;
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",
};
# 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;
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 {
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",
};
# 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)
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};
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",
};
--- /dev/null
+# 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",
+};
+
--- /dev/null
+# 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",
+};
+
# 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;
# 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
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",
};
+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
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
); # %action
+my $redraw = 2; # set flag to refresh whole screen
+
sub redraw($) {
# queue a redraw of level $_[0]
$redraw = $_[0] if $_[0]>$redraw;
} # 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});
$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
. (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}->();