release 1.12.1
authorShiar <shiar@shiar.org>
Thu, 4 Nov 2004 00:00:05 +0000 (01:00 +0100)
committerShiar <shiar@shiar.org>
Thu, 10 Jul 2008 19:25:31 +0000 (21:25 +0200)
- 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

03_disp_curses.pm [moved from 05_disp_curses.pm with 69% similarity]
04_disp_slang.pm [moved from 06_disp_slang.pm with 67% similarity]
05_disp_stdout.pm [moved from 08_disp_stdout.pm with 73% similarity]
08_disp_tk.pm [new file with mode: 0644]
09_disp_qt.pm [new file with mode: 0644]
15_menu.pm
33_trig.pm
CHANGES
dct.pl

similarity index 69%
rename from 05_disp_curses.pm
rename to 03_disp_curses.pm
index e88f6672702fb94b3161cf3278f73d43be3b38cd..8f94960af14927a24e17b0a85787fe1b5de0aef8 100644 (file)
@@ -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",
 };
 
similarity index 67%
rename from 06_disp_slang.pm
rename to 04_disp_slang.pm
index 4fa569d2f04be14a62f3b9b205c5acf46d876001..90dccf6340747c1f3d5dce4a47577a8133cefa89 100644 (file)
@@ -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",
 };
 
similarity index 73%
rename from 08_disp_stdout.pm
rename to 05_disp_stdout.pm
index 41614e1be994f2064e1ec6104d13c2fe0aac2947..07be1da3ab411396d5bf3e9ceadbaec7573f2fd3 100644 (file)
@@ -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)
 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 (file)
index 0000000..918b77f
--- /dev/null
@@ -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
@@ -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",
+};
+
index 7af32dbb8cdf8f01ed4f71f064dc448e84630b4b..9ae8c03fdfbcecd0dcdfae39e21656cc2aefc3a8 100644 (file)
@@ -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;
 
index 7736e2d71d16089d61c088967206c8d8142ad915..fbfd46af7df57f460b85f8ddbb91bf8d7a348870 100644 (file)
@@ -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 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
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 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}->();