backport mojo console.pl width/scolling changes

diff --git a/Changes b/Changes
index ef0d371c69e1c8a33761731577f0d05e5a26dc2e..1194b5dcd7b97a3fc86d5b658705ba1c06302ada 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,3 +1,5 @@
+08Dec21=======================================================================
+1. Backport console.pl scrolling and width management changes.
 06Dec21=======================================================================
 1. Fix show/register to allow query of individual calls as well as get a 
    complete list.

diff --git a/cmd/set/width.pl b/cmd/set/width.pl
new file mode 100644 (file)
index 0000000..27620c2
--- /dev/null
+++ b/cmd/set/width.pl
@@ -0,0 +1,13 @@
+#
+# set the page width for this invocation of the client
+#
+# Copyright (c) 2021 - Dirk Koopman G1TLH
+#
+#
+#
+my $self = shift;
+my $l = shift;
+$l = 80 if $l < 80;
+$self->width($l);
+$self->user->width($l);
+return (1, $self->msg('pagewidth', $l));

diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm
index a02edc9ee200c69c5624151dc52f4e278458cc7d..fedaee056d4815807f744748297b7b786f322300 100644 (file)
--- a/perl/DXChannel.pm
+++ b/perl/DXChannel.pm
@@ -159,12 +159,15 @@ sub alloc
                $user->new_buddies unless $user->buddies;
                $self->{group} = $user->group;
                $self->{sort} = $user->sort;
+               $self->{width} = $user->width;
        }
        $self->{startt} = $self->{t} = time;
        $self->{state} = 0;
        $self->{oldstate} = 0;
        $self->{lang} = $main::lang if !$self->{lang};
        $self->{func} = "";
+       $self->{width} ||=  80;
+       
 
        # add in all the dxcc, itu, zone info
        my @dxcc = Prefix::extract($call);

diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm
index 35c92341d17cbc896a0a64d6941e9a3d156dea77..c8decb72e1b3b5c39e34e2fd3f283d0f23741b54 100644 (file)
--- a/perl/DXCommandmode.pm
+++ b/perl/DXCommandmode.pm
@@ -960,29 +960,40 @@ sub format_dx_spot
 
        my $t = ztime($_[2]);
        my $loc = '';
-       my $clth = $self->{consort} eq 'local' ? 29 : 30;
+
+       my $clth = 30 + $self->{width} - 80;    # allow comment to grow according the screen width 
+       #       --$clth if $self->{consort} eq 'local';
+       
        my $comment = substr (($_[3] || ''), 0, $clth);
-       $comment .= ' ' x ($clth - length($comment));
-       if ($self->{user}->wantgrid) {
-               my $ref = DXUser::get_current($_[4]);
-               if ($ref) {
-                       $loc = $ref->qra || '';
-                       $loc = ' ' . substr($loc, 0, 4) if $loc;
+       $comment =~ s/\t/ /g;
+       
+       $comment .= ' ' x ($clth - (length($comment)));
+       
+    if ($self->{user}->wantgrid) {
+               my $ref = DXUser::get_current($_[1]);
+               if ($ref && $ref->qra) {
+                       my $cloc = ' ' . substr($ref->qra, 0, 4);
+                       $comment = substr $comment, 0,  ($clth - (length($comment)+length($cloc)));
+                       $comment .= $cloc;
                }
-       }
-
-       if ($self->{user}->wantdxitu) {
+               my $origin = $_[4];
+               $origin =~ s/-#$//;                     # sigh......
+               $ref = DXUser::get_current($origin);
+               if ($ref && $ref->qra) {
+                       $loc = ' ' . substr($ref->qra, 0, 4);
+               }
+       } elsif ($self->{user}->wantdxitu) {
                $loc = ' ' . sprintf("%2d", $_[10]) if defined $_[10];
-               $comment = substr($comment, 0,  $self->{consort} eq 'local' ? 26 : 27) . ' ' . sprintf("%2d", $_[8]) if defined $_[8]; 
+               $comment = substr($comment, 0,  $clth-3) . ' ' . sprintf("%2d", $_[8]) if defined $_[8]; 
        } elsif ($self->{user}->wantdxcq) {
                $loc = ' ' . sprintf("%2d", $_[11]) if defined $_[11];
-               $comment = substr($comment, 0,  $self->{consort} eq 'local' ? 26 : 27) . ' ' . sprintf("%2d", $_[9]) if defined $_[9]; 
+               $comment = substr($comment, 0, $clth-3) . ' ' . sprintf("%2d", $_[9]) if defined $_[9]; 
        } elsif ($self->{user}->wantusstate) {
                $loc = ' ' . $_[13] if $_[13];
-               $comment = substr($comment, 0,  $self->{consort} eq 'local' ? 26 : 27) . ' ' . $_[12] if $_[12]; 
+               $comment = substr($comment, 0,  $clth-3) . ' ' . $_[12] if $_[12]; 
        }
 
-       return sprintf "DX de %-7.7s%11.1f  %-12.12s %-s $t$loc", "$_[4]:", $_[0], $_[1], $comment;
+       return sprintf "DX de %-8.8s%10.1f  %-12.12s %-s $t$loc", "$_[4]:", $_[0], $_[1], $comment;
 }
 
 # send a dx spot

diff --git a/perl/DXUser.pm b/perl/DXUser.pm
index c611fac376ca54605fa6967dd6e43d87d68dc787..3ea1282379eedfde361913de7e50291928bb21e4 100644 (file)
--- a/perl/DXUser.pm
+++ b/perl/DXUser.pm
@@ -90,6 +90,7 @@ $v3 = 0;
                  believe => '1,Believable nodes,parray',
                  lastping => '1,Last Ping at,ptimelist',
                  maxconnect => '1,Max Connections',
+                 width => '0,Preferred Width',
                 );
 
 #no strict;

diff --git a/perl/Messages b/perl/Messages
index f7878eb1fc0a5c7afce1dd6ca26c313107298547..fddb29bcebde62cce48a0fa773aefe53ce9caf2e 100644 (file)
--- a/perl/Messages
+++ b/perl/Messages
@@ -243,6 +243,7 @@ package DXM;
                                outconn => 'Outstanding connect to $_[0]',
                                page => 'Press Enter to continue, A to abort ($_[0] lines) >',
                                pagelth => 'Page Length is now $_[0]',
+                               pagewidth => 'Page width is now $_[0] columns',
                                passerr => 'Please use: SET/PASS <password> <callsign>',
                                passphrase => 'Passphrase set or changed for $_[0]',
                                passphraseu => 'Passphrase removed for $_[0]',

diff --git a/perl/console.pl b/perl/console.pl
index 2c8c456bbfff35268d43fcb9e72d12b37f32132e..6651272460eeba69b7c01fe46583785fadafbf52 100755 (executable)
--- a/perl/console.pl
+++ b/perl/console.pl
@@ -51,12 +51,14 @@ use Console;
 #
 
 $call = "";                     # the callsign being used
+$node = "";                     # the node callsign being used
+
 $conn = 0;                      # the connection object for the cluster
 $lasttime = time;               # lasttime something happened on the interface
 
 $connsort = "local";
-@khistory = ();
-@shistory = ();
+@kh = ();
+@sh = ();
 $khistpos = 0;
 $spos = $pos = $lth = 0;
 $inbuf = "";
@@ -126,7 +128,8 @@ sub do_resize
        $cols = COLS;
        $has_colors = has_colors();
        do_initscr();
-
+       $inscroll = 0;
+       $spos = @sh < $pagel ? 0 :  @sh - $pagel;
        show_screen();
 }
 
@@ -160,70 +163,69 @@ sub setattr
        }
 }
 
-# measure the no of screen lines a line will take
-sub measure
-{
-       my $line = shift;
-       return 0 unless $line;
-
-       my $l = length $line;
-       my $lines = int ($l / $cols);
-       $lines++ if $l / $cols > $lines;
-       return $lines;
-}
 
 # display the top screen
 sub show_screen
-{
-       if ($spos == @shistory - 1) {
-
-               # if we really are scrolling thru at the end of the history
-               my $line = $shistory[$spos];
-               $top->addstr("\n") if $spos > 0;
-               setattr($line);
-               $top->addstr($line);
-#              $top->addstr("\n");
-               $top->attrset(COLOR_PAIR(0)) if $has_colors;
-               $spos = @shistory;
-               
-       } else {
+{      if ($inscroll) {
                
-               # anywhere else
+               dbg("B: s:$spos h:" . scalar @sh) if isdbg('console');
                my ($i, $l);
-               my $p = $spos-1;
-               for ($i = 0; $i < $pagel && $p >= 0; ) {
-                       $l = measure($shistory[$p]);
-                       $i += $l;
-                       $p-- if $i < $pagel;
-               }
-               $p = 0 if $p < 0;
-               
+
+               $spos = 0 if $spos < 0;
+               my $y = $spos;
                $top->move(0, 0);
                $top->attrset(COLOR_PAIR(0)) if $has_colors;
                $top->clrtobot();
-               for ($i = 0; $i < $pagel && $p < @shistory; $p++) {
-                       my $line = $shistory[$p];
-                       my $lines = measure($line);
-                       last if $i + $lines > $pagel;
-                       $top->addstr("\n") if $i;
+               for ($i = 0; $i < $pagel && $y < @sh; ++$y) {
+                       my $line = $sh[$y];
+                       my $lines = 1;
+                       $top->move($i, 0);
+                       dbg("C: s:$spos y:$i sh:" . scalar @sh . " l:" . length($line) . " '$line'") if isdbg('console');
                        setattr($line);
                        $top->addstr($line);
                        $top->attrset(COLOR_PAIR(0)) if $has_colors;
                        $i += $lines;
                }
-               $spos = $p;
-               $spos = @shistory if $spos > @shistory;
+               if ($y >= @sh) {
+                       $inscroll = 0;
+                       $spos = @sh;
+               }
+       }       elsif ($spos < @sh || $spos < $pagel) {
+               # if we really are scrolling thru at the end of the history
+               while ($spos < @sh) {
+                       my $line = $sh[$spos];
+                       my $y = $spos;
+                       if ($y >= $pagel) {
+                               $top->scrollok(1);
+                               $top->scrl(1);
+                               $top->scrollok(0);
+                               $y = $pagel-1;
+                       }
+                       $top->move($y, 0);
+                       dbg("A: s:$spos sh:" . scalar @sh . " y:$y l:" . length($line) . " '$line'") if isdbg('console');
+                       $top->refresh;
+                       setattr($line);
+                       $line =~ s/\n//s;
+                       $top->addstr($line);
+                       $top->attrset(COLOR_PAIR(0)) if $has_colors;
+                       ++$spos;
+               }
+               shift @sh while @sh > $maxshist;
+               $spos = @sh;
        }
-    my $shl = @shistory;
+
+       $top->refresh;
+    my $shl = @sh;
        my $size = $lines . 'x' . $cols . '-'; 
        my $add = "-$spos-$shl";
     my $time = ztime(time);
-       my $str =  "-" . $time . '-' x ($cols - (length($size) + length($call) + length($add) + length($time) + 1));
+       my $c = "$call\@$node";
+       my $str =  "-" . $time . '-' . ($inscroll ? 'S':'-') . '-' x ($cols - (length($size) + length($c) + length($add) + length($time) + 3));
        $scr->addstr($lines-4, 0, $str);
        
        $scr->addstr($size);
        $scr->attrset($mycallcolor) if $has_colors;
-       $scr->addstr($call);
+       $scr->addstr($c);
        $scr->attrset(COLOR_PAIR(0)) if $has_colors;
     $scr->addstr($add);
        $scr->refresh();
@@ -235,17 +237,20 @@ sub addtotop
 {
        while (@_) {
                my $inbuf = shift;
-               if ($inbuf =~ s/\x07+$//) {
-                       beep();
-               }
-               if (length $inbuf >= $cols) {
-                       $Text::Wrap::Columns = $cols;
-                       push @shistory, wrap('',"\t", $inbuf);
+               my $l = length $inbuf;
+               if ($l > $cols) {
+                       $inbuf =~ s/\s+/ /g;
+                       if (length $inbuf > $cols) {
+                               $Text::Wrap::columns = $cols;
+                               push @sh, split /\n/, wrap('',' ' x 19, $inbuf);
+                       } else {
+                               push @sh, $inbuf;
+                       }
                } else {
-                       push @shistory, $inbuf;
+                       push @sh, $inbuf;
                }
-               shift @shistory while @shistory > $maxshist;
        }
+#      shift @sh while @sh > $maxshist;
        show_screen();
 }
 
@@ -257,7 +262,14 @@ sub rec_socket
                cease(1);
        }
        if (defined $msg) {
-               my ($sort, $call, $line) = $msg =~ /^(\w)([^\|]+)\|(.*)$/;
+               my ($sort, $incall, $line) = $msg =~ /^(\w)([^\|]+)\|(.*)$/;
+               if ($line =~ s/\x07+$//) {
+                       beep();
+               }
+               $line =~ s/[\r\n]+//s;
+
+               # change my call if my node says "tonight Michael you are Jane" or something like that...
+               $call = $incall if $call ne $incall;
                
                $line =~ s/[\x00-\x06\x08\x0a-\x19\x1b-\x1f\x80-\x9f]/./g;         # immutable CSI sequence + control characters
                if ($sort && $sort eq 'D') {
@@ -266,6 +278,7 @@ sub rec_socket
                } elsif ($sort && $sort eq 'Z') { # end, disconnect, go, away .....
                        cease(0);
                }         
+               
                # ******************************************************
                # ******************************************************
                # any other sorts that might happen are silently ignored.
@@ -300,9 +313,9 @@ sub rec_stdin
                        if ($inbuf =~ /^!/o) {
                                my $i;
                                $inbuf =~ s/^!//o;
-                               for ($i = $#khistory; $i >= 0; $i--) {
-                                       if ($khistory[$i] =~ /^$inbuf/) {
-                                               $inbuf = $khistory[$i];
+                               for ($i = $#kh; $i >= 0; $i--) {
+                                       if ($kh[$i] =~ /^$inbuf/) {
+                                               $inbuf = $kh[$i];
                                                last;
                                        }
                                }
@@ -311,18 +324,20 @@ sub rec_stdin
                                        return;
                                }
                        }
-                       push @khistory, $inbuf if length $inbuf;
-                       shift @khistory if @khistory > $maxkhist;
-                       $khistpos = @khistory;
+                       push @kh, $inbuf if length $inbuf;
+                       shift @kh if @kh > $maxkhist;
+                       $khistpos = @kh;
                        $bot->move(0,0);
                        $bot->clrtoeol();
                        $bot->addstr(substr($inbuf, 0, $cols));
 
-                       # add it to the monitor window
-                       unless ($spos == @shistory) {
-                               $spos = @shistory;
+                       if ($inscroll && $spos < @sh) {
+                               $spos = @sh - $pagel;
+                               $inscroll = 0;
                                show_screen();
-                       };
+                       }
+
+                       # add it to the monitor window
                        addtotop($inbuf);
                
                        # send it to the cluster
@@ -332,42 +347,40 @@ sub rec_stdin
                } elsif ($r eq KEY_UP || $r eq "\020") {
                        if ($khistpos > 0) {
                                --$khistpos;
-                               $inbuf = $khistory[$khistpos];
+                               $inbuf = $kh[$khistpos];
                                $pos = $lth = length $inbuf;
                        } else {
                                beep();
                        }
                } elsif ($r eq KEY_DOWN || $r eq "\016") {
-                       if ($khistpos < @khistory - 1) {
+                       if ($khistpos < @kh - 1) {
                                ++$khistpos;
-                               $inbuf = $khistory[$khistpos];
+                               $inbuf = $kh[$khistpos];
                                $pos = $lth = length $inbuf;
                        } else {
                                beep();
                        }
                } elsif ($r eq KEY_PPAGE || $r eq "\032") {
-                       if ($spos > 0) {
-                               my ($i, $l);
-                               for ($i = 0; $i < $pagel-1 && $spos >= 0; ) {
-                                       $l = measure($shistory[$spos]);
-                                       $i += $l;
-                                       $spos-- if $i <= $pagel;
-                               }
+                       if ($spos > 0 && @sh > $pagel) {
+                               $spos -= $pagel+int($pagel/2); 
                                $spos = 0 if $spos < 0;
+                               $inscroll = 1;
                                show_screen();
                        } else {
                                beep();
                        }
                } elsif ($r eq KEY_NPAGE || $r eq "\026") {
-                       if ($spos < @shistory - 1) {
-                               my ($i, $l);
-                               for ($i = 0; $i <= $pagel && $spos <= @shistory; ) {
-                                       $l = measure($shistory[$spos]);
-                                       $i += $l;
-                                       $spos++ if $i <= $pagel;
-                               }
-                               $spos = @shistory if $spos >= @shistory - 1;
+                       if ($inscroll && $spos < @sh) {
+
+                               $spos += int($pagel/2);
+                               if ($spos > @sh - $pagel) {
+                                       $spos = @sh - $pagel;
+                               } 
                                show_screen();
+                               if ($spos >= @sh) {
+                                       $spos = @sh;
+                                       $inscroll = 0;
+                               }
                        } else {
                                beep();
                        }
@@ -415,8 +428,8 @@ sub rec_stdin
                        return;
                } elsif (defined $r && is_pctext($r)) {
                        # move the top screen back to the bottom if you type something
-                       if ($spos < @shistory) {
-                               $spos = @shistory;
+                       if ($spos < @sh) {
+                               $spos = @sh;
                                show_screen();
                        }
 
@@ -457,6 +470,8 @@ sub rec_stdin
 
 $call = uc shift @ARGV if @ARGV;
 $call = uc $myalias if !$call;
+$node = uc $mycall unless $node;
+
 my ($scall, $ssid) = split /-/, $call;
 $ssid = undef unless $ssid && $ssid =~ /^\d+$/;  
 if ($ssid) {
@@ -502,11 +517,11 @@ $SIG{__DIE__} = \&sig_term;
 
 $conn->send_later("A$call|$connsort width=$cols");
 $conn->send_later("I$call|set/page $maxshist");
-#$conn->send_later("I$call|set/nobeep");
+$conn->send_later("I$call|set/nobeep");
 
 #Msg->set_event_handler(\*STDIN, "read" => \&rec_stdin);
 
-$Text::Wrap::Columns = $cols;
+$Text::Wrap::columns = $cols;
 
 my $lastmin = 0;
 for (;;) {
@@ -523,8 +538,6 @@ for (;;) {
        }
        my $ch = $bot->getch();
        if (@time && tv_interval(\@time, [gettimeofday]) >= 1) {
-#              mydbg("Got Resize");
-#              do_resize();
                next;
        }
        if (defined $ch) {