added scrolling and color

diff --git a/Changes b/Changes
index e9b7a3886245918adf85590a318eef6fdd7d9d2c..824457049172dfb729473276db410bec4eed89af 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,7 @@
 28Jun99=======================================================================
 1. console.pl now works with history and editting.
+2. added scrolling to stuff sent by the cluster.
+3. added colours to things.
 27Jun99=======================================================================
 1. added WWV filtering
 2. added timeouts to for forwarding Messages, also added a waiting time for

diff --git a/perl/Console.pm b/perl/Console.pm
new file mode 100644 (file)
index 0000000..72c110e
--- /dev/null
+++ b/perl/Console.pm
@@ -0,0 +1,37 @@
+#
+# These are the default variables for the console program
+#
+# DON'T ALTER this file, copy it to ../local and alter that
+# instead. This file will be overwritten with new releases
+#
+# Copyright (c) 1999 Dirk Koopman G1TLH
+#
+# $Id$
+#
+# The colour pairs are:-
+#
+# 0 - $foreground, $background
+# 1 - RED, $background
+# 2 - BROWN, $background
+# 3 - GREEN, $background
+# 4 - CYAN, $background
+# 5 - BLUE, $background
+# 6 - MAGENTA, $background
+#
+
+package main;
+
+$maxkhist = 100;
+$maxshist = 500;
+$foreground = COLOR_BLACK();
+$background = A_BOLD|COLOR_WHITE();
+
+@colors = (
+                  [ '^DX de [\-\w]+:\s+(14[45]\d\d\d|5[01]\d\d\d)', COLOR_PAIR(1) ],
+                  [ '^DX', COLOR_PAIR(2) ],
+                  [ '^To', COLOR_PAIR(3) ],
+                  [ '^WWV', COLOR_PAIR(4) ],
+                  [ '^WX', COLOR_PAIR(5) ],
+);
+
+1; 

diff --git a/perl/console.pl b/perl/console.pl
index 429f5d36245be86a35880a477356a2c6f1ec6f19..b4fef51ad68ec56d5aca5c645a0de24a91501ac3 100755 (executable)
--- a/perl/console.pl
+++ b/perl/console.pl
@@ -33,6 +33,23 @@ use Curses;
 
 use Carp qw{cluck};
 
+use Console;
+
+#
+# initialisation
+#
+
+$call = "";                     # the callsign being used
+$conn = 0;                      # the connection object for the cluster
+$lasttime = time;               # lasttime something happened on the interface
+
+$connsort = "local";
+@khistory = ();
+@shistory = ();
+$khistpos = 0;
+$spos = $pos = $lth = 0;
+$inbuf = "";
+
 # cease communications
 sub cease
 {
@@ -42,15 +59,43 @@ sub cease
        }
        endwin();
        dbgclose();
-#      $SIG{__WARN__} = sub {my $a = shift; cluck($a); };
-       sleep(1);
+       print @_ if @_;
        exit(0);        
 }
 
 # terminate program from signal
 sub sig_term
 {
-       cease(1);
+       cease(1, @_);
+}
+
+# display the top screen
+sub show_screen
+{
+       my $p = $spos - $pages;
+       my $i;
+       $p = 0 if $p < 0;
+
+       $top->move(0, 0);
+       $top->attrset(COLOR_PAIR(0)) if $has_colors;
+       $top->clrtobot();
+       for ($i = 0; $i < $pages && $p < @shistory; $i++, $p++) {
+               my $line = $shistory[$p];
+               $line = substr($line, 0, COLS()) if length $line > COLS();
+               $top->move($i, 0);
+               if ($has_colors) {
+                       foreach my $ref (@colors) {
+                               if ($line =~ m{$$ref[0]}) {
+                                       $top->attrset($$ref[1]);
+                                       last;
+                               }
+                       }
+               }
+               $top->addstr($line);
+               $top->attrset(COLOR_PAIR(0)) if $has_colors;
+       }
+       $spos = $p;
+       $top->refresh();
 }
 
 # handle incoming messages
@@ -64,7 +109,10 @@ sub rec_socket
                my ($sort, $call, $line) = $msg =~ /^(\w)(\S+)\|(.*)$/;
                
                if ($sort eq 'D') {
-                       $top->addstr("\n$line");
+                       push @shistory, $line;
+                       shift @shistory if @shistory > $maxshist;
+                       $spos = @shistory if $spos >= @shistory - 1;
+                       show_screen();
                } elsif ($sort eq 'Z') { # end, disconnect, go, away .....
                        cease(0);
                }         
@@ -89,9 +137,9 @@ sub rec_stdin
                        
                        # save the lines
                        if ($inbuf) {
-                               push @history, $inbuf if $inbuf;
-                               shift @history if @history > $maxhist;
-                               $histpos = @history;
+                               push @khistory, $inbuf if $inbuf;
+                               shift @khistory if @khistory > $maxkhist;
+                               $khistpos = @khistory;
                                $bot->move(0,0);
                                $bot->clrtoeol();
                                $bot->addstr(substr($inbuf, 0, COLS));
@@ -102,22 +150,38 @@ sub rec_stdin
                        $conn->send_later("I$call|$inbuf");
                        $inbuf = "";
                        $pos = $lth = 0;
-               } elsif ($r eq KEY_UP || $r eq KEY_PPAGE || $r eq "\020") {
-                       if ($histpos > 0) {
-                               --$histpos;
-                               $inbuf = $history[$histpos];
+               } elsif ($r eq KEY_UP || $r eq "\020") {
+                       if ($khistpos > 0) {
+                               --$khistpos;
+                               $inbuf = $khistory[$khistpos];
                                $pos = $lth = length $inbuf;
                        } else {
                                beep();
                        }
-               } elsif ($r eq KEY_DOWN || $r eq KEY_NPAGE || $r eq "\016") {
-                       if ($histpos < @history - 1) {
-                               ++$histpos;
-                               $inbuf = $history[$histpos];
+               } elsif ($r eq KEY_DOWN || $r eq "\016") {
+                       if ($khistpos < @khistory - 1) {
+                               ++$khistpos;
+                               $inbuf = $khistory[$khistpos];
                                $pos = $lth = length $inbuf;
                        } else {
                                beep();
                        }
+               } elsif ($r eq KEY_PPAGE || $r eq "\026") {
+                       if ($spos > 0) {
+                               $spos -= $pages;
+                               $spos = 0 if $spos < 0;
+                               show_screen();
+                       } else {
+                               beep();
+                       }
+               } elsif ($r eq KEY_NPAGE || $r eq "\032") {
+                       if ($spos < @shistory - 1) {
+                               $spos += $pages;
+                               $spos = @shistory if $spos > @shistory;
+                               show_screen();
+                       } else {
+                               beep();
+                       }
                } elsif ($r eq KEY_LEFT || $r eq "\002") {
                        if ($pos > 0) {
                                --$pos;
@@ -183,21 +247,6 @@ sub rec_stdin
 }
 
 
-#
-# initialisation
-#
-
-$call = "";                     # the callsign being used
-$conn = 0;                      # the connection object for the cluster
-$lasttime = time;               # lasttime something happened on the interface
-
-$connsort = "local";
-@history = ();
-$histpos = 0;
-$maxhist = 100;
-$pos = $lth = 0;
-$inbuf = "";
-
 #
 # deal with args
 #
@@ -232,6 +281,19 @@ $SIG{'HUP'} = 'IGNORE';
 $scr = new Curses;
 raw();
 noecho();
+$has_colors = has_colors();
+
+if ($has_colors) {
+       start_color();
+       init_pair(0, $foreground, $background);
+       init_pair(1, COLOR_RED, $background);
+       init_pair(2, COLOR_YELLOW, $background);
+       init_pair(3, COLOR_GREEN, $background);
+       init_pair(4, COLOR_CYAN, $background);
+       init_pair(5, COLOR_BLUE, $background);
+       init_pair(6, COLOR_MAGENTA, $background);
+}
+
 $top = $scr->subwin(LINES()-4, COLS, 0, 0);
 $top->intrflush(0);
 $top->scrollok(1);
@@ -245,10 +307,11 @@ $scr->refresh();
 
 $SIG{__DIE__} = \&sig_term;
 
-$pages = LINES()-6;
+$pages = LINES()-4;
+my $dpages = $pages - 2;
 
 $conn->send_now("A$call|$connsort");
-$conn->send_now("I$call|set/page $pages");
+$conn->send_now("I$call|set/page $dpages");
 $conn->send_now("I$call|set/nobeep");
 
 Msg->set_event_handler(\*STDIN, "read" => \&rec_stdin);