X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2Fconsole.pl;h=3fbc46fe64ab432169d125e1281c007b75a0b76a;hb=2f876d1acd6afe143f482da0749f292b9d869376;hp=88ffb92787589a527ebf03f51983b053de466bdb;hpb=e69a98ce612592a78aca2a3ac4e2388a06059955;p=spider.git diff --git a/perl/console.pl b/perl/console.pl index 88ffb927..3fbc46fe 100755 --- a/perl/console.pl +++ b/perl/console.pl @@ -10,10 +10,16 @@ # # Copyright (c) 1999 Dirk Koopman G1TLH # -# $Id$ +# # require 5.004; +package main; + +use vars qw($data $clusteraddr $clusterport); + +$clusteraddr = '127.0.0.1'; # cluster tcp host address - used for things like console.pl +$clusterport = 27754; # cluster tcp port # search local then perl directories BEGIN { @@ -23,6 +29,8 @@ BEGIN { unshift @INC, "$root/perl"; # this IS the right way round! unshift @INC, "$root/local"; + $is_win = ($^O =~ /^MS/ || $^O =~ /^OS-2/) ? 1 : 0; # is it Windows? + $data = "$root/data"; } use Msg; @@ -43,18 +51,20 @@ 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 = ""; @time = (); -$SIG{WINCH} = sub {@time = gettimeofday}; +#$SIG{WINCH} = sub {@time = gettimeofday}; sub mydbg { @@ -84,9 +94,9 @@ sub do_initscr init_pair(12, COLOR_MAGENTA, COLOR_BLUE); init_pair(13, COLOR_YELLOW, COLOR_GREEN); init_pair(14, COLOR_RED, COLOR_GREEN); - eval { assume_default_colors($foreground, $background) }; + eval { assume_default_colors($foreground, $background) } unless $is_win; } - + $top = $scr->subwin($lines-4, $cols, 0, 0); $top->intrflush(0); $top->scrollok(1); @@ -118,8 +128,11 @@ sub do_resize $cols = COLS; $has_colors = has_colors(); do_initscr(); - + $inscroll = 0; + $spos = @sh < $pagel ? 0 : @sh - $pagel; show_screen(); + $conn->send_later("C$call|$cols") if $conn; + } # cease communications @@ -152,70 +165,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; +{ 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; - + + $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(); @@ -227,17 +239,23 @@ 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; + my $token; + ($token) = $inbuf =~ m!^(.* de [-\w\d/\#]+:?\s+|\w{9}\@\d\d:\d\d:\d\d )!; + $token ||= ' ' x 19; + push @sh, split /\n/, wrap('', ' ' x length($token), $inbuf); + } else { + push @sh, $inbuf; + } } else { - push @shistory, $inbuf; + push @sh, $inbuf; } - shift @shistory while @shistory > $maxshist; } +# shift @sh while @sh > $maxshist; show_screen(); } @@ -249,7 +267,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') { @@ -258,6 +283,7 @@ sub rec_socket } elsif ($sort && $sort eq 'Z') { # end, disconnect, go, away ..... cease(0); } + # ****************************************************** # ****************************************************** # any other sorts that might happen are silently ignored. @@ -292,9 +318,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; } } @@ -303,18 +329,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 @@ -324,42 +352,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(); } @@ -407,8 +433,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(); } @@ -449,6 +475,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) { @@ -494,11 +522,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 (;;) { @@ -515,8 +543,6 @@ for (;;) { } my $ch = $bot->getch(); if (@time && tv_interval(\@time, [gettimeofday]) >= 1) { -# mydbg("Got Resize"); -# do_resize(); next; } if (defined $ch) {