forked from VE3NEA/MorseRunner
-
Notifications
You must be signed in to change notification settings - Fork 12
/
MyStn.pas
245 lines (197 loc) · 5.33 KB
/
MyStn.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
//------------------------------------------------------------------------------
//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 MyStn;
interface
uses
Station, Classes, SndTypes;
type
TMyStation = class(TStation)
private
Pieces: TStringList;
procedure AddToPieces(AMsg: string);
procedure SendNextPiece;
public
MyEntity : String;
constructor CreateStation;
destructor Destroy; override;
procedure Init;
procedure SetWpm(const AWpmS : integer);
procedure ProcessEvent(AEvent: TStationEvent); override;
procedure AbortSend;
procedure SendText(AMsg: string); override;
function GetBlock: TSingleArray; override;
function UpdateCallInMessage(ACall: string): boolean;
end;
implementation
uses
ExchFields,
SysUtils, RndFunc, Ini, MorseKey, Contest, Main, DXCC;
{ TMyStation }
constructor TMyStation.CreateStation;
begin
inherited Create(nil);
Pieces := TStringList.Create;
Init;
end;
destructor TMyStation.Destroy;
begin
Pieces.Free;
inherited;
end;
procedure TMyStation.Init;
var
dxrec : TDXCCRec;
begin
inherited Init;
dxrec := nil;
MyCall := Ini.Call;
NR := 1;
RST := 599;
Pitch := Ini.Pitch;
WpmS := Ini.Wpm;
WpmC := WpmS;
Amplitude := 300000;
// invalidate SentExchTypes. Will be set by Tst.OnSetMyCall().
SentExchTypes := ExchTypesUndef;
// Adding a contest: Initialize Exch1 and Exch2
// (try to use the generalized Exch1 and Exch2 fields for new contests.)
OpName := HamName;
Exch1 := '3A';
Exch2 := 'OR';
// load my Entity string; used to filter user-text status messages
MyEntity := '';
if gDXCCList.FindRec(dxrec, MyCall) then
MyEntity := dxrec.Entity;
end;
{
Called by TMainForm.SetWpm whenever Wpm is updated via UI.
}
procedure TMyStation.SetWpm(const AWpmS : integer);
begin
if Ini.AllStationsWpmS > 0
then WpmS := Ini.AllStationsWpmS
else WpmS := AWpmS; // set via UI
if Tst.IsFarnsworthAllowed() and (Ini.FarnsworthCharRate > WpmS)
then WpmC := Ini.FarnsworthCharRate
else WpmC := WpmS;
end;
procedure TMyStation.ProcessEvent(AEvent: TStationEvent);
begin
if AEvent = evMsgSent then Tst.OnMeFinishedSending;
end;
procedure TMyStation.AbortSend;
begin
Envelope := nil;
Msg := [msgGarbage];
MsgText := '';
Pieces.Clear;
State := stListening;
ProcessEvent(evMsgSent);
end;
procedure TMyStation.SendText(AMsg: string);
begin
// Adding a contest: some field types have specific behaviors
if SentExchTypes.Exch1 = etOpName then
begin
assert(OpName = HamName, 'HamName doesn''t change; should already be set');
OpName := HamName;
end;
// Split message around '<his>' token to allow special callsign processing.
AddToPieces(AMsg);
if State <> stSending then
begin
SendNextPiece;
Tst.OnMeStartedSending;
end;
end;
procedure TMyStation.AddToPieces(AMsg: string);
var
p, i: integer;
begin
//split into pieces
//special processing of callsign
p := Pos('<his>', AMsg);
while p > 0 do
begin
if p > 1 then Pieces.Add(Copy(AMsg, 1, p-1));
Pieces.Add('@'); //his callsign indicator
Delete(AMsg, 1, p+4);
p := Pos('<his>', AMsg);
end;
if AMsg <> '' then Pieces.Add(AMsg);
// remove any empty pieces (there shouldn't be any)
// todo - this can be removed in the future.
for i:= Pieces.Count-1 downto 0 do
if Pieces[i] = '' then begin assert(false); Pieces.Delete(i); end;
end;
procedure TMyStation.SendNextPiece;
begin
MsgText := '';
if Pieces[0] <> '@' then
inherited SendText(Pieces[0])
else
if CallsFromKeyer and (not (RunMode in [rmHst, rmWpx])) then
inherited SendText(' ')
else
inherited SendText(HisCall);
end;
function TMyStation.GetBlock: TSingleArray;
begin
Result := inherited GetBlock;
if Envelope = nil then
begin
Pieces.Delete(0);
if Pieces.Count > 0 then SendNextPiece;
//cursor to exchange field
MainForm.Advance;
end;
end;
function TMyStation.UpdateCallInMessage(ACall: string): boolean;
var
NewEnvelope: TSingleArray;
i: integer;
begin
Result := false;
if ACall = '' then Exit;
NewEnvelope := nil;
//are we sending call now?
Result := (Pieces.Count > 0) and (Pieces[0] = '@');
//is the already sent part of the call the same as in the new call?
if Result then
begin
//create new envelope
Keyer.SetWpm(Self.WpmS, Self.WpmC);
Keyer.MorseMsg := Keyer.Encode(ACall);
NewEnvelope := Keyer.Envelope;
for i:=0 to High(NewEnvelope) do
NewEnvelope[i] := NewEnvelope[i] * Amplitude;
//compare to the old one
Result := Length(NewEnvelope) >= SendPos;
if Result then
for i:=0 to SendPos-1 do
begin
Result := Envelope[i] = NewEnvelope[i];
if not Result then Break;
end;
//update
if Result then
begin
Envelope := NewEnvelope;
HisCall := ACall;
end;
end;
//could not correct the current message
//but another call is scheduled for sending
if not Result then
for i:=1 to Pieces.Count-1 do
if Pieces[i] = '@' then
begin
Result := true;
HisCall := ACall;
Exit;
end;
end;
end.