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 e88f6672702fb94b3161cf3278f73d43be3b38cd..8f94960af14927a24e17b0a85787fe1b5de0aef8 100644 (file)
--- a/05_disp_curses.pm
+++ b/03_disp_curses.pm
@@ -1,5 +1,6 @@
 # ncurses output for DCT, by Shiar
 
 # 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
 
 # 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 warnings;
 
 use Curses;

+use Term::ReadKey;

 
 push @{$hook{init}}, sub {
        initscr;
 
 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;
 
        $set{height} = $LINES-2 if $LINES>=3;
        $set{width} = $COLS if $COLS;


@@ -46,9 +53,22 @@ push @{$hook{showentry}}, sub {
        refresh;
 }; # showentry
 
        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",
 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 4fa569d2f04be14a62f3b9b205c5acf46d876001..90dccf6340747c1f3d5dce4a47577a8133cefa89 100644 (file)
--- a/06_disp_slang.pm
+++ b/04_disp_slang.pm
@@ -1,11 +1,13 @@
 # s-lang output for DCT, by Shiar
 
 # 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;
 
 # 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;
 
 push @{$hook{init}}, sub {
        SLtt_get_terminfo and exit;


@@ -26,8 +28,8 @@ push @{$hook{showerror}}, sub {
        SLsmg_write_string(" $error ");
        SLsmg_refresh;
 
        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 {
 }; # showerror
 
 push @{$hook{showstack}}, sub {


@@ -53,9 +55,22 @@ push @{$hook{showentry}}, sub {
        SLsmg_refresh;
 }; # showentry
 
        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",
 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 41614e1be994f2064e1ec6104d13c2fe0aac2947..07be1da3ab411396d5bf3e9ceadbaec7573f2fd3 100644 (file)
--- a/08_disp_stdout.pm
+++ b/05_disp_stdout.pm
@@ -1,5 +1,6 @@
 # console output for DCT, by Shiar
 
 # 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)
 # 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;
 
 use strict;
 use warnings;
 

-#return 0 if $set{display};
-#$set{display} = "stdout";
+use Term::ReadKey;

 
 push @{$hook{init}}, sub {
 
 push @{$hook{init}}, sub {

+       ReadMode 3;  # cbreak mode
+

 #      print "\ec";  # reset (clear screen, go home)
 #      print "\e[4mDCT $::VERSION\e[24m ";  # print intro (underlined)
 #      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};
 
        $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
 
        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",
 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 (file)
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 (file)
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 7af32dbb8cdf8f01ed4f71f064dc448e84630b4b..9ae8c03fdfbcecd0dcdfae39e21656cc2aefc3a8 100644 (file)
--- 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
 
 # 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;
 
 use strict;
 use warnings;
 

diff --git a/33_trig.pm b/33_trig.pm
index 7736e2d71d16089d61c088967206c8d8142ad915..fbfd46af7df57f460b85f8ddbb91bf8d7a348870 100644 (file)
--- a/33_trig.pm
+++ b/33_trig.pm
@@ -1,5 +1,6 @@
 # trigonometry for DCT, by Shiar
 
 # 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
 # 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),
        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",
 
 return {
        author  => "Shiar",
        title   => "trigonometry",

-       version => "1.11.1",
+       version => "1.11.2",

 };
 
 };
 

diff --git a/CHANGES b/CHANGES
index 2e8eefa07da18b1f28cd33d6e53e3fc9eb3777cc..396d6572768b99d0f5bceeb8a255334c2442a56d 100644 (file)
--- 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
 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 d2e411c64b36bdfc696ea29b08766ee1d507b62c..d871555a16e02c5b1981df664a974e035319a8a8 100755 (executable)
--- a/dct.pl
+++ b/dct.pl
@@ -10,18 +10,14 @@ use warnings;
 use utf8;
 
 use Data::Dumper;
 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);
 
 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
 
 %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
 
        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
 
 
 ); # %action
 
 

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

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


@@ -104,32 +102,14 @@ sub showval {
 } # 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;
        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});
 
        {
                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
                $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)
        $_ = 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}}) {
 
        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
 
        } # 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
 
                redraw(2);
        } # refresh
 


@@ -222,5 +201,32 @@ LOOP: while (1) {
                        . (m/^\w*$/ ? qq{"$_"} : join ' ', map ord, split //, $_)
                );
        } # error
                        . (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}->();