X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2Fconsole.pl;h=6651272460eeba69b7c01fe46583785fadafbf52;hb=2e3638e69f84390b8e911093aa71a7c9382dfc0f;hp=8af9f3b3aed640fb6500efa34d1c471a1f192b38;hpb=0aaec2fed8977d5e1cd02a4f1432bdde135a1044;p=spider.git diff --git a/perl/console.pl b/perl/console.pl index 8af9f3b3..66512724 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; @@ -32,7 +40,9 @@ use DXDebug; use DXUtil; use DXDebug; use IO::File; +use Time::HiRes qw(gettimeofday tv_interval); use Curses 1.06; +use Text::Wrap; use Console; @@ -41,15 +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}; sub mydbg { @@ -79,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); @@ -113,9 +128,8 @@ sub do_resize $cols = COLS; $has_colors = has_colors(); do_initscr(); - - $winch = 0; - $SIG{'WINCH'} = sub {$winch = 1}; + $inscroll = 0; + $spos = @sh < $pagel ? 0 : @sh - $pagel; show_screen(); } @@ -149,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; +{ 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(); @@ -224,9 +237,20 @@ sub addtotop { while (@_) { my $inbuf = shift; - push @shistory, $inbuf; - shift @shistory if @shistory > $maxshist; + 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 @sh, $inbuf; + } } +# shift @sh while @sh > $maxshist; show_screen(); } @@ -238,14 +262,23 @@ 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') { - $line = " " unless $line; + $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. @@ -269,19 +302,20 @@ sub rec_stdin # print "sys: $r ($prbuf)\n"; if (defined $r) { + $r = '0' if !$r; if ($r eq KEY_ENTER || $r eq "\n" || $r eq "\r") { # save the lines - $inbuf = " " unless $inbuf; + $inbuf = " " unless length $inbuf; # check for a pling and do a search back for a command 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; } } @@ -290,18 +324,20 @@ sub rec_stdin return; } } - push @khistory, $inbuf if $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 @@ -311,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 && $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(); } @@ -366,7 +400,7 @@ sub rec_stdin $pos = 0; } elsif ($r eq KEY_END || $r eq "\005") { $pos = $lth; - } elsif ($r eq KEY_BACKSPACE || $r eq "\010" || $r eq "\0177") { + } elsif ($r eq KEY_BACKSPACE || $r eq "\010" || $r eq "\x7f") { if ($pos > 0) { my $a = substr($inbuf, 0, $pos-1); my $b = substr($inbuf, $pos) if $pos < $lth; @@ -392,10 +426,10 @@ sub rec_stdin } elsif ($r eq KEY_RESIZE || $r eq "\0632") { do_resize(); return; - } elsif (is_pctext($r)) { + } 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(); } @@ -436,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) { @@ -485,6 +521,8 @@ $conn->send_later("I$call|set/nobeep"); #Msg->set_event_handler(\*STDIN, "read" => \&rec_stdin); +$Text::Wrap::columns = $cols; + my $lastmin = 0; for (;;) { my $t; @@ -499,9 +537,7 @@ for (;;) { $lasttime = $t; } my $ch = $bot->getch(); - if ($winch) { -# mydbg("Got Resize"); -# do_resize(); + if (@time && tv_interval(\@time, [gettimeofday]) >= 1) { next; } if (defined $ch) {