04_disp_slang.pm

   1 # s-lang output for DCT, by Shiar
   2
   3 # 1.12.0 200411032145 - define main loop
   4 #                     - use slang key reading functions
   5 # 1.11.0 200410291300 -
   6
   7 use strict;
   8 use warnings;
   9
  10 use Term::Slang qw(:all);
  11
  12 push @{$hook{init}}, sub {
  13         SLtt_get_terminfo and exit;
  14         SLang_init_tty(-1, 0, 1);
  15         SLsmg_init_smg;
  16
  17         END { SLsmg_reset_smg; SLang_reset_tty; } # shutdown display system
  18
  19         # where are $SLtt_Screen_Rows and $SLtt_Screen_Cols?
  20         ($set{height}, $set{width}) = SLtt_get_screen_size;
  21         $set{height} -= 2;
  22 }; # init
  23
  24 push @{$hook{showerror}}, sub {
  25         my $error = shift;
  26         SLsmg_draw_box(0, 0, 3, length($error)+4);
  27         SLsmg_gotorc(1, 1);
  28         SLsmg_write_string(" $error ");
  29         SLsmg_refresh;
  30
  31         SLang_getkey;  # wait for confirm
  32         SLang_getkey while SLang_input_pending(0)==1; # clear key buffer
  33 }; # showerror
  34
  35 push @{$hook{showstack}}, sub {
  36         for (0..@stack-1) {
  37                 SLsmg_gotorc($set{height}-$_, 1);
  38                 SLsmg_write_string("$_: ".showval($stack[$_], $set{base}));  # prompt
  39                 SLsmg_erase_eol;
  40         } # show stack
  41         SLsmg_gotorc($set{height}-@stack, 1);
  42         SLsmg_erase_eol;
  43 }; # showstack
  44
  45 push @{$hook{refresh}}, sub {
  46         SLsmg_cls;
  47         SLsmg_gotorc($set{height}+1, 0);
  48         SLsmg_write_string("> ");  # prompt
  49 }; # refresh
  50
  51 push @{$hook{showentry}}, sub {
  52         SLsmg_gotorc($set{height}+1, 2);
  53         SLsmg_write_string($_[0]);
  54         SLsmg_erase_eol;
  55         SLsmg_refresh;
  56 }; # showentry
  57
  58 $hook{main} = sub {
  59         while (1) {
  60                 draw();
  61
  62                 my $key = chr SLang_getkey;  # wait for user input
  63                 if ($key eq chr 27) {
  64                         $key .= chr SLang_getkey while SLang_input_pending(0)==1;  # read additional keys
  65                 } # escape sequence
  66 #               error(join " ", map ord, split //, $key); #debug
  67                 onkey($key);
  68         } # input loop
  69 }; # main
  70
  71 return {
  72         author  => "Shiar",
  73         title   => "slang output",
  74         version => "1.12",
  75 };
  76