188 add Farnsworth timing to k1usn SST Contest

CWSST.pas

@@ -117,6 +117,8 @@ constructor TCWSST.Create;
     inherited Create;
     CWSSTList:= TObjectList<TCWSSTRec>.Create;
     Comparer := TComparer<TCWSSTRec>.Construct(TCWSSTRec.compareCall);
+
+    BFarnsworthEnabled := true;
 end;
 
 destructor TCWSST.Destroy;

Contest.pas

@@ -20,6 +20,8 @@   TContest = class
     procedure SwapFilters;
 
   protected
+    BFarnsworthEnabled : Boolean; // enables Farnsworth timing (e.g. SST Contest)
+
     constructor Create;
     function IsReloadRequired(const AUserCallsign : String) : boolean;
     procedure SetLastLoadCallsign(const AUserCallsign : String);
@@ -48,6 +50,7 @@   TContest = class
     function OnSetMyCall(const AUserCallsign : string; out err : string) : boolean; virtual;
     function OnContestPrepareToStart(const AUserCallsign: string;
       const ASentExchange : string) : Boolean; virtual;
+    function IsFarnsworthAllowed : Boolean;
     function GetSentExchTypes(
       const AStationKind : TStationKind;
       const AMyCallsign : string) : TExchTypes;
@@ -108,6 +111,7 @@ constructor TContest.Create;
   Agc.AgcEnabled := true;
   NoActivityCnt :=0;
   LastLoadCallsign := '';
+  BFarnsworthEnabled := false;
 
   Init;
 end;
@@ -131,6 +135,7 @@ procedure TContest.Init;
   Stations.Clear;
   BlockNumber := 0;
   LastLoadCallsign := '';
+  BFarnsworthEnabled := false;
 end;
 
 
@@ -153,6 +158,18 @@ procedure TContest.SetLastLoadCallsign(const AUserCallsign : String);
 end;
 
 
+{
+  Farnsworth timing is supported by certain contests only (initially the
+  K1USN SST Contest). Derived contests will set BFarnworthEnabled in their
+  TContest.Create() method.
+}
+function TContest.IsFarnsworthAllowed : Boolean;
+begin
+  Result := BFarnsworthEnabled;
+end;
+
+
+
 {
   GetStationInfo() returns station's DXCC information.
 

DxOper.pas

@@ -32,7 +32,7 @@   TDxOperator = class
     State: TOperatorState;
     function GetSendDelay: integer;
     function GetReplyTimeout: integer;
-    function GetWpm: integer;
+    function GetWpm(out AWpmC : integer) : integer;
     function GetNR: integer;
     function GetName: string;
     procedure MsgReceived(AMsg: TStationMessages);
@@ -65,7 +65,7 @@ function TDxOperator.GetSendDelay: integer;
     Result := SecondsToBlocks(0.1 + 0.5*Random);
 end;
 
-function TDxOperator.GetWpm: integer;
+function TDxOperator.GetWpm(out AWpmC : integer): integer;
 var
   mean, limit: Single;
 begin
@@ -81,6 +81,16 @@ function TDxOperator.GetWpm: integer;
     end
   else                      { use Random value, [Wpm-Min,Wpm+Max] }
     Result := Round(Ini.Wpm - MinRxWpm + (MinRxWpm + MaxRxWpm) * Random);
+
+  // optionally force all stations to use same speed (debugging and timing)
+  if Ini.AllStationsWpmS > 10 then
+    Result := Ini.AllStationsWpmS;
+
+  // Allow Farnsworth timing for certain contests
+  if Tst.IsFarnsworthAllowed() and (Result < Ini.FarnsworthCharRate) then
+    AWpmC := Ini.FarnsworthCharRate
+  else
+    AWpmC := Result;
 end;
 
 function TDxOperator.GetNR: integer;

DxStn.pas

@@ -56,7 +56,8 @@ constructor TDxStation.CreateStation;
   Oper.SetState(osNeedPrevEnd);
   NrWithError := Ini.Lids and (Random < 0.1);
 
-  WpmS := Oper.GetWpm;
+  // DX's speed, {WpmS,WpmC}, is set once at creation time
+  WpmS := Oper.GetWpm(WpmC);
 
   // DX's sent exchange types depends on kind-of-station and their callsign
   SentExchTypes := Tst.GetSentExchTypes(skDxStation, MyCall);

Ini.pas

@@ -202,6 +202,8 @@   TContestDefinition = record
   CompDuration: integer = 60;
 
   SaveWav: boolean = false;
+  FarnsworthCharRate: integer = 25;
+  AllStationsWpmS: integer = 0;      // force all stations to this Wpm
   CallsFromKeyer: boolean = false;
   F8: string = '';
 
@@ -309,11 +311,13 @@ procedure FromIni;
       SaveWav := ReadBool(SEC_STN, 'SaveWav', SaveWav);
 
       // [Settings]
+      FarnsworthCharRate := ReadInteger(SEC_SET, 'FarnsworthCharacterRate', FarnsworthCharRate);
 
       // [Debug]
       DebugExchSettings := ReadBool(SEC_DBG, 'DebugExchSettings', DebugExchSettings);
       DebugCwDecoder := ReadBool(SEC_DBG, 'DebugCwDecoder', DebugCwDecoder);
       DebugGhosting := ReadBool(SEC_DBG, 'DebugGhosting', DebugGhosting);
+      AllStationsWpmS := ReadInteger(SEC_DBG, 'AllStationsWpmS', AllStationsWpmS);
       F8 := ReadString(SEC_DBG, 'F8', F8);
     finally
       Free;
@@ -379,6 +383,8 @@ procedure ToIni;
       WriteInteger(SEC_STN, 'SelfMonVolume', V);
 
       WriteBool(SEC_STN, 'SaveWav', SaveWav);
+
+      WriteInteger(SEC_SET, 'MinFarnsworthWpmC', FarnsworthCharRate);
     finally
       Free;
     end;

Log.pas

@@ -19,6 +19,7 @@ procedure CheckErr;
 //procedure PaintHisto;
 procedure ShowRate;
 procedure ScoreTableSetTitle(const ACol1, ACol2, ACol3, ACol4, ACol5, ACol6, ACol7 :string);
+procedure ScoreTableScaleWidth(const ACol : integer; const AScaleWidth : Single);
 procedure ScoreTableInsert(const ACol1, ACol2, ACol3, ACol4, ACol5, ACol6, ACol7 :string);
 procedure ScoreTableUpdateCheck;
 function FormatScore(const AScore: integer):string;
@@ -38,7 +39,7 @@   TQso = record
     Nr, TrueNr: integer;
     Exch1, TrueExch1: string;   // exchange 1 (e.g. 3A, OpName)
     Exch2, TrueExch2: string;   // exchange 2 (e.g. OR, CWOPSNum)
-    TrueWpm: integer;           // WPM of sending DxStn (reported in log)
+    TrueWpm: string;            // WPM of sending DxStn (reported in log)
     Pfx: string;                // extracted call prefix
     MultStr: string;            // contest-specific multiplier (e.g. Pfx, dxcc)
     Points: integer;            // points for this QSO
@@ -185,6 +186,23 @@ procedure ScoreTableSetTitle(const ACol1, ACol2, ACol3, ACol4, ACol5, ACol6, ACo
   SetCaption(6, ACol7);
 end;
 
+{
+  Adjust the Log Table column width by AScaleWidth scaling factor.
+  This scaling number is multiplied by the original column width from the UI.
+  Typical usage is to increase the width of a column for a given contest.
+  For example, the SST contest will increase the column width from 3 to 5
+  characters by using 'ScoreTableScaleWidth(6, 5.0/3)' or to increase width
+  by 40% use 'ScoreTableScaleWidth(6, 1.4)'.
+  This method can also be used to set the column width to zero if desired.
+  Note that whenever a new contest is started, the column widths are restored
+  to their original column widths.
+}
+procedure ScoreTableScaleWidth(const ACol : integer; const AScaleWidth : Single);
+begin
+  assert(LogColWidthInitialized, 'must be called after ScoreTableSetTitle');
+  MainForm.ListView2.Column[ACol].Width:= Ceil(AScaleWidth * LogColWidths[ACol]);
+end;
+
 procedure ScoreTableInsert(const ACol1, ACol2, ACol3, ACol4, ACol5, ACol6, ACol7 :string);
 begin
   with MainForm.ListView2.Items.Add do begin
@@ -248,7 +266,12 @@ procedure Clear;
       scCwt:
         ScoreTableSetTitle('UTC', 'Call', 'Name', 'Exch', '', 'Chk', 'Wpm');
       scSst:
-        ScoreTableSetTitle('UTC', 'Call', 'Name', 'Exch', '', 'Chk', 'Wpm');
+        begin
+        ScoreTableSetTitle('UTC', 'Call', 'Name', 'Exch', '', 'Chk', ' Wpm');
+        ScoreTableScaleWidth(3, 0.75);  // shrink Exch column
+        ScoreTableScaleWidth(5, 1.2);   // expand Chk column for 'NAME' error
+        ScoreTableScaleWidth(6, 1.4);   // expand Wpm column for 22/25 Farnsworth
+        end;
       scFieldDay:
         ScoreTableSetTitle('UTC', 'Call', 'Class', 'Section', 'Pref', 'Chk', 'Wpm');
       scNaQp:
@@ -258,7 +281,10 @@ procedure Clear;
       scArrlDx:
         ScoreTableSetTitle('UTC', 'Call', 'Recv', 'Sent', 'Pref', 'Chk', 'Wpm');
       scAcag:
+        begin
         ScoreTableSetTitle('UTC', 'Call', 'Recv', 'Sent', 'City', 'Chk', 'Wpm');
+        ScoreTableScaleWidth(4, 1.2);   // expand City column for wide numbers
+        end;
       else
         ScoreTableSetTitle('UTC', 'Call', 'Recv', 'Sent', 'Pref', 'Chk', 'Wpm');
     end;
@@ -616,7 +642,7 @@ procedure SaveQso;
         with Tst.Stations[i] as TDxStation do
           if (MyCall = Qso.Call) then
           begin
-            Qso.TrueWpm := Wpm;
+            Qso.TrueWpm := WpmAsText();
             Break;
           end;
 
@@ -654,46 +680,51 @@ procedure LastQsoToScreen;
   with QsoList[High(QsoList)] do begin
     // Adding a contest: LastQsoToScreen, add last qso to Score Table
     case Ini.SimContest of
-    scCwt, scSst:
+    scCwt:
+      ScoreTableInsert(FormatDateTime('hh:nn:ss', t), Call
+        , Exch1
+        , Exch2
+        , Pfx, Err, format('%3s', [TrueWpm]));
+    scSst:
       ScoreTableInsert(FormatDateTime('hh:nn:ss', t), Call
         , Exch1
         , Exch2
-        , Pfx, Err, format('%.2d', [TrueWpm]));
+        , Pfx, Err, format('%5s', [TrueWpm]));
     scFieldDay:
       ScoreTableInsert(FormatDateTime('hh:nn:ss', t), Call
         , Exch1
         , Exch2
-        , Pfx, Err, format('%.2d', [TrueWpm]));
+        , Pfx, Err, format('%3s', [TrueWpm]));
     scNaQp:
       ScoreTableInsert(FormatDateTime('hh:nn:ss', t), Call
         , Exch1
         , Exch2
-        , Pfx, Err, format('%.2d', [TrueWpm]));
+        , Pfx, Err, format('%3s', [TrueWpm]));
     scWpx, scHst:
       ScoreTableInsert(FormatDateTime('hh:nn:ss', t), Call
         , format('%.3d %.4d', [Rst, Nr])
         , format('%.3d %.4d', [Tst.Me.Rst, Tst.Me.NR])
-        , Pfx, Err, format('%.3d', [TrueWpm]));
+        , Pfx, Err, format('%3s', [TrueWpm]));
     scCQWW:
       ScoreTableInsert(FormatDateTime('hh:nn:ss', t), Call
         , format('%.3d %4d', [Rst, NR])
         , format('%.3s %4d', [Tst.Me.Exch1, Tst.Me.NR])     // log my sent RST
-        , Pfx, Err, format('%.3d', [TrueWpm]));
+        , Pfx, Err, format('%3s', [TrueWpm]));
     scArrlDx:
       ScoreTableInsert(FormatDateTime('hh:nn:ss', t), Call
         , format('%.3d %4s', [Rst, Exch2])
         , format('%.3s %4s', [Tst.Me.Exch1, Tst.Me.Exch2])  // log my sent RST
-        , Pfx, Err, format('%.2d', [TrueWpm]));
+        , Pfx, Err, format('%3s', [TrueWpm]));
     scAllJa:
       ScoreTableInsert(FormatDateTime('hh:nn:ss', t), Call
         , format('%.3d %4s', [Rst, Exch2])
         , format('%.3s %4s', [Tst.Me.Exch1, Tst.Me.Exch2])  // log my sent RST
-        , MultStr, Err, format('%.2d', [TrueWpm]));
+        , MultStr, Err, format('%3s', [TrueWpm]));
     scAcag:
       ScoreTableInsert(FormatDateTime('hh:nn:ss', t), Call
         , format('%.3d %4s', [Rst, Exch2])
         , format('%.3s %4s', [Tst.Me.Exch1, Tst.Me.Exch2])  // log my sent RST
-        , MultStr, Err, format('%.2d', [TrueWpm]));
+        , MultStr, Err, format('%3s', [TrueWpm]));
     else
       assert(false, 'missing case');
     end;

Main.pas

@@ -423,7 +423,7 @@ implementation
 
 uses
   ARRL, ARRLFD, NAQP, CWOPS, CQWW, CQWPX, ARRLDX, CWSST, ALLJA, ACAG,
-  MorseKey, CallLst,
+  MorseKey, FarnsKeyer, CallLst,
   SysUtils, ShellApi, Crc32, Idhttp, Math, IniFiles,
   Dialogs, System.UITypes, TypInfo, ScoreDlg, Log, PerlRegEx, StrUtils;
 
@@ -477,9 +477,7 @@ procedure TMainForm.FormCreate(Sender: TObject);
   BDebugExchSettings := CDebugExchSettings or Ini.DebugExchSettings;
   BDebugCwDecoder := CDebugCwDecoder or Ini.DebugCwDecoder;
 
-  MakeKeyer;
-  Keyer.Rate := DEFAULTRATE;
-  Keyer.BufSize := Ini.BufSize;
+  MakeKeyer(DEFAULTRATE, Ini.BufSize);
 
   // create a derived TContest of the appropriate type
   SetContest(Ini.SimContest);
@@ -965,6 +963,13 @@ procedure TMainForm.SetContest(AContestNum: TSimContest);
   // create new contest
   Tst := CreateContest(AContestNum);
 
+  // load original or Farnsworth Keyer
+  FreeAndNil(Keyer);
+  if SimContest in [scSST] then
+    Keyer := TFarnsKeyer.Create(DEFAULTRATE, Ini.BufSize)
+  else
+    Keyer := TKeyer.Create(DEFAULTRATE, Ini.BufSize);
+
   // the following will initialize simulation-specific data owned by contest.
   // (moved here from Ini.FromIni)
   begin

MorseRunner.dpr

@@ -9,6 +9,7 @@ uses
   Ini in 'Ini.pas',
   Station in 'Station.pas',
   MorseKey in 'VCL\MorseKey.pas',
+  FarnsKeyer in 'VCL\FarnsKeyer.pas',
   StnColl in 'StnColl.pas',
   DxStn in 'DxStn.pas',
   MyStn in 'MyStn.pas',

MorseRunner.dproj

@@ -124,6 +124,7 @@
         <DCCReference Include="Ini.pas"/>
         <DCCReference Include="Station.pas"/>
         <DCCReference Include="VCL\MorseKey.pas"/>
+        <DCCReference Include="VCL\FarnsKeyer.pas"/>
         <DCCReference Include="StnColl.pas"/>
         <DCCReference Include="DxStn.pas"/>
         <DCCReference Include="MyStn.pas"/>

MyStn.pas

@@ -60,6 +60,7 @@ procedure TMyStation.Init;
   RST := 599;
   Pitch := Ini.Pitch;
   WpmS := Ini.Wpm;
+  WpmC := WpmS;
   Amplitude := 300000;
 
   // invalidate SentExchTypes. Will be set by Tst.OnSetMyCall().
@@ -78,7 +79,12 @@ procedure TMyStation.Init;
 }
 procedure TMyStation.SetWpm(const AWpmS : integer);
 begin
-  WpmS := AWpmS;   // set via UI
+  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;
 
 
@@ -186,7 +192,7 @@ function TMyStation.UpdateCallInMessage(ACall: string): boolean;
   if Result then
     begin
     //create new envelope
-    Keyer.WpmS := Wpm;
+    Keyer.SetWpm(Self.WpmS, Self.WpmC);
     Keyer.MorseMsg := Keyer.Encode(ACall);
     NewEnvelope := Keyer.Envelope;
     for i:=0 to High(NewEnvelope) do

QrmStn.pas

@@ -36,6 +36,7 @@ constructor TQrmStation.CreateStation;
   Amplitude := 5000 + 25000 * Random;
   Pitch := Round(RndGaussLim(0, 300));
   WpmS := 30 + Random(20);
+  WpmC := WpmS;
 
   // DX's sent exchange types depends on kind-of-station and their callsign
   SentExchTypes:= Tst.GetSentExchTypes(skDxStation, MyCall);