Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

fix callsign prefix reporting issue (Coded by W7SST) #129

Merged
merged 1 commit into from
Nov 15, 2022
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
34 changes: 20 additions & 14 deletions ARRL.pas
Original file line number Diff line number Diff line change
Expand Up @@ -35,7 +35,7 @@ TDXCC= class
implementation

uses
SysUtils, Contnrs, log, PerlRegEx, pcre;
SysUtils, Contnrs, log, PerlRegEx, pcre, Ini;

procedure TDXCC.LoadDxCCList;
var
Expand Down Expand Up @@ -100,13 +100,13 @@ function TDXCC.SearchPrefix(out index : integer; const ACallPrefix : string) : B

function TDXCC.FindRec(out dxrec : TDXCCRec; const ACallsign : string) : Boolean;
var
sC, sP: string;
index : integer;
begin
dxrec:= nil;
sC:= ExtractCallsign(ACallsign);
sP:= ExtractPrefix(sC);
Result:= SearchPrefix(index, sP);

// Use full call when extracting prefix, not user's call.
// Example: F6/W7SST should return 'F6' not 'W7' (station located within F6)
Copy link
Owner Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Bug - I deleted the call to ExtractPrefix(ACallsign). This must be restored.

Result:= SearchPrefix(index, ACallsign);
if Result then
dxrec:= TDXCCRec(DXCCList.Items[index]);
end;
Expand All @@ -115,32 +115,34 @@ function TDXCC.FindRec(out dxrec : TDXCCRec; const ACallsign : string) : Boolean
function TDXCC.GetStationInfo(const ACallsign: string): string;
var
i : integer;
sC, sP: string;
sP: string;
begin
Result:= 'Unknown';
sC:= ExtractCallsign(ACallsign);
sP:= ExtractPrefix(sC);

// Use full call when extracting prefix, not user's call.
sP:= ExtractPrefix(ACallsign);

if SearchPrefix(i, sP) then
Result:= sC + ' ' + TDXCCRec(DXCCList[i]).GetString;
Result:= sP + ': ' + TDXCCRec(DXCCList[i]).GetString;
end;

function TDXCC.Search(ACallsign: string): string;
var
reg: TPerlRegEx;
i: integer;
s, sC, sP: string;
s, sP: string;
begin
reg := TPerlRegEx.Create();
try
Result:= '';
sC:= ExtractCallsign(ACallsign);
sP:= ExtractPrefix(sC);
// Use full call when extracting prefix, not user's call.
sP:= ExtractPrefix(ACallsign);
reg.Subject := UTF8Encode(sP);
for i:= DXCCList.Count - 1 downto 0 do begin
s:= '^(' + TDXCCRec(DXCCList.Items[i]).prefixReg + ')';
reg.RegEx:= UTF8Encode(s);
if Reg.Match then begin
Result:= sC + ' ' + TDXCCRec(DXCCList[i]).GetString;
Result:= sP + ': ' + TDXCCRec(DXCCList[i]).GetString;
Break;
end;
end;
Expand Down Expand Up @@ -173,7 +175,11 @@ procedure TDXCC.Delimit(var AStringList: TStringList; const AText: string);

function TDXCCRec.GetString: string;
begin
Result:= Format('%s/%s; ITU Zone:%s; CQ Zone:%s', [Entity, Continent, ITU, CQ]);
// make the long USA entry a little shorter (similar to N1MM)
if Entity = 'United States of America' then
Result:= Format('%s/United States; ITU Zone: %s; CQ Zone: %s', [Continent, ITU, CQ])
else
Result:= Format('%s/%s; ITU Zone: %s; CQ Zone: %s', [Continent, Entity, ITU, CQ]);
end;

end.
46 changes: 42 additions & 4 deletions Log.pas
Original file line number Diff line number Diff line change
Expand Up @@ -25,6 +25,9 @@ function FormatScore(const AScore: integer):string;
procedure UpdateSbar(const ACallsign: string);
function ExtractCallsign(Call: string): string;
function ExtractPrefix(Call: string): string;
{$ifdef DEBUG}
function ExtractPrefix0(Call: string): string;
{$endif}

type
PQso = ^TQso;
Expand Down Expand Up @@ -61,6 +64,9 @@ THisto= class(TObject)
CallSent: boolean; // msgHisCall has been sent; cleared upon edit.
NrSent: boolean; // msgNR has been sent. Seems to imply exchange sent.
Histo: THisto;
{$ifdef DEBUG}
RunUnitTest : boolean; // run ExtractPrefix unit tests once
{$endif}


implementation
Expand Down Expand Up @@ -303,7 +309,9 @@ function ExtractCallsign(Call: string):string;
end;
end;

function ExtractPrefix(Call: string): string;

{$ifdef DEBUG}
function ExtractPrefix0(Call: string): string;
var
reg: TPerlRegEx;
begin
Expand All @@ -318,7 +326,9 @@ function ExtractPrefix(Call: string): string;
reg.Free;
end;
end;
{
{$endif}


function ExtractPrefix(Call: string): string;
const
DIGITS = ['0'..'9'];
Expand All @@ -327,6 +337,30 @@ function ExtractPrefix(Call: string): string;
p: integer;
S1, S2, Dig: string;
begin
{$ifdef DEBUG}
if RunUnitTest then begin
RunUnitTest := false;
// original algorithm
assert(ExtractPrefix0('W7SST') = 'W7');
assert(ExtractPrefix0('W7SST/6') = 'W7'); // should be 'W6'
assert(ExtractPrefix0('N7SST/6') = 'N7'); // should be 'N6'
assert(ExtractPrefix0('F6/W7SST') = 'F6');
assert(ExtractPrefix0('F6/AB7Q') = 'F6');
assert(ExtractPrefix0('W7SST/W') = 'W7'); // should be 'W0'
assert(ExtractPrefix0('F6FVY/W7') = 'F6'); // should be 'W7'

// newer algorithm
assert(ExtractPrefix('W7SST') = 'W7');
assert(ExtractPrefix('W7SST/6') = 'W6');
assert(ExtractPrefix('N7SST/6') = 'N6');
assert(ExtractPrefix('F6/W7SST') = 'F6');
assert(ExtractPrefix('W7SST/W') = 'W0');
assert(ExtractPrefix('F6FVY/W7') = 'W7');
assert(ExtractPrefix('F6/W7SST/P') = 'F6');
assert(ExtractPrefix('W7SST/W/QRP') = 'W0');
assert(ExtractPrefix('F6FVY/W7/MM') = 'W7');
end;
{$endif}
//kill modifiers
Call := Call + '|';
Call := StringReplace(Call, '/QRP|', '', []);
Expand Down Expand Up @@ -390,7 +424,7 @@ function ExtractPrefix(Call: string): string;

Result := Copy(Result, 1, 5);
end;
}


procedure SaveQso;
var
Expand Down Expand Up @@ -475,7 +509,8 @@ procedure SaveQso;
end;

Qso.RawCallsign:= ExtractCallsign(Qso.Call);
Qso.Pfx := ExtractPrefix(Qso.RawCallsign);
// Use full call when extracting prefix, not user's call.
Qso.Pfx := ExtractPrefix(Qso.Call);
{if PfxList.Find(Qso.Pfx, Idx) then Qso.Pfx := '' else }
PfxList.Add(Qso.Pfx);
if Ini.RunMode = rmHst then
Expand Down Expand Up @@ -650,6 +685,9 @@ initialization
PfxList := TStringList.Create;
PfxList.Sorted := true;
PfxList.Duplicates := dupIgnore;
{$ifdef DEBUG}
RunUnitTest := true;
{$endif}

finalization
PfxList.Free;
Expand Down