forked from VE3NEA/MorseRunner
-
Notifications
You must be signed in to change notification settings - Fork 15
/
Copy pathCWOPS.pas
292 lines (234 loc) · 7.36 KB
/
CWOPS.pas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
unit CWOPS;
interface
uses
Classes, Generics.Defaults, Generics.Collections, Contest, Contnrs,
Station, DxStn, Log;
type
TCWOPSRec= class
public
Call: string; // Station Callsign
Exch1: string; // Operator Name
Exch2: string; // Number/State/Province/Country Prefix
UserText: string; // station location/information string
function IsCWOpsMember: Boolean; // return whether operator is a member
class function compareCall(const left, right: TCWOPSRec) : integer; static;
end;
TCWOPS= class(TContest)
private
CWOPSList: TObjectList<TCWOPSRec>;
Comparer: IComparer<TCWOPSRec>;
procedure Delimit(var AStringList: TStringList; const AText: string);
public
constructor Create;
destructor Destroy; override;
function LoadCallHistory(const AUserCallsign : string) : boolean; override;
function PickStation(): integer; override;
procedure DropStation(id : integer); override;
function GetCall(id : integer): string; override;
function FindCallRec(out outrec: TCWOPSRec; const ACall: string): Boolean;
procedure GetExchange(id : integer; out station : TDxStation); override;
procedure SendMsg(const AStn: TStation; const AMsg: TStationMessage); override;
function GetStationInfo(const ACallsign: string) : string; override;
function ExtractMultiplier(Qso: PQso) : string; override;
end;
function IsNum(Num: String): Boolean;
implementation
uses
SysUtils, DXCC;
function TCWOPS.LoadCallHistory(const AUserCallsign : string) : boolean;
const
// !!Order!!,Call,Name,Exch1,UserText,
CallInx : integer = 0;
NameInx : integer = 1;
ExchInx : integer = 2;
UserTextInx : integer = 3;
var
slst, tl: TStringList;
i: integer;
CWO: TCWOPSRec;
begin
// reload call history if empty
Result := CWOPSList.Count <> 0;
if Result then
Exit;
slst:= TStringList.Create;
tl:= TStringList.Create;
CWO := nil;
try
CWOPSList.Clear;
slst.LoadFromFile(ParamStr(1) + 'CWOPS.LIST');
for i:= 0 to slst.Count-1 do begin
if (slst.Strings[i].StartsWith('!!Order!!')) then continue;
if (slst.Strings[i].StartsWith('#')) then continue;
self.Delimit(tl, slst.Strings[i]);
if (tl.Count >= 3) then begin
if CWO = nil then
CWO:= TCWOPSRec.Create;
CWO.Call:= UpperCase(tl.Strings[CallInx]);
CWO.Exch1:= UpperCase(tl.Strings[NameInx]);
CWO.Exch2:= UpperCase(tl.Strings[ExchInx]);
if tl.Count > UserTextInx then
CWO.UserText:= Trim(tl.Strings[UserTextInx]);
if CWO.Call='' then continue;
if CWO.Exch1='' then continue;
if CWO.Exch2='' then continue;
if length(CWO.Exch1) > 10 then continue;
if length(CWO.Exch2) > 5 then continue;
CWOPSList.Add(CWO);
CWO := nil;
end;
end;
Result := True;
finally
slst.Free;
tl.Free;
if CWO <> nil then CWO.Free;
end;
end;
constructor TCWOPS.Create;
begin
inherited Create;
CWOPSList:= TObjectList<TCWOPSRec>.Create;
Comparer := TComparer<TCWOPSRec>.Construct(TCWOPSRec.compareCall);
end;
destructor TCWOPS.Destroy;
begin
FreeAndNil(CWOPSList);
inherited;
end;
function TCWOPS.PickStation(): integer;
begin
result := random(CWOPSList.Count);
end;
procedure TCWOPS.DropStation(id : integer);
begin
assert(id < CWOPSList.Count);
CWOPSList.Delete(id);
end;
function TCWOPS.GetCall(id : integer): string;
begin
result := CWOPSList[id].Call;
end;
function TCWOPS.FindCallRec(out outrec: TCWOPSRec; const ACall: string): Boolean;
var
rec: TCWOPSRec;
{$ifdef FPC}
index: int64;
{$else}
index: integer;
{$endif}
begin
rec := TCWOPSRec.Create();
rec.Call := ACall;
outrec:= nil;
try
if CWOPSList.BinarySearch(rec, index, Comparer) then
outrec:= CWOPSList.Items[index];
finally
rec.Free;
end;
Result:= outrec <> nil;
end;
procedure TCWOPS.GetExchange(id : integer; out station : TDxStation);
begin
station.OpName := CWOPSList.Items[id].Exch1;
station.Exch1 := CWOPSList.Items[id].Exch1;
station.Exch2 := CWOPSList.Items[id].Exch2;
end;
{
Overrides TContest.SendMsg() to send contest-specific messages.
Adding a contest: TContest.SendMsg(AMsg): send contest-specfic messages
}
procedure TCWOPS.SendMsg(const AStn: TStation; const AMsg: TStationMessage);
begin
case AMsg of
msgCQ: SendText(AStn, 'CQ CWT <my>');
msgR_NR:
if (random < 0.9)
then SendText(AStn, '<#>')
else SendText(AStn, 'R <#>');
msgR_NR2:
if (random < 0.9)
then SendText(AStn, '<#> <#>')
else SendText(AStn, 'R <#> <#>');
msgLongCQ: SendText(AStn, 'CQ CQ CWT <my> <my>'); // QrmStation only
else
inherited SendMsg(AStn, AMsg);
end;
end;
{
return status bar information string from CWOPS call history file.
for members (w/ numeric Exch2), return their QTH string (UserText)
for DX Stations (not USA or Canada), return their Entity/Continent.
this string is used in MainForm.sbar.Caption (status bar).
We are careful not to disclose information that would give hints during
exchange copy (e.g. for non-members in US or Canada, we do not return
their city/state/province).
Format: '<call> [- <user text from CWOPS.LIST>] [- Entity/Continent]'
}
function TCWOPS.GetStationInfo(const ACallsign: string) : string;
var
cwopsrec : TCWOPSRec;
dxrec : TDXCCRec;
userText : string;
begin
cwopsrec := nil;
dxrec := nil;
userText := '';
result:= '';
if FindCallRec(cwopsrec, ACallsign) then
begin
// if caller is a member, include their UserText string.
// if non-member calling from USA or Canada, use either NA/USA or NA/Canada
// (otherwise UserText string gives a hint for State/Province).
// if UserText is empty, always return DXCC Continent/Entity.
userText := cwopsrec.UserText;
if gDXCCList.FindRec(dxrec, ACallsign) then
if userText.IsEmpty or
(not cwopsrec.IsCWOpsMember and
(dxrec.Entity.Equals('United States of America') or
dxrec.Entity.Equals('Canada'))) then
userText:= dxRec.Continent + '/' + dxRec.Entity;
if not userText.IsEmpty then
result:= ACallsign + ' - ' + userText;
end;
end;
{
CWOPS CWT contest uses number of unique callsigns worked as the multiplier.
Also sets contest-specific Qso.Points for this QSO.
}
function TCWOPS.ExtractMultiplier(Qso: PQso) : string;
begin
Qso^.Points := 1;
Result:= Qso^.Call;
end;
function TCWOPSRec.IsCWOpsMember: Boolean;
begin
Result := IsNum(Exch2);
end;
class function TCWOPSRec.compareCall(const left, right: TCWOPSRec) : integer;
begin
Result := CompareStr(left.Call, right.Call);
end;
function IsNum(Num: String): Boolean;
var
X : Integer;
begin
Result := Length(Num) > 0;
for X := 1 to Length(Num) do begin
if Pos(copy(Num,X,1),'0123456789') = 0 then begin
Result := False;
Exit;
end;
end;
end;
procedure TCWOPS.Delimit(var AStringList: TStringList; const AText: string);
const
DelimitChar: char= ',';
begin
AStringList.Clear;
AStringList.Delimiter := DelimitChar;
AStringList.StrictDelimiter := True;
AStringList.DelimitedText := AText;
end;
end.