Browse Source

bandmap: perform all screen updates from main thread

master
Fabian Kurz 4 years ago
parent
commit
daf3875d8d
  1. 5
      CHANGELOG
  2. 43
      yfk
  3. 215
      yfksubs.pl

5
CHANGELOG

@ -1,3 +1,8 @@
2019-Aug-31: Version 0.5.1
-------------------------------------------------------------------------------
- Bandmap: Perform all screen updates in the main thread (avoid display problems
with Curses which is not thread safe)
2019-Jul-31: Version 0.5.0
-------------------------------------------------------------------------------
- LoTW download: Show list of confirmed contacts after import.

43
yfk

@ -27,11 +27,13 @@ use Curses;
use Net::FTP; # upload of online log or backup
use threads ('yield', 'stack_size' => 64*4096, 'exit' => 'threads_only', 'stringify');
use threads::shared;
# terminal size (will be queried later)
our $col;
our $row;
# window/terminal size changed
$SIG{'WINCH'} = sub {
&redraw();
};
@ -170,7 +172,7 @@ else {
&databaseupgrade(0) unless ($firstrun);
getch;
&waitkey();
# Now the main windows will be generated:
@ -669,7 +671,7 @@ while ($aw == 6) {
addstr($wqsos, 1, 0, "Press F7 again to return to interactive mode.");
refresh($wqsos);
my $c = getch();
my $c = getch2();
my $ret = &receive_qso();
&lastqsos(\$wlog);
@ -881,7 +883,7 @@ while ($status == 4) {
$status = 2;
getch();
&waitkey();
} # end of $status = 4, update of online log
@ -969,7 +971,7 @@ while ($status == 6) {
refresh($wmain);
refresh($whelp);
$status = 2;
getch();
&waitkey();
last;
}
# if the dates are valid, build a SQL String to put into the
@ -1056,7 +1058,7 @@ while ($status == 6) {
addstr($wmain, 0,0, " "x(80*($row-2)));
addstr($wmain, 10,28, "No QSL Cards in queue!");
refresh($wmain);
getch();
&waitkey();
$status = 2; # back to main menu
last;
}
@ -1105,7 +1107,7 @@ while ($status == 6) {
my $nr = &emptyqslqueue; # returns nr of QSOs..
addstr($wmain, 19,16, "$nr QSOs updated. Press any key to continue!");
refresh($wmain);
getch();
&waitkey();
}
$status = 2; # back to the main menu
@ -1195,7 +1197,7 @@ while (($status == 7) || ($status == 14)) {
refresh($wmain);
refresh($whelp);
$status = 2;
getch();
&waitkey();
last;
}
# if the dates are valid, build a SQL String to put into the
@ -1277,7 +1279,7 @@ while (($status == 7) || ($status == 14)) {
refresh($wmain);
flushinp();
getch();
&waitkey();
$status = 2;
} # end ADIF export mode, $status==7
@ -1474,7 +1476,7 @@ while ($status == 9) {
unless (-e $adifdir) {
addstr($wmain, 5,15, "$adifdir does not exist! Any key to continue.");
refresh($wmain);
getch();
&waitkey();
$status = 2; # back to main menu
next;
}
@ -1497,7 +1499,7 @@ while ($status == 9) {
if ($y == 0) {
addstr($wmain, 5,15, "No ADI-Files in $adifdir! Any key to continue.");
refresh($wmain);
getch;
&waitkey();
$status = 2; # back to main menu
next;
}
@ -1537,7 +1539,7 @@ while ($status == 9) {
}
refresh($wmain);
getch();
&waitkey();
$status = 2; # back to main menu
@ -1603,7 +1605,7 @@ while ($status == 10) {
&changemycall($mycall); # change $mycall also in yfksubs.pl
}
refresh($wmain);
getch();
&waitkey();
}
elsif ($choice == 1) { # second item -> delete old log
curs_set(1); # cursor visible
@ -1617,7 +1619,7 @@ while ($status == 10) {
if ($msg =~ /successfully/) { # delete succefull
}
refresh($wmain);
getch();
&waitkey();
}
else { # change $mycall to selected log
$mycall = $logs[$choice]; # Callsign is here
@ -1705,7 +1707,7 @@ while ($status == 11) {
refresh($wmain);
refresh($whelp);
$status = 2;
getch();
&waitkey();
last;
}
# if the dates are valid, build a SQL String to put into the
@ -1814,7 +1816,8 @@ while ($status == 11) {
# Statistics printed, wait for keystroke to go back to the menu
refresh($wmain);
getch();
flushinp();
&waitkey();
$status = 2; # back to menu
} # AWARD mode
@ -1904,7 +1907,7 @@ while ($status == 13) {
addstr($wmain,6, 5, "Download failed! Check username/password and/or network connection.");
attron($wmain, COLOR_PAIR(4));
refresh($wmain);
getch();
&waitkey();
$status = 2; # back to main menu
next;
}
@ -1923,7 +1926,7 @@ while ($status == 13) {
unless (-e $lotwdir) {
addstr($wmain, 5,15, "$lotwdir does not exist! Any key to continue.");
refresh($wmain);
getch();
&waitkey();
$status = 2; # back to main menu
next;
}
@ -1945,7 +1948,7 @@ while ($status == 13) {
if ($y == 0) {
addstr($wmain, 5,15, "No ADI-Files in $lotwdir! Any key to continue.");
refresh($wmain);
getch;
&waitkey();
$status = 2; # back to main menu
next;
}
@ -1984,7 +1987,7 @@ while ($status == 13) {
addstr($wmain, 7,10, "No QSLs imported. Possibly this file doesn't meet the LoTW");
addstr($wmain, 8,10, "specifications. ");
addstr($wmain, 9,10, "If you think the file is OK, contact author.");
getch();
&waitkey();
}
refresh($wmain);
@ -2065,7 +2068,7 @@ while ($status == 15) {
$status = 2;
# endwin;
&databaseupgrade(1); # 1 -> clear screen first
getch;
&waitkey();
last;
}

215
yfksubs.pl

@ -34,7 +34,7 @@ changemycall newlogtable oldlogtable choseeditqso geteditqso editw updateqso che
awards statistics qslstatistics editdb editdbw savedbedit lotwimport
databaseupgrade xplanet queryrig tableexists changeconfig readsubconfig
connectdb connectrig jumpfield receive_qso tqslsign getlotwlocations
getlotwstartdate downloadlotw redraw create_windows rundxc);
getlotwstartdate downloadlotw redraw create_windows rundxc getch2 waitkey);
use strict;
use POSIX; # needed for acos in distance/direction calculation
@ -46,6 +46,9 @@ use IPC::SysV qw(IPC_PRIVATE IPC_RMID IPC_NOWAIT IPC_CREAT);
use LWP::UserAgent ();
use Net::Telnet ();
use threads;
use threads::shared;
my $havehamdb = eval "require Ham::Callsign::DB;";
my $hamdb;
if ($havehamdb) {
@ -54,6 +57,7 @@ if ($havehamdb) {
$hamdb->initialize_dbs();
}
# We load the default values for some variables that can be changed in .yfklog
my $lidadditions="^QRP\$|^LGT\$";
@ -109,6 +113,10 @@ our $dxcport=0; # dx cluster telnet port
our $dxccall=""; # dx cluster login callsign
my @dxspots;
share(@dxspots);
sub redraw {
endwin();
initscr();
@ -158,9 +166,11 @@ sub create_windows {
}
# connect to a DX cluster (if configured)
sub rundxc {
my $win = $main::wdxc;
my $c = 0;
my %bcfh = (); # band-call-> freq hash
my %bcth = (); # band-call-> timestamp hash
my $rows = $main::row;
# each column in the bandmap requires 25 characters. from the total number
@ -168,84 +178,120 @@ sub rundxc {
# calculate the number of bandmap columns as follows:
my $dxccols = int(($main::col - 80) / 25);
my $maxspots = $rows * $dxccols;
# DX cluster not configured? Exit thread.
unless ($dxchost =~ /\./ && $dxcport =~ /^\d+$/ && $dxccall ne "") {
return;
}
while (1) {
addstr($win, 1, 3, " Connecting to '$dxchost:$dxcport'");
addstr($win, 2, 3, " with callsign '$dxccall'. ");
# addstr($win, 3, 3, " ($dxccols columns)");
refresh($win);
sleep(3);
@dxspots = ();
push @dxspots, " Connecting to '$dxchost:$dxcport'";
push @dxspots, " with callsign '$dxccall'.";
my $t = new Net::Telnet (Timeout => 600, Port => $dxcport, Prompt => '/./');
$t->open($dxchost);
$t->print("$dxccall\n");
sleep(3);
while (1) {
my $line = $t->getline();
chomp($line);
if ($line =~ /CW/ and $line =~ /DX de .*:\s+([0-9.]+)\s+([A-Z0-9\/]+)/) {
my $dxcall = $2;
my $freq = $1;
$freq =~ s/(\.\d)\d$/$1/g;
my $dxband = &freq2band($freq);
$bcfh{$dxband}{$dxcall} = $freq;
$bcth{$dxband}{$dxcall} = time;
# update the @dxspots array
&updatedxc(\%bcfh, \%bcth, $maxspots);
}
my $t = new Net::Telnet (Timeout => 600, Port => $dxcport, Prompt => '/./');
$t->open($dxchost);
$t->print("$dxccall\n");
$t->print("set/raw\n");
} # while 1 (when connected)
} # while(1) outter loop
}
my %bcfh = (); # band-call-> freq hash
my %bcth = (); # band-call-> timestamp hash
# push bandmap entries in shared array @dxspots. it will be
# printed on screen by showdxc() from the main thread
sub updatedxc {
my $fr = shift; # reference to %bcfh
my $tr = shift; # reference to %bcth
my $maxspots = shift;
my $c = 0;
my $timeout = 300;
my $lastrefresh = 0;
sleep(3);
@dxspots = ();
while (1) {
my $line = $t->getline();
chomp($line);
if ($line =~ /CW/ and $line =~ /DX de .*:\s+([0-9.]+)\s+([A-Z0-9\/]+)/) {
my $dxcall = $2;
my $freq = $1;
$freq =~ s/(\.\d)\d$/$1/g;
my $dxband = &freq2band($freq);
do {
$c = 0;
for my $band ( sort { $b <=> $a } keys %{ $tr } ) {
if ($c) {
push @dxspots, "";
$c++;
}
for my $call ( sort { $fr->{$band}{$a} <=> $fr->{$band}{$b} } keys %{ $fr->{$band} } ) {
push @dxspots, sprintf("%7.1f %s", $fr->{$band}{$call}, $call);
$c++;
# remove spots that are older than 5 minutes
if ((time - $tr->{$band}{$call}) > $timeout) {
delete($fr->{$band}{$call});
delete($tr->{$band}{$call});
}
}
}
$bcfh{$dxband}{$dxcall} = $freq;
$bcth{$dxband}{$dxcall} = time;
# bandmap full? reduce timeout gradually until we have resolved
# the overflow.
$timeout -= 1;
} while ($c >= $maxspots);
addstr($win, 0, 0, " "x($dxccols * 50 * $rows));
do {
$c = 0;
for my $band ( sort { $b <=> $a } keys %bcfh ) {
$c++ if ($c);
for my $call ( sort { $bcfh{$band}{$a} <=> $bcfh{$band}{$b} } keys %{ $bcfh{$band} } ) {
$line = sprintf("%7.1f %s", $bcfh{$band}{$call}, $call);
$c++;
# we split into columns with a width of 25
my $mrow = $c % $rows;
my $mcol = int($c / $rows);
next if ($mcol >= $dxccols); # don't swap into a non-existing column
addstr($win, $mrow , 1 + $mcol*25, $line);
# remove spots that are older than 5 minutes
if ((time - $bcth{$band}{$call}) > $timeout) {
delete($bcfh{$band}{$call});
delete($bcth{$band}{$call});
}
}
}
$timeout = 300;
}
# bandmap full? reduce timeout gradually until we have resolved
# the overflow.
$timeout -= 1;
} while ($c >= ($dxccols * $rows));
# print bandmap in wdxc window.
# this is called from the main thread (getch2, on keyboard timeout)
$timeout = 300;
}
# limit screen refresh to 1/second
if ($lastrefresh != time) {
refresh($win);
$lastrefresh = time;
}
} # while 1 (when connected)
} # while(1) outter loop
sub showdxc {
my $win = $main::wdxc;
my $rows = $main::row;
return unless (defined($win));
# each column in the bandmap requires 25 characters. from the total number
# of available columns, 80 are already used by the logger, so we can
# calculate the number of bandmap columns as follows:
my $dxccols = int(($main::col - 80) / 25);
addstr($win, 0, 0, " "x($dxccols * 50 * $rows));
my $c = 0;
foreach my $line (@dxspots) {
# we split into columns with a width of 25
my $mrow = $c % $rows;
my $mcol = int($c / $rows);
next if ($mcol >= $dxccols); # don't swap into a non-existing column
next if ($mrow == 0 && $line eq ""); # don't print empty line on top
addstr($win, $mrow , 1 + $mcol*25, $line) if ($win);
$c++;
}
refresh($win);
# a little trick to get the cursor back to the entry field
# where it was before: push a character into the keyboard
# input queue that will be ignored
ungetchar("~");
}
# We read the configuration file .yfklog.
sub readsubconfig {
@ -1967,8 +2013,8 @@ do { # loop and get keyboard input
}
elsif ($ch eq KEY_F(8)) { # back to inp-window without any action
$goon = 0; # do not go on!
$ret = "i"; # return value i = Input Window
$goon = 0; # do not go on!
$ret = "i"; # return value i = Input Window
}
elsif ($ch eq KEY_F(10)) { # to QSO b4-window without any action
@ -1976,7 +2022,7 @@ do { # loop and get keyboard input
$ret = "q"; # return value q = QSO Window
}
elsif ($ch =~ /\s/) { # we selected a QSO!
elsif ($ch =~ /\s/) { # we selected a QSO!
$goon=0; # get out of the do .. while loop
}
@ -2300,7 +2346,7 @@ for ($y=$ystart; $y < ($ystart+$height); $y++) { # go through $y range
refresh($win);
$ch = getch();
$ch = getch2();
if ($ch eq KEY_DOWN) { # Arrow down was pressed
if ($aline < $#items) { # not at last position
@ -2357,7 +2403,7 @@ elsif ($ch eq KEY_F(12)) { # F12 - QUIT YFKlog
exit;
}
elsif (ord($ch) eq '27') {
$ch = getch();
$ch = getch2();
if ($ch eq '1') {
return "m";
}
@ -2539,7 +2585,7 @@ if ($write) { # QSL Write mode
addstr($win, 0,0, " " x ($xw * $yh)); # clear window
addstr($win, 9, 33, "No QSL queued!");
refresh($win);
getch(); # wait for user
getch2(); # wait for user
return 2; # return to main menu
}
}
@ -2561,7 +2607,7 @@ else { # QSL receive mode
my $msg = "No QSO found matching $call!";
addstr($win, 9, ($xw-length($msg))/2 , $msg);
refresh($win);
getch(); # wait for user
getch2(); # wait for user
return 3;
}
}
@ -4354,7 +4400,7 @@ sub editw {
move ($win,0,$pos); # move cursor to $pos
refresh($win); # show new window
$ch = &getch2; # wait for a character
$ch = &getch2(); # wait for a character
# We first check if it is a legal character of the specified $match,
# if so, it will be added to the string (at the proper position!)
@ -4910,7 +4956,7 @@ sub editdb {
addstr($win, 10, 23, "$call does not exist in the database.");
curs_set(0);
refresh($win);
getch;
getch2();
curs_set(1);
return 12;
}
@ -5673,7 +5719,7 @@ sub askconfirmation {
addstr($win, 0, 0, $question." "x80);
refresh($win);
do {
$k = getch();
$k = getch2();
} until ($k =~ /$regex/i);
delwin($win);
@ -5770,7 +5816,7 @@ sub finderror {
addstr($win, 2, 0, "$err QSO cannot be saved. Press any key to go back to the QSO..");
curs_set(0);
refresh($win);
getch;
getch2();
delwin($win);
if ($mode eq 'log') {
@ -6028,7 +6074,16 @@ sub qslstatistics {
sub getch2 {
my $ch = getch();
halfdelay(10);
my $ch;
do {
$ch = getch();
if ($ch eq "-1") {
&showdxc();
}
} while ($ch eq "-1");
# ESC-n instead of F-Keys
if (ord($ch) == 27) {
@ -6050,6 +6105,16 @@ sub getch2 {
return $ch;
}
# return on anything except ~ (see showdxc)
sub waitkey {
while (getch2() eq "~"){};
}
sub tqslsign {
my $filename = shift;
my $location = shift;

Loading…
Cancel
Save