ARRL SS - display parsed exchange summary (#357)

ArrlSS.pas

@@ -52,7 +52,7 @@ TSweepstakes = class(TContest)
   procedure SendMsg(const AStn: TStation; const AMsg: TStationMessage); override;
   procedure OnWipeBoxes; override;
   function OnExchangeEdit(const ACall, AExch1, AExch2: string;
-    out AExchSummary: string) : Boolean; override;
+    out AExchSummary: string; out AExchError: string) : Boolean; override;
   procedure OnExchangeEditComplete; override;
   procedure SetHisCall(const ACall: string); override;
   function CheckEnteredCallLength(const ACall: string;
@@ -177,7 +177,7 @@ function TSweepstakes.ValidateMyExchange(const AExchange: string;
 const
   // Syntax: [123|#][ ]<Precedence> <Check> <Section>
   Regexpr: string = ' *(?P<exch1>(?P<nr>[0-9]+|#)? *(?P<prec>[QABUMS])) +'
-                  + '(?P<chk>[0-9]{2}) +(?P<sect>[A-Z]+) *';
+                  + '(?P<chk>[0-9]{2}) +(?P<sect>[A-Z]{2,3}) *';
 var
   reg: TPerlRegEx;
   Exch1, Exch2: string;
@@ -319,17 +319,20 @@ procedure TSweepstakes.SetHisCall(const ACall: string);
   Overriden here to handle complex ARRL Sweepstakes exchange.
   Returns whether Exchange summary is non-empty.
 }
-function TSweepstakes.OnExchangeEdit(
-  const ACall, AExch1, AExch2: string; out AExchSummary: string) : Boolean;
-var
-  ExchError: string;
+function TSweepstakes.OnExchangeEdit(const ACall, AExch1, AExch2: string;
+  out AExchSummary: string; out AExchError: string) : Boolean;
 begin
-  // incrementally parse the exchange with each keystroke
-  ExchValidator.ValidateEnteredExchange(ACall, AExch1, AExch2, ExchError);
+  if Ini.ShowExchangeSummary <> 0 then
+    begin
+      // incrementally parse the exchange with each keystroke
+      ExchValidator.ValidateEnteredExchange(ACall, AExch1, AExch2, AExchError);
 
-  // return summary (displayed above Exch2's Caption)
-  AExchSummary := ExchValidator.ExchSummary;
-  Result := not AExchSummary.IsEmpty;
+      // return summary (displayed above Exch2's Caption)
+      AExchSummary := ExchValidator.ExchSummary;
+      Result := not AExchSummary.IsEmpty;
+    end
+  else
+    Result := False;
 end;
 
 

Contest.pas

@@ -74,7 +74,7 @@   TContest = class
     procedure SendText(const AStn: TStation; const AMsg: string); virtual;
     procedure OnWipeBoxes; virtual;
     function OnExchangeEdit(const ACall, AExch1, AExch2: string;
-       out AExchSummary: string) : Boolean; virtual;
+       out AExchSummary: string; out AExchError: string) : Boolean; virtual;
     procedure OnExchangeEditComplete; virtual;
     procedure SetHisCall(const ACall: string); virtual;
 
@@ -100,6 +100,7 @@ implementation
 uses
   SysUtils, RndFunc, Math, DxOper,
   PerlRegEx,
+  VCL.Graphics,       // clDefault
   Main, CallLst, DXCC;
 
 { TContest }
@@ -203,7 +204,7 @@ function TContest.GetRandomSerialNR: Integer;
 {
   GetStationInfo() returns station's DXCC information.
 
-  Adding a contest: UpdateSbar - update status bar with station info (e.g. FD shows UserText)
+  Adding a contest: SbarUpdateStationInfo - update status bar with station info (e.g. FD shows UserText)
   Override as needed for each contest.
 }
 function TContest.GetStationInfo(const ACallsign : string) : string;
@@ -442,16 +443,16 @@ procedure TContest.SendText(const AStn: TStation; const AMsg: string);
 }
 procedure TContest.OnWipeBoxes;
 begin
-  Log.CallSent := False;
   Log.NrSent := False;
+  Log.DisplayError('', clDefault);
 end;
 
 
 {
   Called after each keystroke of the Exch2 field (Edit3).
 }
 function TContest.OnExchangeEdit(const ACall, AExch1, AExch2: string;
-  out AExchSummary: string) : Boolean;
+  out AExchSummary: string; out AExchError: string) : Boolean;
 begin
   AExchSummary := '';
   Result := False;
@@ -480,7 +481,7 @@ procedure TContest.OnExchangeEditComplete;
 }
 procedure TContest.SetHisCall(const ACall: string);
 begin
-  Self.Me.HisCall := ACall;
+  if ACall <> '' then Self.Me.HisCall := ACall;
   Log.CallSent := ACall <> '';
 end;
 
@@ -764,7 +765,19 @@ function TContest.GetAudio: TSingleArray;
                 Log.UpdateStatsHst
               else
                 Log.UpdateStats({AVerifyResults=}True);
+
+{
+              This code can be used to clear QSO info after 'TU' is sent.
+              However, this may be a multi-threading issue here because
+              this audio thread will be changing things being manipulated
+              by the GUI thread. Need more time to think through this one.
+
+              // clear any errors/status from last QSO
+              Log.DisplayError('', clDefault);
+              Log.SBarUpdateSummary('');
+}
           end;
+
   //show info
   ShowRate;
   MainForm.Panel2.Caption := FormatDateTime('hh:nn:ss', BlocksToSeconds(BlockNumber) /  86400);

ExchFields.pas

@@ -66,7 +66,7 @@   TFieldDefinition = record
    ,(C: 'State';      R: '([0-9A-Z/]*)';                   L: 6; T:Ord(etNaQpExch2))
    ,(C: 'State';      R: '()|([0-9A-Z/]*)';                L: 6; T:Ord(etNaQpNonNaExch2))
    ,(C: 'Nr Prec CK Sect';
-                      R: '[0-9ONT]{1,2} +[A-Z]+';          L: 32; T:Ord(etSSCheckSection))
+                      R: '[0-9ONT]{1,2} +[A-Z]{2,3}';      L: 32; T:Ord(etSSCheckSection))
   );
 
 implementation

Ini.pas

@@ -255,6 +255,7 @@   TContestDefinition = record
   NoStopActivity: integer=0;
   GetWpmUsesGaussian: boolean = false;
   ShowCheckSection: integer=50;
+  ShowExchangeSummary: integer = 1; // 0=Off, 1=Above Field, 2=Status Bar
 
   Duration: integer = 30;
   RunMode: TRunMode = rmStop;
@@ -434,6 +435,7 @@ procedure FromIni(cb : TErrMessageCallback);
       RitStepIncr := ReadInteger(SEC_SET, 'RitStepIncr', RitStepIncr);
       RitStepIncr := Max(-500, Min(500, RitStepIncr));
       ShowCheckSection := ReadInteger(SEC_SET, 'ShowCheckSection', ShowCheckSection);
+      ShowExchangeSummary := ReadInteger(SEC_SET, 'ShowExchangeSummary', ShowExchangeSummary);
 
       // [Debug]
       DebugExchSettings := ReadBool(SEC_DBG, 'DebugExchSettings', DebugExchSettings);
@@ -517,6 +519,7 @@ procedure ToIni;
       WriteInteger(SEC_SET, 'WpmStepRate', WpmStepRate);
       WriteInteger(SEC_SET, 'RitStepIncr', RitStepIncr);
       WriteInteger(SEC_SET, 'ShowCheckSection', ShowCheckSection);
+      WriteInteger(SEC_SET, 'ShowExchangeSummary', ShowExchangeSummary);
 
     finally
       Free;

Log.pas

@@ -26,7 +26,10 @@ procedure SetExchColumns(AExch1ColPos, AExch2ColPos: integer;
 procedure ScoreTableInsert(const ACol1, ACol2, ACol3, ACol4, ACol5, ACol6: string; const ACol7: string = ''; const ACol8: string = '');
 procedure ScoreTableUpdateCheck;
 function FormatScore(const AScore: integer):string;
-procedure UpdateSbar(const ACallsign: string);
+procedure UpdateSbar;
+procedure SbarUpdateStationInfo(const ACallsign: string);
+procedure SBarUpdateSummary(const AExchSummary: String);
+procedure SBarUpdateDebugMsg(const AMsgText: string);
 procedure DisplayError(const AExchError: string; const AColor: TColor);
 function ExtractCallsign(Call: string): string;
 function ExtractPrefix(Call: string; DeleteTrailingLetters: boolean = True): string;
@@ -119,7 +122,12 @@   TMultList= class(TStringList)
   VerifiedPoints:   integer;   // accumulated verified QSO points total
   CallSent: boolean; // msgHisCall has been sent; cleared upon edit.
   NrSent: boolean;   // msgNR has been sent; cleared after qso is completed.
-  ShowCorrections: boolean;    // show exchange correction column.
+  ShowCorrections: boolean;   // show exchange correction column.
+  SBarDebugMsg: String;         // sbar debug message
+  SBarStationInfo: String;    // sbar station info (UserText from call history file)
+  SBarSummaryMsg: String;     // sbar exchange summary (ARRL SS)
+  SBarErrorMsg: String;       // sbar exchange error
+  SBarErrorColor: TColor;     // sbar exchange error color
   Histo: THisto;
 
   // the following column index values are used to set error flags in TQso.ColumnErrorFlags
@@ -198,6 +206,7 @@ implementation
 {$ifdef DEBUG}
   Indent: Integer = 0;    // used by DebugLnEnter/DebugLnExit
 {$endif}
+  SBarLastCallsign: String;       // used to optimize SBrSetStationInfo
 
 constructor THisto.Create(APaintBox: TPaintBOx);
 begin
@@ -395,45 +404,107 @@ procedure ScoreTableInsert(const ACol1, ACol2, ACol3, ACol4, ACol5, ACol6, ACol7
   end;
   MainForm.ListView2.Items.EndUpdate;
 
-  //UpdateSbar(MainForm.ListView2.Items.Count);
   MainForm.ListView2.Perform(WM_VSCROLL, SB_BOTTOM, 0);
 end;
 
 //Update Callsign info
-procedure UpdateSbar(const ACallsign: string);
+procedure SbarUpdateStationInfo(const ACallsign: string);
 var
   s: string;
 begin
+  if ACallSign = SBarLastCallsign then Exit;
+  SBarLastCallsign := ACallsign;
+
   s:= '';
   if not ACallsign.IsEmpty then
   begin
-    // Adding a contest: UpdateSbar - update status bar with station info (e.g. FD shows UserText)
+    // Adding a contest: SbarUpdateStationInfo - update status bar with station info (e.g. FD shows UserText)
     s := Tst.GetStationInfo(ACallsign);
 
     // '&' are suppressed in this control; replace with '&&'
     s:= StringReplace(s, '&', '&&', [rfReplaceAll]);
   end;
 
+  SBarStationInfo := s;
+  UpdateSbar;
+end;
+
+
+procedure SBarUpdateSummary(const AExchSummary: String);
+begin
+  if SBarSummaryMsg = AExchSummary then Exit;
+
+  SBarSummaryMsg := AExchSummary;
+  UpdateSbar;
+end;
+
+
+
+procedure SBarUpdateDebugMsg(const AMsgText: string);
+begin
+  if SBarDebugMsg = AMsgText then Exit;
+
+  if AMsgText.IsEmpty then
+    SBarDebugMsg := ''
+  else
+    SBarDebugMsg := (AMsgText + '; ' + SBarDebugMsg).Substring(0, 40);
+  UpdateSbar;
+end;
+
+// Refresh Status Bar
+// [<Exchange Summary> --] [(Error | UserText)] [>> Debug]
+procedure UpdateSbar;
+var
+  S: String;
+begin
+  // optional exchange summary...
+  if Ini.ShowExchangeSummary <> 0 then
+    if SimContest in [scArrlSS] then
+      case Ini.ShowExchangeSummary of
+        1:
+          if SBarSummaryMsg.IsEmpty then
+            Mainform.Label3.Caption := Exchange2Settings[etSSCheckSection].C
+          else
+            Mainform.Label3.Caption := SBarSummaryMsg;
+        2:
+          S := SBarSummaryMsg;
+      end;
+
+  // error or UserText...
+  if not SBarErrorMsg.IsEmpty then
+    begin
+      if not S.IsEmpty then
+        S := S + ' -- ';
+      S := S + SBarErrorMsg;
+    end
+  else if not SBarStationInfo.IsEmpty then
+    begin
+      if not S.IsEmpty then
+        S := S + ' -- ';
+      S := S + SBarStationInfo;
+    end;
+
   // during debug, use status bar to show CW stream
-  Mainform.sbar.Font.Color := clDefault;
-  if not s.IsEmpty and (BDebugCwDecoder or BDebugGhosting) then
-    Mainform.sbar.Caption := LeftStr(Mainform.sbar.Caption, 40) + ' -- ' + s
+  if not SBarDebugMsg.IsEmpty then
+    S := format('  %-45s >> %-40s', [S, SBarDebugMsg]);
+
+  if SBarErrorMsg.IsEmpty then
+    Mainform.sbar.Font.Color := clDefault
   else
-    MainForm.sbar.Caption := '  ' + s;
+    Mainform.sbar.Font.Color := SBarErrorColor;
+
+  MainForm.sbar.Caption := S;
 end;
 
 
 procedure DisplayError(const AExchError: string; const AColor: TColor);
 begin
-  if AExchError.IsEmpty then Exit;
+  if (Log.SBarErrorMsg = AExchError) and
+     (Log.SBarErrorColor = AColor) then Exit;
 
-  Mainform.sbar.Font.Color := AColor;
-  if (BDebugCwDecoder or BDebugGhosting) then
-    Mainform.sbar.Caption := LeftStr(Mainform.sbar.Caption, 40) + ' -- ' + AExchError
-  else
-    Mainform.sbar.Caption := AExchError;
-  Mainform.sbar.Align:= alBottom;
-  Mainform.sbar.Visible:= true;
+  Log.SBarErrorMsg := AExchError;
+  Log.SBarErrorColor := AColor;
+  UpdateSbar;
 end;
 
 

Main.dfm

@@ -49,7 +49,6 @@ object MainForm: TMainForm
     000000FF000001FF000083FF0000E7FF0000E7FF0000}
   KeyPreview = True
   Menu = MainMenu1
-  OldCreateOrder = False
   Position = poScreenCenter
   OnClose = FormClose
   OnCreate = FormCreate
@@ -59,7 +58,6 @@ object MainForm: TMainForm
   OnKeyUp = FormKeyUp
   OnMouseWheelDown = FormMouseWheelDown
   OnMouseWheelUp = FormMouseWheelUp
-  PixelsPerInch = 96
   TextHeight = 15
   object Bevel1: TBevel
     Left = 0
@@ -543,7 +541,6 @@ object MainForm: TMainForm
       ScrollBars = ssVertical
       TabOrder = 1
       Visible = False
-      Zoom = 100
     end
     object ListView2: TListView
       Left = 0