refactor - introduce contest-specific message handling

ArrlFd.pas

@@ -7,7 +7,7 @@
 interface
 
 uses
-  Generics.Defaults, Generics.Collections, Contest, DxStn, Log;
+  Generics.Defaults, Generics.Collections, Contest, Station, DxStn, Log;
 
 type
   TFdCallRec = class
@@ -42,6 +42,7 @@ TArrlFieldDay = class(TContest)
   function getUserText(id:integer): string; // returns optional club name
   //function IsNum(Num: String): Boolean;
   function FindCallRec(out fdrec: TFdCallRec; const ACall: string): Boolean;
+  procedure SendMsg(const AStn: TStation; const AMsg: TStationMessage); override;
   function GetStationInfo(const ACallsign: string) : string; override;
   function ExtractMultiplier(Qso: PQso) : string; override;
 end;
@@ -156,6 +157,29 @@ function TArrlFieldDay.FindCallRec(out fdrec: TFdCallRec; const ACall: string):
 end;
 
 
+{
+  Overrides TContest.SendMsg() to send contest-specific messages.
+
+  Adding a contest: TContest.SendMsg(AMsg): send contest-specfic messages
+}
+procedure TArrlFieldDay.SendMsg(const AStn: TStation; const AMsg: TStationMessage);
+begin
+  case AMsg of
+    msgCQ: SendText(AStn, 'CQ FD <my>');
+    msgNrQm:
+      case Random(5) of
+        0,1: SendText(AStn, 'NR?');
+        2: SendText(AStn, 'SECT?');
+        3: SendText(AStn, 'CLASS?');
+        4: SendText(AStn, 'CL?');
+      end;
+    msgLongCQ: SendText(AStn, 'CQ CQ FD <my> <my> FD');  // QrmStation only
+    else
+      inherited SendMsg(AStn, AMsg);
+  end;
+end;
+
+
 // return status bar information string from field day call history file.
 // for DX stations, their Entity and Continent is also included.
 // this string is used in MainForm.sbar.Caption (status bar).

CWOPS.pas

@@ -3,7 +3,8 @@
 interface
 
 uses
-  Classes, Generics.Defaults, Generics.Collections, Contest, Contnrs, DxStn, Log;
+  Classes, Generics.Defaults, Generics.Collections, Contest, Contnrs,
+  Station, DxStn, Log;
 
 type
     TCWOPSRec= class
@@ -33,6 +34,7 @@   TCWOPS= class(TContest)
     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;
@@ -168,6 +170,30 @@ procedure TCWOPS.GetExchange(id : integer; out station : TDxStation);
 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)

Contest.pas

@@ -59,6 +59,8 @@   TContest = class
       const AStationKind : TStationKind;
       const ARequestedMsgType : TRequestedMsgType;
       const ADxCallsign : string) : TExchTypes; virtual;
+    procedure SendMsg(const AStn: TStation; const AMsg: TStationMessage); virtual;
+    procedure SendText(const AStn: TStation; const AMsg: string); virtual;
     function ExtractMultiplier(Qso: PQso) : string; virtual;
     function Minute: Single;
     function GetAudio: TSingleArray;
@@ -200,7 +202,7 @@ function TContest.OnSetMyCall(const AUserCallsign : string; out err : string) :
   function.
 
   Current behavior is to load the call history file. This action has been
-  defferred until now since some contests use the user's callsign to determine
+  deferred until now since some contests use the user's callsign to determine
   which stations can work other stations in the contest. For example, in the
   ARRL DX Contest, US/CA Stations work DX (non-US/CA) stations.
 
@@ -261,6 +263,53 @@ function TContest.GetExchangeTypes(
 end;
 
 
+{
+  This virtual procedure allows contest-specific messages to be implemented
+  in derived Contest classes.
+
+  When overridden by derived classes, if a message is not handled then this
+  base-class procedure should be called.
+  Please see ARRLFD.SendMsg for an example.
+}
+procedure TContest.SendMsg(const AStn: TStation; const AMsg: TStationMessage);
+begin
+  case AMsg of
+    msgCQ: SendText(AStn, 'CQ <my> TEST');
+    msgNR: SendText(AStn, '<#>');
+    msgTU: SendText(AStn, 'TU');
+    msgMyCall: SendText(AStn, '<my>');
+    msgHisCall: SendText(AStn, '<his>');
+    msgB4: SendText(AStn, 'QSO B4');
+    msgQm: SendText(AStn, '?');
+    msgNil: SendText(AStn, 'NIL');
+    msgR_NR: SendText(AStn, 'R <#>');
+    msgR_NR2: SendText(AStn, 'R <#> <#>');
+    msgDeMyCall1: SendText(AStn, 'DE <my>');
+    msgDeMyCall2: SendText(AStn, 'DE <my> <my>');
+    msgDeMyCallNr1: SendText(AStn, 'DE <my> <#>');
+    msgDeMyCallNr2: SendText(AStn, 'DE <my> <my> <#>');
+    msgMyCallNr2: SendText(AStn, '<my> <my> <#>');
+    msgNrQm: SendText(AStn, 'NR?');
+    msgLongCQ: SendText(AStn, 'CQ CQ TEST <my> <my> TEST');  // QrmStation only
+    msgQrl: SendText(AStn, 'QRL?');
+    msgQrl2: SendText(AStn, 'QRL?   QRL?');
+    msqQsy: SendText(AStn, '<his>  QSY QSY');
+    msgAgn: SendText(AStn, 'AGN');
+  end;
+end;
+
+
+{
+  This virtual procedure is provided to allow a derived contest the ability
+  to perform additional processing on the message, including token replacement,
+  before being passed to the Encoder and Keyer.
+}
+procedure TContest.SendText(const AStn: TStation; const AMsg: string);
+begin
+  AStn.SendText(AMsg);  // virtual
+end;
+
+
 {
   Extract multiplier string for a given contest. Default behavior will
   return the QSO.Pfx string (which implies this method must be called

DxStn.pas

@@ -19,7 +19,6 @@   TDxStation = class(TStation)
     constructor CreateStation;
     destructor Destroy; override;
     procedure ProcessEvent(AEvent: TStationEvent); override;
-    procedure SendMsg(AMsg: TStationMessage); override;
     procedure DataToLastQso;
     function GetBlock: TSingleArray; override;
   var
@@ -169,25 +168,6 @@ procedure TDxStation.ProcessEvent(AEvent: TStationEvent);
 end;
 
 
-// override SendMsg to allow Dx Stations to send alternate field day messages
-// (SECT?, CLASS?, CL?) whenever a 'NR?' message (msgNrQm) is sent.
-procedure TDxStation.SendMsg(AMsg: TStationMessage);
-begin
-  if (SimContest = scFieldDay) and
-    (AMsg = msgNrQm) then
-    begin
-      case Random(5) of
-        0,1: SendText('NR?');
-        2: SendText('SECT?');
-        3: SendText('CLASS?');
-        4: SendText('CL?');
-      end;
-    end
-  else
-    inherited SendMsg(AMsg);
-end;
-
-
 // copies data from this DxStation to top of QsoList[].
 // removes Self from Stations[] container array.
 procedure TDxStation.DataToLastQso;

Station.pas

@@ -55,7 +55,7 @@   TStation = class (TCollectionItem)
   public
     Amplitude: Single;
     Wpm: integer;
-    Envelope: TSingleArray;
+    Envelope: TSingleArray; // this station's digitized Envelope being sent
     State: TStationState;
 
     // Sent Exchange field types...
@@ -77,7 +77,7 @@   TStation = class (TCollectionItem)
     UserText: string; // club name or description (from fdHistory file)
 
     Msg: TStationMessages;
-    MsgText: string;
+    MsgText: string;  // this station's current message being sent
 
     constructor CreateStation;
 
@@ -104,6 +104,8 @@ implementation
 uses
   Main,     // for Mainform.sbar.Caption, BDebugCwDecoder
   QrmStn,   // for TQrmStation.ClassType
+  Contest,  // for Tst (TContest)
+  StrUtils, // for PosEx
   SysUtils, Math, MorseKey;
 
 
@@ -159,67 +161,41 @@ procedure TStation.SendMsg(AMsg: TStationMessage);
   if (AMsg = msgTU) and BDebugCwDecoder and not (self is TQrmStation) then
     Mainform.sbar.Caption:= '';
 
-  case AMsg of
-    msgCQ: begin
-      // Adding a contest: TStation.SendMsg(msgCQ): send CQ message (e.g. CQ FD <my>)
-      case SimContest of
-        scCwt: SendText('CQ CWT <my>');
-        scFieldDay: SendText('CQ FD <my>');
-        else SendText('CQ <my> TEST');
-      end;
-    end;
-    msgNR: SendText('<#>');
-    msgTU: SendText('TU');
-    msgMyCall: SendText('<my>');
-    msgHisCall: SendText('<his>');
-    msgB4: SendText('QSO B4');
-    msgQm: SendText('?');
-    msgNil: SendText('NIL');
-    msgR_NR: begin
-      // Adding a contest: TStation.SendMsg(msgR_NR): send 'R <#>' message, where # is exch (e.g. 3A OR)
-      case SimContest of
-        scCwt:
-          if (random < 0.9)
-            then SendText('<#>')
-            else SendText('R <#>');
-      else
-        SendText('R <#>');
-      end;
-    end;
-    msgR_NR2: begin
-      // Adding a contest: TStation.SendMsg(msgR_NR2): send 'R <#> <#>' message, where # is exch (e.g. 3A OR)
-      case SimContest of
-        scCwt:
-          if (random < 0.9)
-            then SendText('<#> <#>')
-            else SendText('R <#> <#>');
-      else
-        SendText('R <#> <#>');
-      end;
-    end;
-    msgDeMyCall1: SendText('DE <my>');
-    msgDeMyCall2: SendText('DE <my> <my>');
-    msgDeMyCallNr1: SendText('DE <my> <#>');
-    msgDeMyCallNr2: SendText('DE <my> <my> <#>');
-    msgMyCallNr2: SendText('<my> <my> <#>');
-    msgNrQm: SendText('NR?');
-    msgLongCQ:
-      begin
-        case SimContest of
-          scFieldDay: SendText('CQ CQ FD <my> <my>');
-          scCwt: SendText('CQ CQ CWT <my>');
-        else
-          SendText('CQ CQ TEST <my> <my> TEST');
-        end;
-      end;
-    msgQrl: SendText('QRL?');
-    msgQrl2: SendText('QRL?   QRL?');
-    msqQsy: SendText('<his>  QSY QSY');
-    msgAgn: SendText('AGN');
-    end;
+  // Create contest-specific messages...
+  Tst.SendMsg(self, AMsg);
 end;
 
+{
+  Handle station-specific messaging by replacing message tokens with
+  their respective values. The resulting message is then passed to
+  Keyer.Encode() and SendMorse().
+}
 procedure TStation.SendText(AMsg: string);
+var
+  P : integer;
+
+  // Modifies AMsg by replacing AToken at position P with ANewText and
+  // advances the token offset P to the start of the next token.
+  // Successive occurances of the same token are replaced in one call.
+  // Returns true when no additional tokens are available.
+  function ReplaceTokenAt(
+    var AMsg : string;      // in/out: message to be modified
+    var P : integer;        // in/out: current token offset; advanced to next
+    const AToken : string;  // token to be replaced
+    const ANewText : string // NewText to replace token
+    ) : boolean;            // return true when no additional tokens available
+  begin
+    // loop with valid token and look for successive matches of current token
+    while (P > 0) and (PosEx(AToken, AMsg, P) = P) do
+      begin
+        AMsg := StuffString(AMsg, P, AToken.Length, ANewText);
+        P := PosEx('<', AMsg, P);
+      end;
+
+    // return whether no additional tokens are present in string.
+    Result := (P = 0);
+  end;
+
 begin
   if Pos('<#>', AMsg) > 0 then
     begin
@@ -229,7 +205,12 @@ procedure TStation.SendText(AMsg: string);
     AMsg := StringReplace(AMsg, '<#>', NrAsText, [rfReplaceAll]);
     end;
 
-  AMsg := StringReplace(AMsg, '<my>', MyCall, [rfReplaceAll]);
+  // replace tokens with actual values
+  P := Pos('<', AMsg);
+  while (P > 0) do
+    begin
+      if ReplaceTokenAt(AMsg, P, '<my>', MyCall) then Break;
+    end;
 
 {
   if CallsFromKeyer