forked from jr8ppg/MorseRunner
-
Notifications
You must be signed in to change notification settings - Fork 0
/
DxOper.pas
294 lines (230 loc) · 7.65 KB
/
DxOper.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
290
291
292
293
294
//------------------------------------------------------------------------------
//This Source Code Form is subject to the terms of the Mozilla Public
//License, v. 2.0. If a copy of the MPL was not distributed with this
//file, You can obtain one at http://mozilla.org/MPL/2.0/.
//------------------------------------------------------------------------------
unit DxOper;
interface
uses
SysUtils, RndFunc, Station, Ini, Math, Log;
const
FULL_PATIENCE = 5;
type
TOperatorState = (osNeedPrevEnd, osNeedQso, osNeedNr, osNeedCall,
osNeedCallNr, osNeedEnd, osDone, osFailed);
TCallCheckResult = (mcNo, mcYes, mcAlmost);
TDxOperator = class
private
procedure DecPatience;
function IsMyCall: TCallCheckResult;
public
Call: string;
Skills: integer;
Patience: integer;
RepeatCnt: integer;
State: TOperatorState;
function GetSendDelay: integer;
function GetReplyTimeout: integer;
function GetWpm: integer;
function GetNR: integer;
procedure MsgReceived(AMsg: TStationMessages);
procedure SetState(AState: TOperatorState);
function GetReply: TStationMessage;
end;
implementation
uses
Contest;
{ TDxOperator }
//Delay before reply, keying speed and exchange number are functions
//of the operator's skills
function TDxOperator.GetSendDelay: integer;
begin
// Result := Max(1, SecondsToBlocks(1 / Sqr(4*Skills)));
// Result := Round(RndGaussLim(Result, 0.7 * Result));
if State = osNeedPrevEnd
then Result := NEVER
else if RunMode = rmHst
then Result := SecondsToBlocks(0.05 + 0.5*Random * 10/Wpm)
else
Result := SecondsToBlocks(0.1 + 0.5*Random);
end;
function TDxOperator.GetWpm: integer;
begin
if RunMode = rmHst
then Result := Ini.Wpm
// else Result := Round(Ini.Wpm * 0.5 * (1 + Random));
else
if Ini.WpmFixed = true then
result := Ini.Wpm
else
if Ini.WpmMin <= Ini.WpmMax then
Result := RandomRange(Ini.WpmMin , (Ini.WpmMax + 1))
else
Result := RandomRange(Ini.WpmMax , (Ini.WpmMin + 1))
end;
function TDxOperator.GetNR: integer;
begin
Result := 1 + Round(Random * Tst.Minute * Skills);
end;
function TDxOperator.GetReplyTimeout: integer;
begin
if RunMode = rmHst
then Result := SecondsToBlocks(60/Wpm)
else Result := SecondsToBlocks(6-Skills);
Result := Round(RndGaussLim(Result, Result/2));
end;
procedure TDxOperator.DecPatience;
begin
if State = osDone then Exit;
Dec(Patience);
if Patience < 1 then State := osFailed;
end;
procedure TDxOperator.SetState(AState: TOperatorState);
begin
State := AState;
if AState = osNeedQso
then Patience := Round(RndRayleigh(4))
else Patience := FULL_PATIENCE;
if (AState = osNeedQso) and (not (RunMode in [rmSingle, RmHst])) and (Random < 0.1)
then RepeatCnt := 2
else RepeatCnt := 1;
end;
function TDxOperator.IsMyCall: TCallCheckResult;
const
W_X = 2; W_Y = 2; W_D = 2;
var
C, C0: string;
M: array of array of integer;
x, y: integer;
T, L, D: integer;
begin
C0 := Call;
C := Tst.Me.HisCall;
SetLength(M, Length(C)+1, Length(C0)+1);
//dynamic programming algorithm
for y:=0 to High(M[0]) do M[0,y] := 0;
for x:=1 to High(M) do M[x,0] := M[x-1,0] + W_X;
for x:=1 to High(M) do
for y:=1 to High(M[0]) do
begin
T := M[x,y-1];
//'?' can match more than one char
//end may be missing
if (x < High(M)) and (C[x] <> '?') then Inc(T, W_Y);
L := M[x-1,y];
//'?' can match no chars
if C[x] <> '?' then Inc(L, W_X);
D := M[x-1,y-1];
//'?' matches any char
if not CharInSet(C[x], [C0[y], '?']) then Inc(D, W_D);
M[x,y] := MinIntValue([T,D,L]);
end;
//classify by penalty
case M[High(M), High(M[0])] of
0: Result := mcYes;
1,2: Result := mcAlmost;
else Result := mcNo;
end;
//callsign-specific corrections
if (not Ini.Lids) and (Length(C) = 2) and (Result = mcAlmost) then Result := mcNo;
//partial and wildcard match result in 0 penalty but are not exact matches
if (Result = mcYes) then
if (Length(C) <> Length(C0)) or (Pos('?', C) > 0)
then Result := mcAlmost;
//partial match too short
if Length(StringReplace(C, '?', '', [rfReplaceAll])) < 2 then Result := mcNo;
//accept a wrong call, or reject the correct one
if Ini.Lids and (Length(C) > 3) then
case Result of
mcYes: if Random < 0.01 then Result := mcAlmost;
mcAlmost: if Random < 0.04 then Result := mcYes;
end;
end;
procedure TDxOperator.MsgReceived(AMsg: TStationMessages);
begin
//if CQ received, we can call no matter what else was sent
if msgCQ in AMsg then
begin
case State of
osNeedPrevEnd: SetState(osNeedQso);
osNeedQso: DecPatience;
osNeedNr, osNeedCall, osNeedCallNr: State := osFailed;
osNeedEnd: State := osDone;
end;
Exit;
end;
if msgNil in AMsg then
begin
case State of
osNeedPrevEnd: SetState(osNeedQso);
osNeedQso: DecPatience;
osNeedNr, osNeedCall, osNeedCallNr, osNeedEnd: State := osFailed;
end;
Exit;
end;
if msgHisCall in AMsg then
case IsMyCall of
mcYes:
if State in [osNeedPrevEnd, osNeedQso] then SetState(osNeedNr)
else if State = osNeedCallNr then SetState(osNeedNr)
else if State = osNeedCall then SetState(osNeedEnd);
mcAlmost:
if State in [osNeedPrevEnd, osNeedQso] then SetState(osNeedCallNr)
else if State = osNeedNr then SetState(osNeedCallNr)
else if State = osNeedEnd then SetState(osNeedCall);
mcNo:
if State = osNeedQso then State := osNeedPrevEnd
else if State in [osNeedNr, osNeedCall, osNeedCallNr] then State := osFailed
else if State = osNeedEnd then State := osDone;
end;
if msgB4 in AMsg then
case State of
osNeedPrevEnd, osNeedQso: SetState(osNeedQso);
osNeedNr, osNeedEnd: State := osFailed;
osNeedCall, osNeedCallNr: ; //same state: correct the call
end;
if msgNR in AMsg then
case State of
osNeedPrevEnd: ;
osNeedQso: State := osNeedPrevEnd;
osNeedNr: if (Random < 0.9) or (RunMode = rmHst) then SetState(osNeedEnd);
osNeedCall: ;
osNeedCallNr: if (Random < 0.9) or (RunMode = rmHst) then SetState(osNeedCall);
osNeedEnd: ;
end;
if msgTU in AMsg then
case State of
osNeedPrevEnd: SetState(osNeedQso);
osNeedQso: ;
osNeedNr: ;
osNeedCall: ;
osNeedCallNr: ;
osNeedEnd: State := osDone;
end;
if (not Ini.Lids) and (AMsg = [msgGarbage]) then State := osNeedPrevEnd;
if State <> osNeedPrevEnd then DecPatience;
end;
function TDxOperator.GetReply: TStationMessage;
begin
case State of
osNeedPrevEnd, osDone, osFailed: Result := msgNone;
osNeedQso: Result := msgMyCall;
osNeedNr:
if (Patience = (FULL_PATIENCE-1)) or (Random < 0.3)
then Result := msgNrQm
else Result := msgAgn;
osNeedCall:
if (RunMode = rmHst) or (Random > 0.5) then Result := msgDeMyCallNr1
else if Random > 0.25 then Result := msgDeMyCallNr2
else Result := msgMyCallNr2;
osNeedCallNr:
if (RunMode = rmHst) or (Random > 0.5)
then Result := msgDeMyCall1
else Result := msgDeMyCall2;
else //osNeedEnd:
if Patience < (FULL_PATIENCE-1) then Result := msgNR
else if (RunMode = rmHst) or (Random < 0.9) then Result := msgR_NR
else Result := msgR_NR2;
end;
end;
end.