usub/pager

   1 #!./curseperl
   2
   3 eval <<'EndOfMain';   $evaloffset = __LINE__;
   4
   5     $SIG{'INT'} = 'endit';
   6     $| = 1;             # command buffering on stdout
   7     &initterm;
   8     &inithelp;
   9     &slurpfile && &pagearray;
  10
  11 EndOfMain
  12
  13 &endit;
  14
  15 ################################################################################
  16
  17 sub initterm {
  18
  19     &initscr; &cbreak; &noecho; &scrollok($stdscr, 1);
  20     &defbell unless defined &bell;
  21
  22     $lines = $LINES; $lines1 = $lines - 1; $lines2 = $lines - 2;
  23     $cols = $COLS;   $cols1  = $cols  - 1; $cols2  = $cols  - 2;;
  24
  25     $dl = &getcap('dl');
  26     $al = &getcap('al');
  27     $ho = &getcap('ho');
  28     $ce = &getcap('ce');
  29 }
  30
  31 sub slurpfile {
  32     while (<>) {
  33         s/^(\t+)/'        ' x length($1)/e;
  34         &expand($_) if /\t/;
  35         if (length($_) < $cols) {
  36             push(@lines, $_);
  37         }
  38         else {
  39             while ($_ && $_ ne "\n") {
  40                 push(@lines, substr($_,0,$cols));
  41                 substr($_,0,$cols) = '';
  42             }
  43         }
  44     }
  45     1;
  46 }
  47
  48 sub drawscreen {
  49     &move(0,0);
  50     for ($line .. $line + $lines2) {
  51         &addstr($lines[$_]);
  52     }
  53     &clrtobot;
  54     &percent;
  55     &refresh;
  56 }
  57
  58 sub expand {
  59     while (($off = index($_[0],"\t")) >= 0) {
  60         substr($_[0], $off, 1) = ' ' x (8 - $off % 8);
  61     }
  62 }
  63
  64 sub pagearray {
  65     $line = 0;
  66
  67     $| = 1;
  68
  69     for (&drawscreen;;&drawscreen) {
  70
  71         $ch = &getch;
  72         $ch = 'j' if $ch eq "\n";
  73
  74         if ($ch eq ' ') {
  75             last if $percent >= 100;
  76             &move(0,0);
  77             $line += $lines1;
  78         }
  79         elsif ($ch eq 'b') {
  80             $line -= $lines1;
  81             &move(0,0);
  82             $line = 0 if $line < 0;
  83         }
  84         elsif ($ch eq 'j') {
  85             next if $percent >= 100;
  86             $line += 1;
  87             if ($dl && $ho) {
  88                 print $ho, $dl;
  89                 &mvcur(0,0,$lines2,0);
  90                 print $ce,$lines[$line+$lines2],$ce;
  91                 &wmove($curscr,0,0);
  92                 &wdeleteln($curscr);
  93                 &wmove($curscr,$lines2,0);
  94                 &waddstr($curscr,$lines[$line+$lines2]);
  95             }
  96             &wmove($stdscr,0,0);
  97             &wdeleteln($stdscr);
  98             &wmove($stdscr,$lines2,0);
  99             &waddstr($stdscr,$lines[$line+$lines2]);
 100             &percent;
 101             &refresh;
 102             redo;
 103         }
 104         elsif ($ch eq 'k') {
 105             next if $line <= 0;
 106             $line -= 1;
 107             if ($al && $ho && $ce) {
 108                 print $ho, $al, $ce, $lines[$line];
 109                 &wmove($curscr,0,0);
 110                 &winsertln($curscr);
 111                 &waddstr($curscr,$lines[$line]);
 112             }
 113             &wmove($stdscr,0,0);
 114             &winsertln($stdscr);
 115             &waddstr($stdscr,$lines[$line]);
 116             &percent;
 117             &refresh;
 118             redo;
 119         }
 120         elsif ($ch eq "\f") {
 121             &clear;
 122         }
 123         elsif ($ch eq 'q') {
 124             last;
 125         }
 126         elsif ($ch eq 'h') {
 127             &clear;
 128             &help;
 129             &clear;
 130         }
 131         else {
 132             &bell;
 133         }
 134     }
 135 }
 136
 137 sub defbell {
 138     eval q#
 139         sub bell {
 140             print "\007";
 141         }
 142     #;
 143 }
 144
 145 sub help {
 146     local(*lines) = *helplines;
 147     local($line);
 148     &pagearray;
 149 }
 150
 151 sub inithelp {
 152     @helplines = split(/\n/,<<'EOT');
 153
 154   h              Display this help.
 155   q              Exit.
 156
 157   SPACE          Forward  screen.
 158   b              Backward screen.
 159   j, CR          Forward  1 line.
 160   k              Backward 1 line.
 161   FF             Repaint screen.
 162 EOT
 163     for (@helplines) {
 164         s/$/\n/;
 165     }
 166 }
 167
 168 sub percent {
 169     &standout;
 170       $percent = int(($line + $lines1) * 100 / @lines);
 171       &move($lines1,0);
 172       &addstr("($percent%)");
 173     &standend;
 174     &clrtoeol;
 175 }
 176
 177 sub endit {
 178     &move($lines1,0);
 179     &clrtoeol;
 180     &refresh;
 181     &endwin;
 182
 183     if ($@) {
 184         print "";                               # force flush of stdout
 185         $@ =~ s/\(eval\)/$0/ && $@ =~ s/line (\d+)/'line ' . ($1 + $evaloffset)/e;
 186         die $@;
 187     }
 188
 189     exit;
 190 }