From 9e6322c41076ff462cb37416e28c3742567dc62a Mon Sep 17 00:00:00 2001 From: Dirk Koopman Date: Mon, 6 Jul 2020 17:20:32 +0100 Subject: [PATCH] backport console.pl from users.v3j --- Changes | 2 + perl/Console.pm | 4 +- perl/console.pl | 365 ++++++++++++++++++++++++++++-------------------- 3 files changed, 219 insertions(+), 152 deletions(-) diff --git a/Changes b/Changes index 5aac43e9..ef150a2a 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,5 @@ +06Jul20======================================================================= +1. Update console.pl (dx) to improve scrolling as keyboard speed. 05Jul20======================================================================= 1. Fix show/dxcc. 17Jun20======================================================================= diff --git a/perl/Console.pm b/perl/Console.pm index f1cefa49..9dfacfb6 100644 --- a/perl/Console.pm +++ b/perl/Console.pm @@ -41,7 +41,7 @@ if ($ENV{'TERM'} =~ /(xterm|ansi)/) { @colors = ( [ '^[-A-Z0-9]+ de [-A-Z0-9]+ \d\d-\w\w\w-\d\d\d\d \d\d\d\dZ', COLOR_PAIR(0) ], [ '^DX de [\-A-Z0-9]+:\s+([57][01]\d\d\d\.|\d\d\d\d\d\d+.)', COLOR_PAIR(1) ], - [ '^RB de', COLOR_PAIR(2) ], + [ '-#', COLOR_PAIR(2) ], [ '^To', COLOR_PAIR(3) ], [ '^WX', COLOR_PAIR(3) ], [ '^(?:WWV|WCY)', COLOR_PAIR(4) ], @@ -57,7 +57,7 @@ if ($ENV{'TERM'} =~ /(console|linux)/) { $mycallcolor = COLOR_PAIR(1); @colors = ( [ '^DX de [\-A-Z0-9]+:\s+([57][01]\d\d\d\.|\d\d\d\d\d\d+.)', COLOR_PAIR(1) ], - [ '^RN de', COLOR_PAIR(2) ], + [ '^-#:', COLOR_PAIR(2) ], [ '^DX', COLOR_PAIR(4) ], [ '^To', COLOR_PAIR(3) ], [ '^(?:WWV|WCY)', COLOR_PAIR(5) ], diff --git a/perl/console.pl b/perl/console.pl index cd4a4492..2a88f5b5 100755 --- a/perl/console.pl +++ b/perl/console.pl @@ -43,7 +43,7 @@ use DXDebug; use IO::File; use Time::HiRes qw(gettimeofday tv_interval); use Curses 1.06; -use Text::Wrap; +use Text::Wrap qw(wrap); use Console; @@ -52,27 +52,23 @@ 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 = (); -$khistpos = 0; +@kh = (); +@sh = (); +$kpos = 0; $spos = $pos = $lth = 0; $inbuf = ""; -@time = (); $lastmin = 0; $idle = 0; - +$inscroll = 0; #$SIG{WINCH} = sub {@time = gettimeofday}; -sub mydbg -{ - local *STDOUT = undef; - dbg(@_); -} +$DXDebug::no_stdout = 1; # do the screen initialisation sub do_initscr @@ -80,7 +76,7 @@ sub do_initscr $scr = new Curses; if ($has_colors) { start_color(); - init_pair("0", $foreground, $background); + init_pair(0, $foreground, $background); # init_pair(0, $background, $foreground); init_pair(1, COLOR_RED, $background); init_pair(2, COLOR_YELLOW, $background); @@ -101,25 +97,29 @@ sub do_initscr $top = $scr->subwin($lines-4, $cols, 0, 0); $top->intrflush(0); - $top->scrollok(1); + $top->scrollok(0); $top->idlok(1); $top->meta(1); -# $scr->addstr($lines-4, 0, '-' x $cols); + $top->leaveok(1); + $top->clrtobot(); +# $top->setscrreg(0, $lines-5); + $bot = $scr->subwin(3, $cols, $lines-3, 0); $bot->intrflush(0); $bot->scrollok(1); - $top->idlok(1); $bot->keypad(1); $bot->move(1,0); $bot->meta(1); $bot->nodelay(1); + $bot->clrtobot(); $scr->refresh(); + $pagel = $lines-4; $mycallcolor = COLOR_PAIR(1) unless $mycallcolor; } -sub do_resize +sub doresize { endwin() if $scr; initscr(); @@ -131,6 +131,8 @@ sub do_resize $has_colors = has_colors(); do_initscr(); + $inscroll = 0; + $spos = @sh < $pagel ? 0 : @sh - $pagel; show_screen(); } @@ -179,116 +181,84 @@ sub measure # 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; + if ($inscroll) { - } else { - - # 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; - +# for ($i = 0; $i < $pagel && $p >= 0; ) { +# $l = measure($sh[$p]); +# $i += $l; +# $p-- if $i < $pagel; + # } + + $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 = measure($line); + 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(); # $top->refresh(); } -# add a line to the end of the top screen -sub addtotop -{ - while (@_) { - my $inbuf = shift; - if ($inbuf =~ s/\x07+$//) { - beep(); - } - if (length $inbuf >= $cols) { - $Text::Wrap::Columns = $cols; - push @shistory, wrap('',"\t", $inbuf); - } else { - push @shistory, $inbuf; - } - shift @shistory while @shistory > $maxshist; - } - show_screen(); -} - -# handle incoming messages -sub rec_socket -{ - my ($con, $msg, $err) = @_; - if (defined $err && $err) { - cease(1); - } - if (defined $msg) { - my ($sort, $incall, $line) = $msg =~ /^(\w)([^\|]+)\|(.*)$/; - - # 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') { - $line = " " unless length($line); - addtotop($line); - } elsif ($sort && $sort eq 'Z') { # end, disconnect, go, away ..... - cease(0); - } - # ****************************************************** - # ****************************************************** - # any other sorts that might happen are silently ignored. - # ****************************************************** - # ****************************************************** - } else { - cease(0); - } - $top->refresh(); - $lasttime = time; -} - sub rec_stdin { - my $r = shift;; + my $r = shift; + dbg("KEY: " . unpack("H*", $r). " '$r'") if isdbg('console'); + # my $prbuf; # $prbuf = $buf; # $prbuf =~ s/\r/\\r/; @@ -297,7 +267,7 @@ sub rec_stdin if (defined $r) { $r = '0' if !$r; - + if ($r eq KEY_ENTER || $r eq "\n" || $r eq "\r") { # save the lines @@ -307,9 +277,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; } } @@ -318,18 +288,24 @@ 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; + $kpos = @kh; $bot->move(0,0); $bot->clrtoeol(); $bot->addstr(substr($inbuf, 0, $cols)); # add it to the monitor window - unless ($spos == @shistory) { - $spos = @shistory; +# unless ($spos == @sh) { +# $spos = @sh; +# show_screen(); +# } + if ($inscroll && $spos < @sh) { + $spos = @sh - $pagel; + $inscroll = 0; show_screen(); - }; + } + addtotop($inbuf); # send it to the cluster @@ -337,44 +313,55 @@ sub rec_stdin $inbuf = ""; $pos = $lth = 0; } elsif ($r eq KEY_UP || $r eq "\020") { - if ($khistpos > 0) { - --$khistpos; - $inbuf = $khistory[$khistpos]; + if ($kpos > 0) { + --$kpos; + $inbuf = $kh[$kpos]; $pos = $lth = length $inbuf; } else { beep(); } } elsif ($r eq KEY_DOWN || $r eq "\016") { - if ($khistpos < @khistory - 1) { - ++$khistpos; - $inbuf = $khistory[$khistpos]; + if ($kpos < @kh - 1) { + ++$kpos; + $inbuf = $kh[$kpos]; $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) { +# my ($i, $l); +# for ($i = 0; $i < $pagel-1 && $spos >= 0; ) { +# $l = measure($sh[$spos]); +# $i += $l; +# --$spos if $i <= $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) { +# my ($i, $l); +# for ($i = 0; $i <= $pagel && $spos < @sh; ) { +# $l = measure($sh[$spos]); +# $i += $l; +# ++$spos if $i <= $pagel && $spos < @sh; +# } + + dbg("NPAGE sp:$spos $sh:". scalar @sh . " pl: $pagel") if isdbg('console'); + $spos += int($pagel/2); + if ($spos > @sh - $pagel) { + $spos = @sh - $pagel; + } show_screen(); + if ($spos >= @sh) { + $spos = @sh; + $inscroll = 0; + } } else { beep(); } @@ -418,12 +405,21 @@ sub rec_stdin beep(); } } elsif ($r eq KEY_RESIZE || $r eq "\0632") { - do_resize(); + doresize(); return; + } elsif ($r eq "\x12" || $r eq "\x0c") { + dbg("REDRAW called") if isdbg('console'); + doresize(); + return; + } elsif ($r eq "\013") { + $inbuf = substr($inbuf, 0, $pos); + $lth = length $inbuf; } elsif (defined $r && is_pctext($r)) { # move the top screen back to the bottom if you type something - if ($spos < @shistory) { - $spos = @shistory; + + if ($inscroll && $spos < @sh) { + $spos = @sh - $pagel; + $inscroll = 0; show_screen(); } @@ -439,16 +435,10 @@ sub rec_stdin } $pos++; $lth++; - } elsif ($r eq "\014" || $r eq "\022") { - touchwin(curscr, 1); - refresh(curscr); - return; - } elsif ($r eq "\013") { - $inbuf = substr($inbuf, 0, $pos); - $lth = length $inbuf; } else { beep(); } + $bot->move(1, 0); $bot->clrtobot(); $bot->addstr($inbuf); @@ -457,6 +447,62 @@ sub rec_stdin $bot->refresh(); } + +# add a line to the end of the top screen +sub addtotop +{ + while (@_) { + my $inbuf = shift; + my $l = length $inbuf; + if ($l > $cols) { +# $Text::Wrap::Columns = $cols; +# push @sh, wrap('',"\t", $inbuf); + push @sh, $inbuf; + } else { + push @sh, $inbuf; + } + } + show_screen() unless $inscroll; +} + +# handle incoming messages +sub rec_socket +{ + my ($con, $msg, $err) = @_; + if (defined $err && $err) { + cease(1); + } + if (defined $msg) { + dbg("msg: " . length($msg) . " '$msg'") if isdbg('console'); + 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') { + $line = " " unless length($line); + addtotop($line); + } elsif ($sort && $sort eq 'Z') { # end, disconnect, go, away ..... + cease(0); + } + # ****************************************************** + # ****************************************************** + # any other sorts that might happen are silently ignored. + # ****************************************************** + # ****************************************************** + } else { + cease(0); + } + $top->refresh(); + $lasttime = time; +} + + sub idle_loop { my $t; @@ -465,18 +511,17 @@ sub idle_loop if ($t > $lasttime) { my ($min)= (gmtime($t))[1]; if ($min != $lastmin) { - show_screen(); + show_screen() unless $inscroll; $lastmin = $min; } $lasttime = $t; } - my $ch = $bot->getch(); - if (@time && tv_interval(\@time, [gettimeofday]) >= 1) { - next; - } + my $ch = $bot->getch(); # this is here just to catch RESIZE events if (defined $ch) { - if ($ch ne '-1') { - rec_stdin($ch); + if ($ch == KEY_RESIZE) { + doresize(); + } else { + rec_stdin($ch) unless $ch == '-1'; } } $top->refresh() if $top->is_wintouched; @@ -502,8 +547,16 @@ sub on_disconnect # deal with args # + +while (@ARGV && $ARGV[0] =~ /^-/) { + my $arg = shift; + dbgadd('console'), $maxshist = 200 if $arg eq '-x'; +} + $call = uc shift @ARGV if @ARGV; -$call = uc $myalias if !$call; +$call = uc $myalias unless $call; +$node = uc $mycall unless $node; + my ($scall, $ssid) = split /-/, $call; $ssid = undef unless $ssid && $ssid =~ /^\d+$/; if ($ssid) { @@ -526,11 +579,11 @@ unless ($DB::VERSION) { $SIG{'HUP'} = \&sig_term; # start up -do_resize(); +doresize(); $SIG{__DIE__} = \&sig_term; -$Text::Wrap::Columns = $cols; +#$Text::Wrap::Columns = $cols; my $lastmin = 0; @@ -539,7 +592,19 @@ $conn = IntMsg->connect($clusteraddr, $clusterport, rproc => \&rec_socket); $conn->{on_connect} = \&on_connect; $conn->{on_disconnect} = \&on_disconnect; +my $timer = Mojo::IOLoop->recurring(1, sub {DXLog::flushall()}); + $idle = Mojo::IOLoop->recurring(0.100 => \&idle_loop); +Mojo::IOLoop->singleton->reactor->io(\*STDIN => sub { + my $ch = $bot->getch(); + if (defined $ch) { + if ($ch ne '-1') { + rec_stdin($ch); + } + } +})->watch(\*STDIN, 1, 0); + + Mojo::IOLoop->start; -- 2.34.1