06_disp_slang.pm

   1 # s-lang output for DCT, by Shiar
   2
   3 # 1.11.0 200410291300 -
   4
   5 use strict;
   6 use warnings;
   7
   8 use Term::Slang qw(:common :screen :term :CONSTANTS);
   9
  10 push @{$hook{init}}, sub {
  11         SLtt_get_terminfo and exit;
  12         SLang_init_tty(-1, 0, 1);
  13         SLsmg_init_smg;
  14
  15         END { SLsmg_reset_smg; SLang_reset_tty; } # shutdown display system
  16
  17         # where are $SLtt_Screen_Rows and $SLtt_Screen_Cols?
  18         ($set{height}, $set{width}) = SLtt_get_screen_size;
  19         $set{height} -= 2;
  20 }; # init
  21
  22 push @{$hook{showerror}}, sub {
  23         my $error = shift;
  24         SLsmg_draw_box(0, 0, 3, length($error)+4);
  25         SLsmg_gotorc(1, 1);
  26         SLsmg_write_string(" $error ");
  27         SLsmg_refresh;
  28
  29         ReadKey; # wait for confirm
  30         1 while defined ReadKey(-1); # clear key buffer
  31 }; # showerror
  32
  33 push @{$hook{showstack}}, sub {
  34         for (0..@stack-1) {
  35                 SLsmg_gotorc($set{height}-$_, 1);
  36                 SLsmg_write_string("$_: ".showval($stack[$_], $set{base}));  # prompt
  37                 SLsmg_erase_eol;
  38         } # show stack
  39         SLsmg_gotorc($set{height}-@stack, 1);
  40         SLsmg_erase_eol;
  41 }; # showstack
  42
  43 push @{$hook{refresh}}, sub {
  44         SLsmg_cls;
  45         SLsmg_gotorc($set{height}+1, 0);
  46         SLsmg_write_string("> ");  # prompt
  47 }; # refresh
  48
  49 push @{$hook{showentry}}, sub {
  50         SLsmg_gotorc($set{height}+1, 2);
  51         SLsmg_write_string($_[0]);
  52         SLsmg_erase_eol;
  53         SLsmg_refresh;
  54 }; # showentry
  55
  56 return {
  57         author  => "Shiar",
  58         title   => "slang output",
  59         version => "1.11",
  60 };
  61