I recently worked the Amateur Radio Winter Field Day Contest. In
these contests, a station may only be worked for credit once per band
(and mode if you want to get picky). This requires that some method
of duplicate checking be used. As a low power station, 50 contacts over
a weekend would be an accomplishment. I log on paper(and later enter the
contacts into my Perl based logging program for upload to QRZ.COM and LoTW)
so up to a page of contacts can be visually dupe checked. Over a page
it gets tedious.
So, after the contest, I thought about what I could do to be better
prepared for the next contest.
I have played with wxPerl in the past but I've never used Tk. So why
not try building a Tk application? Posted below is the result. It's
somewhat brut force, and I need to explore frames and -pack options
in the future. Performance is good to at least 100 entries.
(Aside: I am aware of using a hash for duplicate checking, but
I decided to go a different route.)
#!/usr/bin/perl
# dupe.pl - KE4MIQ Contest Dupe Checker
# Searches for a callsign within a (sorted)list of previousl
+y
# entered call signs. A popup indicates when a dup is fo
+und.
# A unique callsign may be added to the list(or skipped).
# Callsigns may be deleted as needed(single selection).
# The callsign list may be saved to a file and
# reloaded at a later time.
# James M. Lynes Jr. - KE4MIQ
# Created: January 31, 2022
# Last Modified: 01/31/2022 - First version created
# - Add Save and Load functions
# 02/01/2022 - Add in dupe checking
# - Allow checking without inserting
# - Add delete callsign function
# Environment: Ubuntu 18.04LTS
# Notes: Install Perl Tk
# sudo apt update
# sudo apt install perl-tk
use strict;
use warnings;
use Tk;
my @callsigns;
my $fh;
#
# Create the Main Window
#
my $mw = new MainWindow;
#
# Add the Window Label & Title
#
$mw->Label(-relief => 'raised',
-text => "KE4MIQ Contest Dupe Checker" )
->pack(-side => 'top', -fill => 'x');
$mw->title("dupe.pl");
#
# Add the buttons
#
my $quit = $mw->Button(-text => 'Quit',
-command => sub{exit});
my $load = $mw->Button(-text => 'Load Callsigns',
-command => \&Load);
my $save = $mw->Button(-text => 'Save Callsigns',
-command => \&Save);
my $delete = $mw->Button(-text => 'Delete Callsign',
-command => \&Delete);
$quit->pack(-side => 'bottom',
-expand => 1,
-fill => 'none');
$save->pack(-side => 'bottom',
-expand => 1,
-fill => 'none');
$load->pack(-side => 'bottom',
-expand => 1,
-fill => 'none');
$delete->pack(-side => 'bottom',
-expand => 1,
-fill => 'none');
#
# Create an Entry Box and Button
#
my $entry = $mw -> Entry();
$entry -> pack;
$mw->Button(-text => 'Check Callsign',
-command => sub{GetCall($entry)}
)->pack;
#
# Create a listbox
#
my $cs_list = $mw->Listbox(-relief => 'raised',
-setgrid => 'yes',
-selectmode => 'single');
#
# Create a scrollbar
#
my $cs_scroll = $mw->Scrollbar(-command => ['yview', $cs_list])
->pack(-side => 'right', -fill => 'y');
#
# Tie the scrollbar to the listbox.
#
$cs_list->configure( -yscrollcommand => ['set', $cs_scroll]);
#
# show the listbox.
#
$cs_list->pack(-fill => 'y');
MainLoop;
#
# Subroutines
#
#
# Get the value of the Text Entry widget,
# Dupe check, & Rebuild the listbox
#
sub GetCall {
my ($widget) = @_;
my $entered = $widget -> get(); # Get the input t
+ext
$entered = uc($entered); # Force upper cas
+e
foreach my $call (@callsigns) { # Check for dupli
+cate callsign
if($call eq $entered) { # Dupe found
my $response = $mw->messageBox(-icon => 'error', -message
+=> 'Callsign Duplicate',
-title => 'Duplicate Found'
+,
-type => 'ok');
$entry->delete(0, 'end'); # Clear the entry
+ box
return; # Dupe, return wi
+thout insert
}
}
# Not a dupe, Ins
+ert?
my $response = $mw->messageBox(-message => 'Insert Callsign?',
-title => 'Callsign Not A Duplicat
+e',
-type => 'YesNo',
-icon => 'question');
if($response eq 'No') { # No, Don't inser
+t
$entry->delete(0, 'end'); # Clear the entry
+ box
return; # Skip the insert
}
push(@callsigns, $entered); # Yes, Insert int
+o callsign list
$entry->delete(0, 'end'); # Clear the entry
+ box
@callsigns = sort @callsigns; # sort callsign l
+ist
$cs_list->delete(0, 'end'); # Clear the listb
+ox
$cs_list->insert('end', @callsigns); # Reload the list
+box
}
#
# Load the saved callsigns from a file - callsigns.txt
#
sub Load {
@callsigns = (); # Empty callsigns
+ before loading
open($fh, "<", "callsigns.txt");
while(defined(my $line = <$fh>)) {
chomp($line);
push(@callsigns, $line);
}
close $fh;
$cs_list->delete(0, 'end'); # Clear the listb
+ox
$cs_list->insert('end', @callsigns); # Reload the list
+box
}
#
# Save the callsigns to a file - callsigns.txt
#
sub Save {
open($fh, ">", "callsigns.txt");
foreach my $call (@callsigns) {
print $fh "$call\n";
}
close $fh;
}
#
# Delete selected callsign
#
sub Delete {
my $position = $cs_list->curselection(); # Pointer to sele
+cted item
if(not defined($position)) {return}; # Nothing selecte
+d, return
my $selection = $cs_list->get($position); # Selected item v
+alue
my @temp;
foreach my $call(@callsigns) { # Remove selected
+ item from
if($call ne $selection) { # Callsign lis
+t
push(@temp, $call);
}
}
@callsigns = @temp;
$cs_list->delete(0, 'end'); # Clear the listb
+ox
$cs_list->insert('end', @callsigns); # Reload the list
+box
}
