03_disp_slang.pm

   1 # s-lang output for DCT, by Shiar
   2
   3 # 1.14.0 200508261255 - SIGWINCH handler to redraw on screen resize
   4 # 1.13.0 200411042100 - menu i/o functions
   5 #                     - refresh hook renamed to showall
   6 # 1.12.0 200411032145 - define main loop
   7 #                     - use slang key reading functions
   8 # 1.11.0 200410291300 - basic output using Term::Slang (ported from Curses)
   9
  10 use strict;
  11 use warnings;
  12
  13 use Term::Slang qw(:all);
  14
  15 use vars qw(%falias $path);
  16 require $path."termcommon.pm";
  17
  18 sub setsize {
  19         ($set{height}, $set{width}) = @_;
  20         $set{height} -= 3;
  21         $set{menushow} = int($set{width}/(4+$set{width}/20))+1;  # menu items to show simultaneously
  22 } # setsize
  23
  24 push @{$hook{init}}, sub {
  25         SLtt_get_terminfo and exit;
  26         SLang_init_tty(-1, 0, 1);
  27         SLsmg_init_smg;
  28         SLtt_set_color(1, 0, 'black', 'lightgray');
  29
  30         END { SLsmg_reset_smg; SLang_reset_tty; } # shutdown display system
  31
  32         $SIG{WINCH} = sub {
  33                 #xxx: no signal until keypress?
  34                 setsize(SLtt_get_screen_size);  # get new screen size
  35                 SLsmg_reinit_smg;  # reinitialize to use new size
  36                 redraw(all=>1);  # queue complete refresh
  37                 draw();  # redraw rightnow
  38         }; # window change (resize)
  39
  40         # where are $SLtt_Screen_Rows and $SLtt_Screen_Cols?
  41         setsize(SLtt_get_screen_size);
  42 }; # init
  43
  44 push @{$hook{showerror}}, sub {
  45         my $error = shift;
  46         SLsmg_draw_box(0, 0, 3, length($error)+4);
  47         SLsmg_gotorc(1, 1);
  48         SLsmg_write_string(" $error ");
  49         SLsmg_refresh;
  50
  51         SLang_getkey;  # wait for confirm
  52         SLang_getkey while SLang_input_pending(0)==1; # clear key buffer
  53 }; # showerror
  54
  55 push @{$hook{showstack}}, sub {
  56         for (0..@stack-1) {
  57                 SLsmg_gotorc($set{height}-$_, 1);
  58                 SLsmg_write_string("$_: ".showval($stack[$_], $set{base}));  # prompt
  59                 SLsmg_erase_eol;
  60         } # show stack
  61         SLsmg_gotorc($set{height}-@stack, 1);
  62         SLsmg_erase_eol;
  63 }; # showstack
  64
  65 push @{$hook{showmenu}}, sub {
  66         SLsmg_gotorc($set{height}+2, 1);
  67         SLsmg_erase_eol;
  68         my $nr = -1;
  69         for (grep exists $menu[0][$_], $menu[0][0]+1..$menu[0][0]+$set{menushow}) {
  70                 $nr++;
  71                 next unless defined $menu[0][$_];
  72                 my $sub = (my $s = $menu[0][$_]) =~ s/>[\w ]+$//;
  73                 SLsmg_gotorc($set{height}+2, $set{width}/$set{menushow}*$nr);
  74                 SLsmg_write_string($_);
  75                 SLsmg_reverse_video; # reverse
  76                 SLsmg_write_string($s);
  77                 SLsmg_normal_video;
  78                 SLsmg_write_string('>') if $sub;  # indicate submenu
  79         } # display menu txts
  80 }; # showmenu
  81
  82 $action{more} = [-1, sub {
  83         $menu[0][0] += $set{menushow};
  84         $menu[0][0] = 0 if $menu[0][0] > @{$menu[0]};
  85         $_->() for @{$hook{showmenu}};
  86 }]; # tab
  87
  88 unshift @{$hook{precmd}}, sub {
  89         exists $falias{$_} or return;  # handle function key
  90         if ($falias{$_}==0) {
  91                 shift @menu if @menu>1;  # remove current submenu
  92                 redraw(menu=>1);
  93                 return 1;
  94         } # escape (go to parent)
  95         $_ = $menu[0][$falias{$_}] and return;  # execute found menu item instead
  96         error("no such menu entry");
  97         return 1;
  98 }; # precmd
  99
 100 push @{$hook{showall}}, sub {
 101         SLsmg_cls;
 102         SLsmg_gotorc($set{height}+1, 0);
 103         SLsmg_write_string("> ");  # prompt
 104 }; # showall
 105
 106 push @{$hook{showentry}}, sub {
 107         SLsmg_gotorc($set{height}+1, 2);
 108         SLsmg_write_string($_[0]);
 109         SLsmg_erase_eol;
 110         SLsmg_refresh;
 111 }; # showentry
 112
 113 $hook{main} = sub {
 114         while (1) {
 115                 draw();
 116
 117                 my $key = chr SLang_getkey;  # wait for user input
 118                 if ($key eq chr 27) {
 119                         $key .= chr SLang_getkey while SLang_input_pending(0)==1;  # read additional keys
 120                 } # escape sequence
 121 #               error(join " ", map ord, split //, $key); #debug
 122                 onkey($key);
 123         } # input loop
 124 }; # main
 125
 126 return {
 127         author  => "Shiar",
 128         title   => "slang output",
 129         version => "1.14",
 130 };
 131