08_disp_tk.pm

   1 # Tk I/O for DCT, by Shiar
   2
   3 # not usable
   4 # 1.12.0 200410312115 - test
   5
   6 use strict;
   7 use warnings;
   8
   9 use Tk;
  10 use Term::ReadKey;
  11
  12 my $main;
  13
  14 push @{$hook{init}}, sub {
  15         $main = new MainWindow;
  16         $main->Label(-text=>"test")->pack;
  17         ReadMode 3;  # cbreak mode
  18
  19         END {
  20                 ReadMode 0;
  21         } # restore terminal on quit
  22
  23 #       $set{height} = $LINES-2 if $LINES>=3;
  24 #       $set{width} = $COLS if $COLS;
  25 }; # init
  26
  27 =cut
  28 push @{$hook{showerror}}, sub {
  29         attron(A_REVERSE);
  30         addstr(0, 0, shift);
  31         attroff(A_REVERSE);
  32         clrtoeol;
  33         refresh;
  34
  35         ReadKey; # wait for confirm
  36         1 while defined ReadKey(-1); # clear key buffer
  37 }; # showerror
  38 =cut
  39
  40 push @{$hook{showstack}}, sub {
  41         my $box = $main->Listbox(
  42                 -relief => 'sunken',
  43                 -width => -1,  # shrink to fit
  44                 -height => 5,
  45                 -setgrid => 'yes',
  46         );
  47 print Dumper \@stack;
  48         for (0..@stack-1) {
  49                 $box->insert('end', "$_: ".showval($stack[$_], $set{base}));
  50 print $_;
  51         }
  52         $box->pack(-side => 'left', -fill => 'both', -expand => 'yes');
  53 #       for (0..@stack-1) {
  54 #               addstr($set{height}-$_, 1, "$_: ".showval($stack[$_], $set{base}));
  55 #               clrtoeol;
  56 #       } # show stack
  57 #       clrtoeol($set{height}-@stack, 1);
  58 }; # showstack
  59
  60 push @{$hook{showall}}, sub {
  61 #       clear;
  62 #       addstr($set{height}+1, 0, "> ");  # prompt
  63         $main->Label(-text=>"> ")->pack;
  64 }; # showall
  65
  66 push @{$hook{showentry}}, sub {
  67         $main->Label(-text=>$_[0])->pack;
  68 #       addstr($set{height}+1, 2, $_[0]);
  69 #       clrtoeol;
  70 #       refresh;
  71 }; # showentry
  72
  73 $hook{main} = sub {
  74         my $in = $main->Entry(-width=>10);
  75         $in->pack;
  76         $main->Button(
  77                 -text=>'test',
  78                 -command => sub {
  79                         onkey($_) for split //, $in->get;
  80                         onkey("enter");
  81                 }
  82         )->pack;
  83
  84         MainLoop;
  85 #       while (1) {
  86 #               draw();
  87 #
  88 #               my $key = ReadKey;  # wait for user input
  89 #               if ($key eq chr 27) {
  90 #                       $key .= $_ while defined ($_ = ReadKey(-1));  # read additional keys
  91 #               } # escape sequence
  92 #
  93 #               onkey($key);
  94 #       } # input loop
  95 }; # main
  96
  97 return {
  98         author  => "Shiar",
  99         title   => "tk output",
 100         version => "1.12",
 101 };
 102