From f77c15770e53e20cc3f5073e557f2b77e244a30d Mon Sep 17 00:00:00 2001 From: Alex Shovkoplyas Date: Fri, 5 Jun 2015 22:40:52 -0400 Subject: [PATCH 1/2] Initial commit, with end-of-line normalization, remove MorseRunner.res --- CallLst.pas | 113 ++++ Contest.pas | 320 ++++++++++ DxOper.pas | 288 +++++++++ DxStn.pas | 161 +++++ Ini.pas | 156 +++++ Log.pas | 351 +++++++++++ Main.dfm | 1435 +++++++++++++++++++++++++++++++++++++++++++++ Main.pas | 1160 ++++++++++++++++++++++++++++++++++++ MorseRunner.dpr | 44 ++ MorseRunner.ico | Bin 0 -> 1078 bytes MorseRunner16.bmp | Bin 0 -> 246 bytes MorseRunner32.bmp | Bin 0 -> 630 bytes MyStn.pas | 192 ++++++ QrmStn.pas | 61 ++ QrnStn.pas | 46 ++ Qsb.pas | 80 +++ Readme.txt | 321 ++++++++++ RndFunc.pas | 142 +++++ ScoreDlg.dfm | 94 +++ ScoreDlg.pas | 46 ++ Station.pas | 236 ++++++++ StnColl.pas | 69 +++ VCL/BaseComp.pas | 106 ++++ VCL/Crc32.pas | 70 +++ VCL/Mixers.pas | 383 ++++++++++++ VCL/MorseKey.pas | 208 +++++++ VCL/MorseTbl.pas | 70 +++ VCL/MovAvg.pas | 233 ++++++++ VCL/PermHint.pas | 139 +++++ VCL/QuickAvg.pas | 156 +++++ VCL/SndCustm.pas | 269 +++++++++ VCL/SndOut.pas | 203 +++++++ VCL/SndTypes.pas | 75 +++ VCL/VolmSldr.dcr | Bin 0 -> 480 bytes VCL/VolmSldr.pas | 248 ++++++++ VCL/VolumCtl.dcr | Bin 0 -> 484 bytes VCL/VolumCtl.pas | 386 ++++++++++++ VCL/WavFile.pas | 683 +++++++++++++++++++++ 38 files changed, 8544 insertions(+) create mode 100644 CallLst.pas create mode 100644 Contest.pas create mode 100644 DxOper.pas create mode 100644 DxStn.pas create mode 100644 Ini.pas create mode 100644 Log.pas create mode 100644 Main.dfm create mode 100644 Main.pas create mode 100644 MorseRunner.dpr create mode 100644 MorseRunner.ico create mode 100644 MorseRunner16.bmp create mode 100644 MorseRunner32.bmp create mode 100644 MyStn.pas create mode 100644 QrmStn.pas create mode 100644 QrnStn.pas create mode 100644 Qsb.pas create mode 100644 Readme.txt create mode 100644 RndFunc.pas create mode 100644 ScoreDlg.dfm create mode 100644 ScoreDlg.pas create mode 100644 Station.pas create mode 100644 StnColl.pas create mode 100644 VCL/BaseComp.pas create mode 100644 VCL/Crc32.pas create mode 100644 VCL/Mixers.pas create mode 100644 VCL/MorseKey.pas create mode 100644 VCL/MorseTbl.pas create mode 100644 VCL/MovAvg.pas create mode 100644 VCL/PermHint.pas create mode 100644 VCL/QuickAvg.pas create mode 100644 VCL/SndCustm.pas create mode 100644 VCL/SndOut.pas create mode 100644 VCL/SndTypes.pas create mode 100644 VCL/VolmSldr.dcr create mode 100644 VCL/VolmSldr.pas create mode 100644 VCL/VolumCtl.dcr create mode 100644 VCL/VolumCtl.pas create mode 100644 VCL/WavFile.pas diff --git a/CallLst.pas b/CallLst.pas new file mode 100644 index 0000000..1a98a03 --- /dev/null +++ b/CallLst.pas @@ -0,0 +1,113 @@ +//------------------------------------------------------------------------------ +//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 CallLst; + +interface + +uses + SysUtils, Classes, Ini; + +procedure LoadCallList; +function PickCall: string; + +var + Calls: TStringList; + + + + +implementation + + +function CompareCalls(Item1, Item2: Pointer): Integer; +begin + Result := StrComp(PChar(Item1), PChar(Item2)); +end; + +procedure LoadCallList; +const + Chars = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789/'; + CHRCOUNT = Length(Chars); + INDEXSIZE = Sqr(CHRCOUNT) + 1; + INDEXBYTES = INDEXSIZE * SizeOf(Integer); +var + i: integer; + P, Pe: PChar; + L: TList; + + FileName: string; + FFileSize: integer; + + FIndex: array[0..INDEXSIZE-1] of integer; + Data: string; +begin + Calls.Clear; + + FileName := ExtractFilePath(ParamStr(0)) + 'Master.dta'; + if not FileExists(FileName) then Exit; + + with TFileStream.Create(FileName, fmOpenRead) do + try + FFileSize := Size; + if FFileSize < INDEXBYTES then Exit; + ReadBuffer(FIndex, INDEXBYTES); + + if (FIndex[0] <> INDEXBYTES) or (FIndex[INDEXSIZE-1] <> FFileSize) + then Exit; + SetLength(Data, Size - Position); + ReadBuffer(Data[1], Length(Data)); + finally + Free; + end; + + + L := TList.Create; + try + //list pointers to calls + L.Capacity := 20000; + P := @Data[1]; + Pe := P + Length(Data); + while P < Pe do + begin + L.Add(TObject(P)); + P := P + StrLen(P) + 1; + end; + //delete dupes + L.Sort(CompareCalls); + for i:=L.Count-1 downto 1 do + if StrComp(PChar(L[i]), PChar(L[i-1])) = 0 + then L[i] := nil; + //put calls to Lst + Calls.Capacity := L.Count; + for i:=0 to L.Count-1 do + if L[i] <> nil then Calls.Add(PChar(L[i])); + finally + L.Free; + end; +end; + + +function PickCall: string; +var + Idx: integer; +begin + if Calls.Count = 0 then begin Result := 'P29SX'; Exit; end; + + Idx := Random(Calls.Count); + Result := Calls[Idx]; + + if Ini.RunMode = rmHst then Calls.Delete(Idx); +end; + + +initialization + Calls := TStringList.Create; + +finalization + Calls.Free; + +end. + diff --git a/Contest.pas b/Contest.pas new file mode 100644 index 0000000..3c1cbab --- /dev/null +++ b/Contest.pas @@ -0,0 +1,320 @@ +//------------------------------------------------------------------------------ +//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 Contest; + +interface + +uses + SysUtils, SndTypes, Station, StnColl, MyStn, Math, Ini, + MovAvg, Mixers, VolumCtl, RndFunc, TypInfo, DxStn, DxOper, Log; + +type + TContest = class + private + function DxCount: integer; + procedure SwapFilters; + public + BlockNumber: integer; + Me: TMyStation; + Stations: TStations; + Agc: TVolumeControl; + Filt, Filt2: TMovingAverage; + Modul: TModulator; + RitPhase: Single; + FStopPressed: boolean; + + constructor Create; + destructor Destroy; override; + procedure Init; + function Minute: Single; + function GetAudio: TSingleArray; + procedure OnMeFinishedSending; + procedure OnMeStartedSending; + end; + +var + Tst: TContest; + + +implementation + +uses + Main; + +{ TContest } + +constructor TContest.Create; +begin + Me := TMyStation.CreateStation; + Stations := TStations.Create; + Filt := TMovingAverage.Create(nil); + Modul := TModulator.Create; + Agc := TVolumeControl.Create(nil); + + Filt.Points := Round(0.7 * 11025 / Ini.BandWidth); + Filt.Passes := 3; + Filt.SamplesInInput := Ini.BufSize; + Filt.GainDb := 10 * Log10(500/Ini.Bandwidth); + + Filt2 := TMovingAverage.Create(nil); + Filt2.Passes := Filt.Passes; + Filt2.SamplesInInput := Filt.SamplesInInput; + Filt2.GainDb := Filt.GainDb; + + Modul.SamplesPerSec := 11025; + Modul.CarrierFreq := Ini.Pitch; + + Agc.NoiseInDb := 76; + Agc.NoiseOutDb := 76; + Agc.AttackSamples := 155; //AGC attack 5 ms + Agc.HoldSamples := 155; + Agc.AgcEnabled := true; + + Init; +end; + + +destructor TContest.Destroy; +begin + Me.Free; + Filt.Free; + Filt2.Free; + Modul.Free; + inherited; +end; + + +procedure TContest.Init; +begin + Me.Init; + Stations.Clear; + BlockNumber := 0; +end; + + +function TContest.GetAudio: TSingleArray; +const + NOISEAMP = 6000; +var + ReIm: TReImArrays; + Blk: TSingleArray; + i, Stn: integer; + Bfo: Single; + Smg, Rfg: Single; +begin + //minimize audio output delay + SetLength(Result, 1); + Inc(BlockNumber); + if BlockNumber < 6 then Exit; + + //complex noise + SetLengthReIm(ReIm, Ini.BufSize); + for i:=0 to High(ReIm.Re) do + begin + ReIm.Re[i] := 3 * NOISEAMP * (Random-0.5); + ReIm.Im[i] := 3 * NOISEAMP * (Random-0.5); + end; + + //QRN + if Ini.Qrn then + begin + //background + for i:=0 to High(ReIm.Re) do + if Random < 0.01 then ReIm.Re[i] := 60 * NOISEAMP * (Random-0.5); + //burst + if Random < 0.01 then Stations.AddQrn; + end; + + //QRM + if Ini.Qrm and (Random < 0.0002) then Stations.AddQrm; + + + //audio from stations + Blk := nil; + for Stn:=0 to Stations.Count-1 do + if Stations[Stn].State = stSending then + begin + Blk := Stations[Stn].GetBlock; + for i:=0 to High(Blk) do + begin + Bfo := Stations[Stn].Bfo - RitPhase - i * TWO_PI * Ini.Rit / 11025; + ReIm.Re[i] := ReIm.Re[i] + Blk[i] * Cos(Bfo); + ReIm.Im[i] := ReIm.Im[i] - Blk[i] * Sin(Bfo); + end; + end; + + //Rit + RitPhase := RitPhase + Ini.BufSize * TWO_PI * Ini.Rit / 11025; + while RitPhase > TWO_PI do RitPhase := RitPhase - TWO_PI; + while RitPhase < -TWO_PI do RitPhase := RitPhase + TWO_PI; + + + //my audio + if Me.State = stSending then + begin + Blk := Me.GetBlock; + //self-mon. gain + Smg := Power(10, (MainForm.VolumeSlider1.Value - 0.75) * 4); + Rfg := 1; + for i:=0 to High(Blk) do + if Ini.Qsk + then + begin + if Rfg > (1 - Blk[i]/Me.Amplitude) + then Rfg := (1 - Blk[i]/Me.Amplitude) + else Rfg := Rfg * 0.997 + 0.003; + ReIm.Re[i] := Smg * Blk[i] + Rfg * ReIm.Re[i]; + ReIm.Im[i] := Smg * Blk[i] + Rfg * ReIm.Im[i]; + end + else + begin + ReIm.Re[i] := Smg * (Blk[i]); + ReIm.Im[i] := Smg * (Blk[i]); + end; + end; + + + //LPF + Filt2.Filter(ReIm); + ReIm := Filt.Filter(ReIm); + if (BlockNumber mod 10) = 0 then SwapFilters; + + //mix up to Pitch frequency + Result := Modul.Modulate(ReIm); + //AGC + Result := Agc.Process(Result); + //save + with MainForm.AlWavFile1 do + if IsOpen then WriteFrom(@Result[0], nil, Ini.BufSize); + + //timer tick + Me.Tick; + for Stn:=Stations.Count-1 downto 0 do Stations[Stn].Tick; + + + //if DX is done, write to log and kill + for i:=Stations.Count-1 downto 0 do + if Stations[i] is TDxStation then + with Stations[i] as TDxStation do + if (Oper.State = osDone) and (QsoList <> nil) and (MyCall = QsoList[High(QsoList)].Call) + then + begin + DataToLastQso; + with MainForm.RichEdit1.Lines do Delete(Count-1); + Log.CheckErr; + Log.LastQsoToScreen; + if Ini.RunMode = RmHst + then Log.UpdateStatsHst + else Log.UpdateStats; + end; + + + //show info + ShowRate; + MainForm.Panel2.Caption := FormatDateTime('hh:nn:ss', BlocksToSeconds(BlockNumber) / 86400); + if Ini.RunMode = rmPileUp then + MainForm.Panel4.Caption := Format('Pile-Up: %d', [DxCount]); + + + if (RunMode = rmSingle) and (DxCount = 0) then + begin + Me.Msg := [msgCq]; //no need to send cq in this mode + Stations.AddCaller.ProcessEvent(evMeFinished); + end + else if (RunMode = rmHst) and (DxCount < Activity) then + begin + Me.Msg := [msgCq]; + for i:=DxCount+1 to Activity do + Stations.AddCaller.ProcessEvent(evMeFinished); + end; + + + if (BlocksToSeconds(BlockNumber) >= (Duration * 60)) or FStopPressed then + begin + if RunMode = rmHst then + begin + MainForm.Run(rmStop); + FStopPressed := false; + MainForm.PopupScoreHst; + end + else if (RunMode = rmWpx) and not FStopPressed then + begin + MainForm.Run(rmStop); + FStopPressed := false; + MainForm.PopupScoreWpx; + end + else + begin + MainForm.Run(rmStop); + FStopPressed := false; + end; +{ + if (RunMode in [rmWpx, rmHst]) and not FStopPressed + then begin MainForm.Run(rmStop); MainForm.PopupScore; end + else MainForm.Run(rmStop); +} + end; +end; + + +function TContest.DxCount: integer; +var + i: integer; +begin + Result := 0; + for i:=Stations.Count-1 downto 0 do + if (Stations[i] is TDxStation) and + (TDxStation(Stations[i]).Oper.State <> osDone) + then Inc(Result); +end; + + +function TContest.Minute: Single; +begin + Result := BlocksToSeconds(BlockNumber) / 60; +end; + + +procedure TContest.OnMeFinishedSending; +var + i: integer; +begin + //the stations heard my CQ and want to call + if (not (RunMode in [rmSingle, RmHst])) then + if (msgCQ in Me.Msg) or + ((QsoList <> nil) and (msgTU in Me.Msg) and (msgMyCall in Me.Msg))then + for i:=1 to RndPoisson(Activity / 2) do Stations.AddCaller; + + //tell callers that I finished sending + for i:=Stations.Count-1 downto 0 do + Stations[i].ProcessEvent(evMeFinished); +end; + + +procedure TContest.OnMeStartedSending; +var + i: integer; +begin + //tell callers that I started sending + for i:=Stations.Count-1 downto 0 do + Stations[i].ProcessEvent(evMeStarted); +end; + + +procedure TContest.SwapFilters; +var + F: TMovingAverage; +begin + F := Filt; + Filt := Filt2; + Filt2 := F; + Filt2.Reset; +end; + + + +end. + diff --git a/DxOper.pas b/DxOper.pas new file mode 100644 index 0000000..f1e446d --- /dev/null +++ b/DxOper.pas @@ -0,0 +1,288 @@ +//------------------------------------------------------------------------------ +//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: string; + 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)); +end; + +function TDxOperator.GetNR: string; +begin + if RunMode = rmCustom + then + else Result := IntToStr(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 (C[x] in [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. + diff --git a/DxStn.pas b/DxStn.pas new file mode 100644 index 0000000..9f744ca --- /dev/null +++ b/DxStn.pas @@ -0,0 +1,161 @@ +//------------------------------------------------------------------------------ +//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 DxStn; + +interface + +uses + SysUtils, Classes, Station, RndFunc, Ini, CallLst, Qsb, DxOper, Log, SndTypes; + +type + TDxStation = class(TStation) + private + Qsb: TQsb; + public + Oper: TDxOperator; + constructor CreateStation; + destructor Destroy; override; + procedure ProcessEvent(AEvent: TStationEvent); override; + procedure DataToLastQso; + function GetBlock: TSingleArray; override; + end; + + +implementation + +uses + Contest; + +{ TDxStation } + +constructor TDxStation.CreateStation; +begin + inherited Create(nil); + + HisCall := Ini.Call; + MyCall := PickCall; + + Oper := TDxOperator.Create; + Oper.Call := MyCall; + Oper.Skills := 1 + Random(3); //1..3 + Oper.SetState(osNeedPrevEnd); + NrWithError := Ini.Lids and (Random < 0.1); + + Wpm := Oper.GetWpm; + NR := Oper.GetNR; + if Ini.Lids and (Random < 0.03) + then RST := 559 + 10*Random(4) + else RST := 599; + + Qsb := TQsb.Create; + + Qsb.Bandwidth := 0.1 + Random / 2; + if Ini.Flutter and (Random < 0.3) then Qsb.Bandwidth := 3 + Random * 30; + + Amplitude := 9000 + 18000 * (1 + RndUShaped); + Pitch := Round(RndGaussLim(0, 300)); + + //the MeSent event will follow immediately + TimeOut := NEVER; + State := stCopying; +end; + + +destructor TDxStation.Destroy; +begin + Oper.Free; + Qsb.Free; + inherited; +end; + + + + +procedure TDxStation.ProcessEvent(AEvent: TStationEvent); +var + i: integer; +begin + if Oper.State = osDone then Exit; + + case AEvent of + evMsgSent: + //we finished sending and started listening + if Tst.Me.State = stSending + then TimeOut := NEVER + else TimeOut := Oper.GetReplyTimeout; + + evTimeout: + begin + //he did not reply, quit or try again + if State = stListening then + begin + Oper.MsgReceived([msgNone]); + if Oper.State = osFailed then begin Free; Exit; end; + State := stPreparingToSend; + end; + //preparations to send are done, now send + if State = stPreparingToSend then + for i:=1 to Oper.RepeatCnt do SendMsg(Oper.GetReply) + end; + + evMeFinished: //he finished sending + //we notice the message only if we are not sending ourselves + if State <> stSending then + begin + //interpret the message + case State of + stCopying: + Oper.MsgReceived(Tst.Me.Msg); + + stListening, stPreparingToSend: + //these messages can be copied even if partially received + if (msgCQ in Tst.Me.Msg) or (msgTU in Tst.Me.Msg) or (msgNil in Tst.Me.Msg) + then Oper.MsgReceived(Tst.Me.Msg) + else Oper.MsgReceived([msgGarbage]); + end; + + //react to the message + if Oper.State = osFailed + then begin Free; Exit; end //give up + else TimeOut := Oper.GetSendDelay; //reply or switch to standby + State := stPreparingToSend; + end; + + evMeStarted: + //If we are not sending, we can start copying + //Cancel timeout, he is replying + begin + if State <> stSending then State := stCopying; + TimeOut := NEVER; + end; + end; +end; + + + +procedure TDxStation.DataToLastQso; +begin + with QsoList[High(QsoList)] do + begin + TrueCall := Self.MyCall; + TrueRst := Self.Rst; + TrueNR := Self.NR; + end; + + Free; +end; + + + + +function TDxStation.GetBlock: TSingleArray; +begin + Result := inherited GetBlock; + if Ini.Qsb then Qsb.ApplyTo(Result); +end; + +end. + diff --git a/Ini.pas b/Ini.pas new file mode 100644 index 0000000..848c371 --- /dev/null +++ b/Ini.pas @@ -0,0 +1,156 @@ +//------------------------------------------------------------------------------ +//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 Ini; + +interface + +uses + SysUtils, IniFiles, SndTypes, Math; + +const + SEC_STN = 'Station'; + SEC_BND = 'Band'; + SEC_TST = 'Contest'; + SEC_SYS = 'System'; + + DEFAULTBUFCOUNT = 8; + DEFAULTBUFSIZE = 512; + DEFAULTRATE = 11025; + + +type + TRunMode = (rmStop, rmPileup, rmSingle, rmWpx, rmHst, rmCustom); + + +var + Call: string = 'VE3NEA'; + HamName: string; + Wpm: integer = 30; + BandWidth: integer = 500; + Pitch: integer = 600; + Qsk: boolean = true; + Rit: integer = 0; + BufSize: integer = DEFAULTBUFSIZE; + + Activity: integer = 2; + Qrn: boolean = true; + Qrm: boolean = true; + Qsb: boolean = true; + Flutter: boolean = true; + Lids: boolean = true; + + Duration: integer = 30; + RunMode: TRunMode = rmStop; + HiScore: integer; + CompDuration: integer = 60; + + SaveWav: boolean = false; + CallsFromKeyer: boolean = false; + + +procedure FromIni; +procedure ToIni; + + + +implementation + +uses + Main, Contest; + +procedure FromIni; +var + V: integer; +begin + with TIniFile.Create(ChangeFileExt(ParamStr(0), '.ini')) do + try + MainForm.SetMyCall(ReadString(SEC_STN, 'Call', Call)); + MainForm.SetPitch(ReadInteger(SEC_STN, 'Pitch', 3)); + MainForm.SetBw(ReadInteger(SEC_STN, 'BandWidth', 9)); + + HamName := ReadString(SEC_STN, 'Name', ''); + if HamName <> '' then + MainForm.Caption := MainForm.Caption + ': ' + HamName; + + Wpm := ReadInteger(SEC_STN, 'Wpm', Wpm); + Wpm := Max(10, Min(120, Wpm)); + MainForm.SpinEdit1.Value := Wpm; + Tst.Me.Wpm := Wpm; + + MainForm.SetQsk(ReadBool(SEC_STN, 'Qsk', Qsk)); + CallsFromKeyer := ReadBool(SEC_STN, 'CallsFromKeyer', CallsFromKeyer); + + Activity := ReadInteger(SEC_BND, 'Activity', Activity); + MainForm.SpinEdit3.Value := Activity; + + MainForm.CheckBox4.Checked := ReadBool(SEC_BND, 'Qrn', Qrn); + MainForm.CheckBox3.Checked := ReadBool(SEC_BND, 'Qrm', Qrm); + MainForm.CheckBox2.Checked := ReadBool(SEC_BND, 'Qsb', Qsb); + MainForm.CheckBox5.Checked := ReadBool(SEC_BND, 'Flutter', Flutter); + MainForm.CheckBox6.Checked := ReadBool(SEC_BND, 'Lids', Lids); + MainForm.ReadCheckBoxes; + + Duration := ReadInteger(SEC_TST, 'Duration', Duration); + MainForm.SpinEdit2.Value := Duration; + HiScore := ReadInteger(SEC_TST, 'HiScore', HiScore); + CompDuration := Max(1, Min(60, ReadInteger(SEC_TST, 'CompetitionDuration', CompDuration))); + + //buffer size + V := ReadInteger(SEC_SYS, 'BufSize', 0); + if V = 0 then + begin V := 3; WriteInteger(SEC_SYS, 'BufSize', V); end; + V := Max(1, Min(5, V)); + BufSize := 64 shl V; + Tst.Filt.SamplesInInput := BufSize; + Tst.Filt2.SamplesInInput := BufSize; + + V := ReadInteger(SEC_STN, 'SelfMonVolume', 0); + MainForm.VolumeSlider1.Value := V / 80 + 0.75; + + SaveWav := ReadBool(SEC_STN, 'SaveWav', SaveWav); + finally + Free; + end; +end; + + +procedure ToIni; +var + V: integer; +begin + with TIniFile.Create(ChangeFileExt(ParamStr(0), '.ini')) do + try + WriteString(SEC_STN, 'Call', Call); + WriteInteger(SEC_STN, 'Pitch', MainForm.ComboBox1.ItemIndex); + WriteInteger(SEC_STN, 'BandWidth', MainForm.ComboBox2.ItemIndex); + WriteInteger(SEC_STN, 'Wpm', Wpm); + WriteBool(SEC_STN, 'Qsk', Qsk); + + WriteInteger(SEC_BND, 'Activity', Activity); + WriteBool(SEC_BND, 'Qrn', Qrn); + WriteBool(SEC_BND, 'Qrm', Qrm); + WriteBool(SEC_BND, 'Qsb', Qsb); + WriteBool(SEC_BND, 'Flutter', Flutter); + WriteBool(SEC_BND, 'Lids', Lids); + + WriteInteger(SEC_TST, 'Duration', Duration); + WriteInteger(SEC_TST, 'HiScore', HiScore); + WriteInteger(SEC_TST, 'CompetitionDuration', CompDuration); + + V := Round(80 * (MainForm.VolumeSlider1.Value - 0.75)); + WriteInteger(SEC_STN, 'SelfMonVolume', V); + + WriteBool(SEC_STN, 'SaveWav', SaveWav); + finally + Free; + end; +end; + + + + +end. + diff --git a/Log.pas b/Log.pas new file mode 100644 index 0000000..88cc401 --- /dev/null +++ b/Log.pas @@ -0,0 +1,351 @@ +//------------------------------------------------------------------------------ +//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 Log; + +interface + +uses + Windows, SysUtils, Classes, Graphics, RndFunc, Math; + + +procedure SaveQso; +procedure LastQsoToScreen; +procedure Clear; +procedure UpdateStats; +procedure UpdateStatsHst; +procedure CheckErr; +procedure PaintHisto; +procedure ShowRate; + + + +type + PQso = ^TQso; + TQso = record + T: TDateTime; + Call, TrueCall: string; + Rst, TrueRst: integer; + Nr, TrueNr: string; + Pfx: string; + Dupe: boolean; + Err: string; + end; + + +var + QsoList: array of TQso; + PfxList: TStringList; + CallSent, NrSent: boolean; + + + +implementation + +uses + Contest, Main, DxStn, DxOper, Ini, MorseKey; + +procedure Clear; +var + Empty: string; +begin + QsoList := nil; + Tst.Stations.Clear; + MainForm.RichEdit1.Lines.Clear; + + if Ini.RunMode = rmHst + then MainForm.RichEdit1.Lines.Add(' UTC Call Recv Sent Score Chk') + else MainForm.RichEdit1.Lines.Add(' UTC Call Recv Sent Pref Chk'); + MainForm.RichEdit1.SelStart := 1; + MainForm.RichEdit1.SelLength := Length(MainForm.RichEdit1.Lines[0]); + MainForm.RichEdit1.SelAttributes.Style := [fsUnderline]; + MainForm.RichEdit1.SelAttributes.Color := clBlue; + + if Ini.RunMode = rmHst then Empty := '' else Empty := '0'; + + MainForm.ListView1.Items[0].SubItems[0] := Empty; + MainForm.ListView1.Items[1].SubItems[0] := Empty; + MainForm.ListView1.Items[0].SubItems[1] := Empty; + MainForm.ListView1.Items[1].SubItems[1] := Empty; + MainForm.ListView1.Items[2].SubItems[0] := '0'; + MainForm.ListView1.Items[2].SubItems[1] := '0'; + + MainForm.PaintBox1.Invalidate; +end; + + +function CallToScore(S: string): integer; +var + i: integer; +begin + S := Keyer.Encode(S); + Result := -1; + for i:=1 to Length(S) do + case S[i] of + '.': Inc(Result, 2); + '-': Inc(Result, 4); + ' ': Inc(Result, 2); + end; +end; + +procedure UpdateStatsHst; +var + CallScore, RawScore, Score: integer; + i: integer; +begin + RawScore := 0; + Score := 0; + + for i:=0 to High(QsoList) do + begin + CallScore := CallToScore(QsoList[i].Call); + Inc(RawScore, CallScore); + if QsoList[i].Err = ' ' then Inc(Score, CallScore); + end; + + MainForm.ListView1.Items[0].SubItems[0] := ''; + MainForm.ListView1.Items[1].SubItems[0] := ''; + MainForm.ListView1.Items[2].SubItems[0] := IntToStr(RawScore); + + MainForm.ListView1.Items[0].SubItems[1] := ''; + MainForm.ListView1.Items[1].SubItems[1] := ''; + MainForm.ListView1.Items[2].SubItems[1] := IntToStr(Score); + + MainForm.PaintBox1.Invalidate; + + MainForm.Panel11.Caption := IntToStr(Score); +end; + + +procedure UpdateStats; +var + i, Pts, Mul: integer; +begin + //raw + + Pts := Length(QsoList); + PfxList.Clear; + for i:=0 to High(QsoList) do PfxList.Add(QsoList[i].Pfx); + Mul := PfxList.Count; + + MainForm.ListView1.Items[0].SubItems[0] := IntToStr(Pts); + MainForm.ListView1.Items[1].SubItems[0] := IntToStr(Mul); + MainForm.ListView1.Items[2].SubItems[0] := IntToStr(Pts*Mul); + + //verified + + Pts := 0; + PfxList.Clear; + for i:=0 to High(QsoList) do + if QsoList[i].Err = ' ' then + begin + Inc(Pts); + PfxList.Add(QsoList[i].Pfx); + end; + Mul := PfxList.Count; + + MainForm.ListView1.Items[0].SubItems[1] := IntToStr(Pts); + MainForm.ListView1.Items[1].SubItems[1] := IntToStr(Mul); + MainForm.ListView1.Items[2].SubItems[1] := IntToStr(Pts*Mul); + + MainForm.PaintBox1.Invalidate; +end; + + +function ExtractPrefix(Call: string): string; +const + DIGITS = ['0'..'9']; + LETTERS = ['A'..'Z']; +var + p: integer; + S1, S2, Dig: string; +begin + //kill modifiers + Call := Call + '|'; + Call := StringReplace(Call, '/QRP|', '', []); + Call := StringReplace(Call, '/MM|', '', []); + Call := StringReplace(Call, '/M|', '', []); + Call := StringReplace(Call, '/P|', '', []); + Call := StringReplace(Call, '|', '', []); + Call := StringReplace(Call, '//', '/', [rfReplaceAll]); + if Length(Call) < 2 then begin Result := ''; Exit; end; + + Dig := ''; + + //select shorter piece + p := Pos('/', Call); + if p = 0 then Result := Call + else if p = 1 then Result := Copy(Call, 2, MAXINT) + else if p = Length(Call) then Result := Copy(Call, 1, p-1) + else + begin + S1 := Copy(Call, 1, p-1); + S2 := Copy(Call, p+1, MAXINT); + + if (Length(S1) = 1) and (S1[1] in DIGITS) then begin Dig := S1; Result := S2; end + else if (Length(S2) = 1) and (S2[1] in DIGITS) then begin Dig := S2; Result := S1; end + else if Length(S1) <= Length(S2) then Result := S1 + else Result := S2; + end; + if Pos('/', Result) > 0 then begin Result := ''; Exit; end; + + //delete trailing letters, retain at least 2 chars + for p:= Length(Result) downto 3 do + if Result[p] in DIGITS then Break + else Delete(Result, p, 1); + + //ensure digit + if not (Result[Length(Result)] in DIGITS) then Result := Result + '0'; + //replace digit + if Dig <> '' then Result[Length(Result)] := Dig[1]; + + Result := Copy(Result, 1, 5); +end; + + +procedure SaveQso; +var + i: integer; + Qso: PQso; +begin + with MainForm do + begin + if (Length(Edit1.Text) < 3) or (Length(Edit2.Text) <> 3) or (Edit3.Text = '') + then begin Beep; Exit; end; + + //add new entry to log + SetLength(QsoList, Length(QsoList)+1); + Qso := @QsoList[High(QsoList)]; + //save data + Qso.T := BlocksToSeconds(Tst.BlockNumber) / 86400; + Qso.Call := StringReplace(Edit1.Text, '?', '', [rfReplaceAll]); + Qso.Rst := StrToInt(Edit2.Text); + Qso.Nr := Trim(Edit3.Text); + Qso.Pfx := ExtractPrefix(Qso.Call); + {if PfxList.Find(Qso.Pfx, Idx) then Qso.Pfx := '' else }PfxList.Add(Qso.Pfx); + if Ini.RunMode = rmHst then Qso.Pfx := IntToStr(CallToScore(Qso.Call)); + + + //mark if dupe + Qso.Dupe := false; + for i:=0 to High(QsoList)-1 do + with QsoList[i] do + if (Call = Qso.Call) and (Err = ' ') + then Qso.Dupe := true; + + //what's in the DX's log? + for i:=Tst.Stations.Count-1 downto 0 do + if Tst.Stations[i] is TDxStation then + with Tst.Stations[i] as TDxStation do + if (Oper.State = osDone) and (MyCall = Qso.Call) + then begin DataToLastQso; Break; end; //deletes the dx station! + CheckErr; + end; + + LastQsoToScreen; + if Ini.RunMode = rmHst + then UpdateStatsHst + else UpdateStats; + + //wipe + MainForm.WipeBoxes; + //inc NR + Tst.Me.NR := IntToStr(StrToInt(Tst.Me.NR) + 1); +end; + + +procedure LastQsoToScreen; +const + EM_SCROLLCARET = $B7; +var + S: string; +begin + with QsoList[High(QsoList)] do + S := FormatDateTime(' hh:nn:ss ', t) + + Format('%-12s %.3d %.4d %.3d %.4d %-5s %-3s', + [Call, Rst, Nr, Tst.Me.Rst, + //Tst.Me.NR, + MainForm.RichEdit1.Lines.Count, + Pfx, Err]); + + MainForm.RichEdit1.Lines.Add(S); + MainForm.RichEdit1.SelStart := Length(MainForm.RichEdit1.Text) - 5; + MainForm.RichEdit1.SelLength := 3; + MainForm.RichEdit1.SelAttributes.Color := clRed; + MainForm.RichEdit1.Perform(EM_SCROLLCARET, 0, 0); +end; + + +procedure CheckErr; +begin + with QsoList[High(QsoList)] do + begin + if TrueCall = '' then Err := 'NIL' + else if Dupe then Err := 'DUP' + else if TrueRst <> Rst then Err := 'RST' + else if TrueNr <> NR then Err := 'NR ' + else Err := ' '; + end; +end; + + +procedure PaintHisto; +var + Histo: array[0..47] of integer; + i: integer; + x, y: integer; +begin + FillChar(Histo, SizeOf(Histo), 0); + + for i:=0 to High(QsoList) do + begin + x := Trunc(QsoList[i].T * 1440) div 5; + Inc(Histo[x]); + end; + + with MainForm.PaintBox1, MainForm.PaintBox1.Canvas do + begin + Brush.Color := Color; + FillRect(RECT(0,0, Width, Height)); + for i:=0 to High(Histo) do + begin + Brush.Color := clGreen; + x := i * 4 + 1; + y := Height - 3 - Histo[i] * 2; + FillRect(Rect(x, y, x+3, Height-2)); + end; + end; +end; + + +procedure ShowRate; +var + i, Cnt: integer; + T, D: Single; +begin + T := BlocksToSeconds(Tst.BlockNumber) / 86400; + if T = 0 then Exit; + D := Min(5/1440, T); + + Cnt := 0; + for i:=High(QsoList) downto 0 do + if QsoList[i].T > (T-D) then Inc(Cnt) else Break; + + + MainForm.Panel7.Caption := Format('%d qso/hr.', [Round(Cnt / D / 24)]); +end; + + + +initialization + PfxList := TStringList.Create; + PfxList.Sorted := true; + PfxList.Duplicates := dupIgnore; + +finalization + PfxList.Free; + +end. + diff --git a/Main.dfm b/Main.dfm new file mode 100644 index 0000000..fa9f0f7 --- /dev/null +++ b/Main.dfm @@ -0,0 +1,1435 @@ +object MainForm: TMainForm + Left = 238 + Top = 115 + BorderIcons = [biSystemMenu] + BorderStyle = bsSingle + Caption = 'Morse Runner' + ClientHeight = 413 + ClientWidth = 700 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + Icon.Data = { + 0000010002002020100000000000E80200002600000010101000000000002801 + 00000E0300002800000020000000400000000100040000000000800200000000 + 0000000000000000000000000000000000000000800000800000008080008000 + 0000800080008080000080808000C0C0C0000000FF0000FF000000FFFF00FF00 + 0000FF00FF00FFFF0000FFFFFF00000000000000000008800000000000000000 + 0000000000000770000000000000000000000000000777777000000000000000 + 000000000777FF8777700000000000000000000777FF70888777700000000000 + 00080777FF70F7708887777000000000000777FF70F770F70F88877000000000 + 0007FF70F770F70FF8870000000000000008788770F70FF88700787800000000 + 00000778870FF8870078887000000000000000077FF88700788FF88700000000 + 00000000077700788FFCCF8700000000000000000070788FFCCCCCF870000000 + 00000000007888FCCCCCCCF88700000000000000000780CCCCCCCCCF87000000 + 09999900000780CCCCCCCCCF8870000998FFF8990000780CCCCCCCC0F8700099 + FFFCFFF99000780CCCCCC0088770009FFFFFFFCF90000780CFC008877000098F + F0FFFFFF89000780C0088770000009FFFF0FFFFFF900007808877000000009FC + FFF90000F900007887700000000009FFFFFFFFFFF9000007700000000000098F + FFFFFFFF89000000000000000000009FCFFFFFCF900000000000000000000099 + FFFCFFF990000000000000000000000998FCF899000000000000000000000000 + 0999990000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000FFFF9FFFFFFE07FFFFF801FFFFE0007FFF80 + 001FFE00000FFE00000FFE00000FFE00000FFF80000FFFE00007FFF80007FFFC + 0003FFFC0001F83E0001E00E0000C007000080030001800380070001801F0001 + C07F0001C1FF0001E7FF0001FFFF8003FFFF8003FFFFC007FFFFE00FFFFFF83F + FFFFFEFFFFFFFC7FFFFFFC7FFFFF280000001000000020000000010004000000 + 0000C00000000000000000000000000000000000000000000000000080000080 + 00000080800080000000800080008080000080808000C0C0C0000000FF0000FF + 000000FFFF00FF000000FF00FF00FFFF0000FFFFFF0000000000770000000000 + 0007F7750000000007F8778775000007887778887000000078788F0087000000 + 008800FF8850000000078FCCCF70001115003CCCC88501F8F91084CCC4F71F8F + FF1007C4780018F77785087800001FFFFF75000000005988F810000000000117 + 71000000000000005000000000000000500000000000FF3F0000FC0F0000F003 + 0000E0030000F0030000FC010000FE010000C30000008100000001830000008F + 000000FF000001FF000083FF0000E7FF0000E7FF0000} + KeyPreview = True + Menu = MainMenu1 + OldCreateOrder = False + Position = poDesktopCenter + OnClose = FormClose + OnCreate = FormCreate + OnDestroy = FormDestroy + OnKeyDown = FormKeyDown + OnKeyPress = FormKeyPress + OnKeyUp = FormKeyUp + PixelsPerInch = 96 + TextHeight = 13 + object Bevel1: TBevel + Left = 0 + Top = 0 + Width = 700 + Height = 2 + Align = alTop + end + object Panel1: TPanel + Left = 0 + Top = 294 + Width = 700 + Height = 119 + Align = alBottom + BevelInner = bvRaised + BevelOuter = bvLowered + TabOrder = 0 + object Label1: TLabel + Left = 16 + Top = 12 + Width = 17 + Height = 13 + Caption = 'Call' + end + object SpeedButton4: TSpeedButton + Tag = 1 + Left = 12 + Top = 68 + Width = 61 + Height = 17 + Caption = 'F1 CQ' + OnClick = SendClick + end + object SpeedButton5: TSpeedButton + Tag = 2 + Left = 76 + Top = 68 + Width = 61 + Height = 17 + Caption = 'F2 <#>' + OnClick = SendClick + end + object SpeedButton6: TSpeedButton + Tag = 3 + Left = 140 + Top = 68 + Width = 61 + Height = 17 + Caption = 'F3 TU' + OnClick = SendClick + end + object SpeedButton7: TSpeedButton + Tag = 4 + Left = 204 + Top = 68 + Width = 61 + Height = 17 + Caption = 'F4 ' + OnClick = SendClick + end + object SpeedButton8: TSpeedButton + Tag = 5 + Left = 12 + Top = 92 + Width = 61 + Height = 17 + Caption = 'F5 ' + OnClick = SendClick + end + object SpeedButton9: TSpeedButton + Tag = 6 + Left = 76 + Top = 92 + Width = 61 + Height = 17 + Caption = 'F6 B4' + OnClick = SendClick + end + object SpeedButton10: TSpeedButton + Tag = 7 + Left = 140 + Top = 92 + Width = 61 + Height = 17 + Caption = 'F7 ?' + OnClick = SendClick + end + object SpeedButton11: TSpeedButton + Tag = 8 + Left = 204 + Top = 92 + Width = 61 + Height = 17 + Caption = 'F8 NIL' + OnClick = SendClick + end + object Label2: TLabel + Left = 172 + Top = 12 + Width = 22 + Height = 13 + Caption = 'RST' + end + object Label3: TLabel + Left = 224 + Top = 12 + Width = 14 + Height = 13 + Caption = 'Nr.' + end + object Bevel2: TBevel + Left = 277 + Top = 6 + Width = 2 + Height = 107 + end + object Edit1: TEdit + Left = 12 + Top = 28 + Width = 149 + Height = 28 + AutoSelect = False + CharCase = ecUpperCase + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'MS Sans Serif' + Font.Style = [fsBold] + MaxLength = 12 + ParentFont = False + TabOrder = 0 + OnChange = Edit1Change + OnEnter = Edit1Enter + OnKeyPress = Edit1KeyPress + end + object Edit2: TEdit + Left = 168 + Top = 28 + Width = 45 + Height = 28 + AutoSelect = False + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'MS Sans Serif' + Font.Style = [fsBold] + MaxLength = 3 + ParentFont = False + TabOrder = 1 + OnEnter = Edit2Enter + OnKeyPress = Edit2KeyPress + end + object Edit3: TEdit + Left = 220 + Top = 28 + Width = 45 + Height = 28 + AutoSelect = False + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'MS Sans Serif' + Font.Style = [fsBold] + MaxLength = 4 + ParentFont = False + TabOrder = 2 + OnKeyPress = Edit3KeyPress + end + object Panel2: TPanel + Left = 529 + Top = 8 + Width = 163 + Height = 31 + BevelOuter = bvLowered + Caption = '00:00:00' + Color = clBlack + Font.Charset = ANSI_CHARSET + Font.Color = 14151712 + Font.Height = -24 + Font.Name = 'Arial' + Font.Style = [] + ParentFont = False + TabOrder = 3 + end + object Panel3: TPanel + Left = 292 + Top = 35 + Width = 225 + Height = 61 + BevelOuter = bvLowered + TabOrder = 4 + object PaintBox1: TPaintBox + Left = 1 + Top = 1 + Width = 223 + Height = 59 + Align = alClient + Color = clInfoBk + ParentColor = False + OnPaint = PaintBox1Paint + end + end + object Panel4: TPanel + Left = 292 + Top = 8 + Width = 114 + Height = 21 + BevelOuter = bvLowered + Font.Charset = DEFAULT_CHARSET + Font.Color = clRed + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [fsBold] + ParentFont = False + TabOrder = 5 + end + object Panel7: TPanel + Left = 412 + Top = 8 + Width = 104 + Height = 21 + BevelOuter = bvLowered + TabOrder = 6 + end + object Panel8: TPanel + Left = 292 + Top = 103 + Width = 225 + Height = 9 + Cursor = crHandPoint + Hint = 'RIT' + BevelOuter = bvLowered + ParentShowHint = False + ShowHint = True + TabOrder = 7 + OnMouseDown = Panel8MouseDown + object Shape2: TShape + Left = 81 + Top = 1 + Width = 32 + Height = 7 + Cursor = crHandPoint + Brush.Color = 12902431 + OnMouseDown = Shape2MouseDown + end + end + object Panel11: TPanel + Left = 529 + Top = 44 + Width = 163 + Height = 68 + BevelOuter = bvLowered + Caption = '0' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -19 + Font.Name = 'MS Sans Serif' + Font.Style = [fsBold] + ParentFont = False + TabOrder = 8 + object ListView1: TListView + Left = 1 + Top = 1 + Width = 161 + Height = 66 + Align = alClient + BorderStyle = bsNone + Columns = < + item + Width = 41 + end + item + Caption = 'Raw' + end + item + Caption = 'Verified' + end> + ColumnClick = False + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + Items.Data = { + 650000000300000000000000FFFFFFFFFFFFFFFF020000000000000003507473 + 000000000000FFFFFFFFFFFFFFFF0200000000000000044D756C740000000000 + 00FFFFFFFFFFFFFFFF02000000000000000553636F72650000FFFFFFFFFFFFFF + FFFFFFFFFF} + ReadOnly = True + RowSelect = True + ParentFont = False + TabOrder = 0 + TabStop = False + ViewStyle = vsReport + end + end + end + object Panel5: TPanel + Left = 0 + Top = 286 + Width = 700 + Height = 8 + Align = alBottom + BevelOuter = bvNone + TabOrder = 1 + end + object Panel6: TPanel + Left = 0 + Top = 2 + Width = 488 + Height = 284 + Align = alClient + BevelOuter = bvNone + BorderStyle = bsSingle + TabOrder = 2 + object Shape1: TShape + Left = 0 + Top = 0 + Width = 484 + Height = 239 + Align = alClient + Brush.Color = 16711401 + Pen.Style = psClear + end + object Label14: TLabel + Left = 76 + Top = 60 + Width = 310 + Height = 40 + Caption = 'Morse Runner 1.68' + Font.Charset = ANSI_CHARSET + Font.Color = 12369084 + Font.Height = -35 + Font.Name = 'Arial' + Font.Style = [fsBold, fsItalic] + ParentFont = False + Transparent = True + end + object Label12: TLabel + Left = 71 + Top = 56 + Width = 310 + Height = 40 + Caption = 'Morse Runner 1.68' + Font.Charset = ANSI_CHARSET + Font.Color = clAqua + Font.Height = -35 + Font.Name = 'Arial' + Font.Style = [fsBold, fsItalic] + ParentFont = False + Transparent = True + end + object Label13: TLabel + Left = 70 + Top = 55 + Width = 310 + Height = 40 + Caption = 'Morse Runner 1.68' + Font.Charset = ANSI_CHARSET + Font.Color = clGreen + Font.Height = -35 + Font.Name = 'Arial' + Font.Style = [fsBold, fsItalic] + ParentFont = False + Transparent = True + end + object Label15: TLabel + Left = 106 + Top = 108 + Width = 245 + Height = 13 + Caption = 'Copyright © 2004-2006 Alex Shovkoplyas, VE3NEA' + Transparent = True + end + object Label16: TLabel + Left = 198 + Top = 128 + Width = 61 + Height = 13 + Caption = 'FREEWARE' + Transparent = True + end + object RichEdit1: TRichEdit + Left = 0 + Top = 239 + Width = 484 + Height = 41 + TabStop = False + Align = alBottom + BorderStyle = bsNone + Font.Charset = ANSI_CHARSET + Font.Color = clWindowText + Font.Height = -13 + Font.Name = 'Courier New' + Font.Style = [] + ParentFont = False + ReadOnly = True + ScrollBars = ssVertical + TabOrder = 0 + Visible = False + end + end + object Panel9: TPanel + Left = 488 + Top = 2 + Width = 212 + Height = 284 + Align = alRight + BevelOuter = bvNone + TabOrder = 3 + object GroupBox3: TGroupBox + Left = 9 + Top = 170 + Width = 194 + Height = 81 + Caption = ' Band Conditions ' + TabOrder = 0 + object Label11: TLabel + Left = 144 + Top = 16 + Width = 34 + Height = 13 + Caption = 'Activity' + end + object CheckBox2: TCheckBox + Left = 12 + Top = 58 + Width = 45 + Height = 17 + TabStop = False + Caption = 'QSB' + Checked = True + State = cbChecked + TabOrder = 0 + OnClick = CheckBoxClick + end + object CheckBox3: TCheckBox + Left = 12 + Top = 38 + Width = 45 + Height = 17 + TabStop = False + Caption = 'QRM' + Checked = True + State = cbChecked + TabOrder = 1 + OnClick = CheckBoxClick + end + object CheckBox4: TCheckBox + Left = 12 + Top = 18 + Width = 45 + Height = 17 + TabStop = False + Caption = 'QRN' + Checked = True + State = cbChecked + TabOrder = 2 + OnClick = CheckBoxClick + end + object CheckBox5: TCheckBox + Left = 76 + Top = 18 + Width = 53 + Height = 17 + TabStop = False + Caption = 'Flutter' + Checked = True + State = cbChecked + TabOrder = 3 + OnClick = CheckBoxClick + end + object CheckBox6: TCheckBox + Left = 76 + Top = 40 + Width = 45 + Height = 17 + TabStop = False + Caption = 'LID'#39's' + Checked = True + State = cbChecked + TabOrder = 4 + OnClick = CheckBoxClick + end + object SpinEdit3: TSpinEdit + Left = 144 + Top = 32 + Width = 37 + Height = 22 + TabStop = False + MaxLength = 1 + MaxValue = 9 + MinValue = 1 + TabOrder = 5 + Value = 3 + OnChange = SpinEdit3Change + end + end + object GroupBox1: TGroupBox + Left = 9 + Top = 6 + Width = 194 + Height = 159 + Caption = ' Station ' + TabOrder = 1 + object Label4: TLabel + Left = 12 + Top = 20 + Width = 17 + Height = 13 + Caption = 'Call' + end + object Label5: TLabel + Left = 156 + Top = 48 + Width = 27 + Height = 13 + Caption = 'WPM' + end + object Label6: TLabel + Left = 12 + Top = 48 + Width = 52 + Height = 13 + Caption = 'CW Speed' + end + object Label7: TLabel + Left = 12 + Top = 76 + Width = 45 + Height = 13 + Caption = 'CW Pitch' + end + object Label9: TLabel + Left = 12 + Top = 104 + Width = 68 + Height = 13 + Caption = 'RX Bandwidth' + end + object VolumeSlider1: TVolumeSlider + Left = 89 + Top = 132 + Width = 60 + Height = 20 + Hint = '-15.0 dB' + ShowHint = True + Margin = 5 + Value = 0.75 + Overloaded = False + OnChange = VolumeSlider1Change + OnDblClick = VolumeSliderDblClick + DbScale = 60 + Db = -15 + end + object Label18: TLabel + Left = 12 + Top = 134 + Width = 53 + Height = 13 + Caption = 'Mon. Level' + end + object Edit4: TEdit + Left = 36 + Top = 16 + Width = 89 + Height = 21 + TabStop = False + CharCase = ecUpperCase + TabOrder = 0 + Text = 'VE3NEA' + OnChange = Edit4Change + end + object SpinEdit1: TSpinEdit + Left = 88 + Top = 44 + Width = 65 + Height = 22 + TabStop = False + MaxLength = 3 + MaxValue = 120 + MinValue = 10 + TabOrder = 1 + Value = 30 + OnChange = SpinEdit1Change + end + object CheckBox1: TCheckBox + Left = 140 + Top = 18 + Width = 45 + Height = 17 + TabStop = False + Caption = 'QSK' + Checked = True + State = cbChecked + TabOrder = 2 + OnClick = CheckBox1Click + end + object ComboBox1: TComboBox + Left = 88 + Top = 72 + Width = 65 + Height = 21 + TabStop = False + Style = csDropDownList + DropDownCount = 12 + ItemHeight = 13 + TabOrder = 3 + OnChange = ComboBox1Change + Items.Strings = ( + '300 Hz' + '350 Hz' + '400 Hz' + '450 Hz' + '500 Hz' + '550 Hz' + '600 Hz' + '650 Hz' + '700 Hz' + '750 Hz' + '800 Hz' + '850 Hz' + '900 Hz') + end + object ComboBox2: TComboBox + Left = 88 + Top = 100 + Width = 65 + Height = 21 + TabStop = False + Style = csDropDownList + DropDownCount = 12 + ItemHeight = 13 + TabOrder = 4 + OnChange = ComboBox2Change + Items.Strings = ( + '100 Hz' + '150 Hz' + '200 Hz' + '250 Hz' + '300 Hz' + '350 Hz' + '400 Hz' + '450 Hz' + '500 Hz' + '550 Hz' + '600 Hz') + end + end + object Panel10: TPanel + Left = 0 + Top = 253 + Width = 212 + Height = 31 + Align = alBottom + BevelOuter = bvNone + TabOrder = 2 + object Label8: TLabel + Left = 173 + Top = 9 + Width = 19 + Height = 13 + Caption = 'min.' + end + object Label10: TLabel + Left = 103 + Top = 9 + Width = 12 + Height = 13 + Caption = 'for' + end + object SpinEdit2: TSpinEdit + Left = 122 + Top = 7 + Width = 45 + Height = 22 + TabStop = False + MaxLength = 2 + MaxValue = 240 + MinValue = 1 + TabOrder = 0 + Value = 30 + OnChange = SpinEdit2Change + end + object ToolBar1: TToolBar + Left = 13 + Top = 5 + Width = 84 + Height = 24 + Align = alNone + ButtonWidth = 65 + Caption = 'ToolBar1' + EdgeBorders = [] + Images = ImageList1 + Indent = 3 + List = True + ShowCaptions = True + TabOrder = 1 + object ToolButton1: TToolButton + Tag = 1 + Left = 3 + Top = 2 + AllowAllUp = True + Caption = ' Run ' + DropdownMenu = PopupMenu1 + Grouped = True + ImageIndex = 0 + Style = tbsDropDown + OnClick = RunBtnClick + end + end + end + end + object AlSoundOut1: TAlSoundOut + BufCount = 8 + OnBufAvailable = AlSoundOut1BufAvailable + Left = 384 + Top = 148 + end + object MainMenu1: TMainMenu + Left = 356 + Top = 148 + object File1: TMenuItem + Caption = 'File' + OnClick = File1Click + object ViewScoreTable1: TMenuItem + Caption = 'View Score Table' + OnClick = ViewScoreTable1Click + end + object ViewScoreBoardMNU: TMenuItem + Caption = 'View Hi-Score web page...' + OnClick = ViewScoreBoardMNUClick + end + object N5: TMenuItem + Caption = '-' + end + object AudioRecordingEnabled1: TMenuItem + Caption = 'Audio Recording Enabled' + OnClick = AudioRecordingEnabled1Click + end + object PlayRecordedAudio1: TMenuItem + Caption = 'Play Recorded Audio' + Enabled = False + OnClick = PlayRecordedAudio1Click + end + object N8: TMenuItem + Caption = '-' + end + object Exit1: TMenuItem + Caption = 'Exit' + OnClick = Exit1Click + end + end + object Run1: TMenuItem + Caption = 'Run' + object PileUp1: TMenuItem + Tag = 1 + Caption = 'Pile-Up' + ShortCut = 120 + OnClick = RunMNUClick + end + object SingleCalls1: TMenuItem + Tag = 2 + Caption = 'Single Calls' + OnClick = RunMNUClick + end + object Competition1: TMenuItem + Tag = 3 + Caption = 'WPX Competition' + OnClick = RunMNUClick + end + object HSTCompetition2: TMenuItem + Tag = 4 + Caption = 'HST Competition' + ShortCut = 16504 + OnClick = RunMNUClick + end + object N4: TMenuItem + Caption = '-' + end + object Stop1MNU: TMenuItem + Caption = 'Stop' + Enabled = False + OnClick = StopMNUClick + end + end + object Send1: TMenuItem + Caption = 'Send' + object CQ1: TMenuItem + Tag = 1 + Caption = 'CQ' + ShortCut = 112 + OnClick = SendClick + end + object Number1: TMenuItem + Tag = 2 + Caption = 'Number' + ShortCut = 113 + OnClick = SendClick + end + object TU1: TMenuItem + Tag = 3 + Caption = 'TU' + ShortCut = 114 + OnClick = SendClick + end + object MyCall1: TMenuItem + Tag = 4 + Caption = 'My Call' + ShortCut = 115 + OnClick = SendClick + end + object HisCall1: TMenuItem + Tag = 5 + Caption = 'His Call' + ShortCut = 116 + OnClick = SendClick + end + object QSOB41: TMenuItem + Tag = 6 + Caption = 'QSO B4' + ShortCut = 117 + OnClick = SendClick + end + object N1: TMenuItem + Tag = 7 + Caption = '' + ShortCut = 118 + OnClick = SendClick + end + object AGN1: TMenuItem + Tag = 8 + Caption = 'NIL' + ShortCut = 119 + OnClick = SendClick + end + end + object Settings1: TMenuItem + Caption = 'Settings' + OnClick = Settings1Click + object Call1: TMenuItem + Caption = 'Call...' + OnClick = Call1Click + end + object QSK1: TMenuItem + Caption = 'QSK' + OnClick = QSK1Click + end + object CWSpeed1: TMenuItem + Caption = 'CW Speed' + object N10WPM1: TMenuItem + Tag = 10 + Caption = '10 WPM' + OnClick = NWPMClick + end + object N15WPM1: TMenuItem + Tag = 15 + Caption = '15 WPM' + OnClick = NWPMClick + end + object N20WPM1: TMenuItem + Tag = 20 + Caption = '20 WPM' + OnClick = NWPMClick + end + object N25WPM1: TMenuItem + Tag = 25 + Caption = '25 WPM' + OnClick = NWPMClick + end + object N30WPM1: TMenuItem + Tag = 30 + Caption = '30 WPM' + OnClick = NWPMClick + end + object N35WPM1: TMenuItem + Tag = 35 + Caption = '35 WPM' + OnClick = NWPMClick + end + object N40WPM1: TMenuItem + Tag = 40 + Caption = '40 WPM' + OnClick = NWPMClick + end + object N45WPM1: TMenuItem + Tag = 45 + Caption = '45 WPM' + OnClick = NWPMClick + end + object N50WPM1: TMenuItem + Tag = 50 + Caption = '50 WPM' + OnClick = NWPMClick + end + object N55WPM1: TMenuItem + Tag = 55 + Caption = '55 WPM' + OnClick = NWPMClick + end + object N60WPM1: TMenuItem + Tag = 60 + Caption = '60 WPM' + OnClick = NWPMClick + end + end + object CWBandwidth1: TMenuItem + Caption = 'CW Pitch' + object N300Hz1: TMenuItem + Caption = '300 Hz' + OnClick = Pitch1Click + end + object N350Hz1: TMenuItem + Tag = 1 + Caption = '350 Hz' + OnClick = Pitch1Click + end + object N400Hz1: TMenuItem + Tag = 2 + Caption = '400 Hz' + OnClick = Pitch1Click + end + object N450Hz1: TMenuItem + Tag = 3 + Caption = '450 Hz' + OnClick = Pitch1Click + end + object N500Hz1: TMenuItem + Tag = 4 + Caption = '500 Hz' + OnClick = Pitch1Click + end + object N550Hz1: TMenuItem + Tag = 5 + Caption = '550 Hz' + OnClick = Pitch1Click + end + object N600Hz1: TMenuItem + Tag = 6 + Caption = '600 Hz' + OnClick = Pitch1Click + end + object N650Hz1: TMenuItem + Tag = 7 + Caption = '650 Hz' + OnClick = Pitch1Click + end + object N700Hz1: TMenuItem + Tag = 8 + Caption = '700 Hz' + OnClick = Pitch1Click + end + object N750Hz1: TMenuItem + Tag = 9 + Caption = '750 Hz' + OnClick = Pitch1Click + end + object N800Hz1: TMenuItem + Tag = 10 + Caption = '800 Hz' + OnClick = Pitch1Click + end + object N850Hz1: TMenuItem + Tag = 11 + Caption = '850 Hz' + OnClick = Pitch1Click + end + object N900Hz1: TMenuItem + Tag = 12 + Caption = '900 Hz' + OnClick = Pitch1Click + end + end + object CWBandwidth2: TMenuItem + Caption = 'CW Bandwidth' + object N100Hz1: TMenuItem + Caption = '100 Hz' + OnClick = Bw1Click + end + object N150Hz1: TMenuItem + Tag = 1 + Caption = '150 Hz' + OnClick = Bw1Click + end + object N200Hz1: TMenuItem + Tag = 2 + Caption = '200 Hz' + OnClick = Bw1Click + end + object N250Hz1: TMenuItem + Tag = 3 + Caption = '250 Hz' + OnClick = Bw1Click + end + object N300Hz2: TMenuItem + Tag = 4 + Caption = '300 Hz' + OnClick = Bw1Click + end + object N350Hz2: TMenuItem + Tag = 5 + Caption = '350 Hz' + OnClick = Bw1Click + end + object N400Hz2: TMenuItem + Tag = 6 + Caption = '400 Hz' + OnClick = Bw1Click + end + object N450Hz2: TMenuItem + Tag = 7 + Caption = '450 Hz' + OnClick = Bw1Click + end + object N500Hz2: TMenuItem + Tag = 8 + Caption = '500 Hz' + OnClick = Bw1Click + end + object N550Hz2: TMenuItem + Tag = 9 + Caption = '550 Hz' + OnClick = Bw1Click + end + object N600Hz2: TMenuItem + Tag = 10 + Caption = '600 Hz' + OnClick = Bw1Click + end + end + object MonLevel1: TMenuItem + Tag = -30 + Caption = 'Mon. Level' + object N30dB1: TMenuItem + Tag = -60 + Caption = '-60 dB' + OnClick = SelfMonClick + end + object N20dB1: TMenuItem + Tag = -40 + Caption = '-40 dB' + OnClick = SelfMonClick + end + object N10dB1: TMenuItem + Tag = -20 + Caption = '-20 dB' + OnClick = SelfMonClick + end + object N0dB1: TMenuItem + Caption = '0 dB' + OnClick = SelfMonClick + end + object N10dB2: TMenuItem + Tag = 20 + Caption = '+20 dB' + OnClick = SelfMonClick + end + end + object N6: TMenuItem + Caption = '-' + end + object QRN1: TMenuItem + Caption = 'QRN' + OnClick = LIDS1Click + end + object QRM1: TMenuItem + Caption = 'QRM' + OnClick = LIDS1Click + end + object QSB1: TMenuItem + Caption = 'QSB' + OnClick = LIDS1Click + end + object Flutter1: TMenuItem + Caption = 'Flutter' + OnClick = LIDS1Click + end + object LIDS1: TMenuItem + Caption = 'LIDS' + OnClick = LIDS1Click + end + object Activity1: TMenuItem + Caption = 'Activity' + object N11: TMenuItem + Tag = 1 + Caption = '1' + OnClick = Activity1Click + end + object N21: TMenuItem + Tag = 2 + Caption = '2' + OnClick = Activity1Click + end + object N31: TMenuItem + Tag = 3 + Caption = '3' + OnClick = Activity1Click + end + object N41: TMenuItem + Tag = 4 + Caption = '4' + OnClick = Activity1Click + end + object N51: TMenuItem + Tag = 5 + Caption = '5' + OnClick = Activity1Click + end + object N61: TMenuItem + Tag = 6 + Caption = '6' + OnClick = Activity1Click + end + object N71: TMenuItem + Tag = 7 + Caption = '7' + OnClick = Activity1Click + end + object N81: TMenuItem + Tag = 8 + Caption = '8' + OnClick = Activity1Click + end + object N91: TMenuItem + Tag = 9 + Caption = '9' + OnClick = Activity1Click + end + end + object N7: TMenuItem + Caption = '-' + end + object Duration1: TMenuItem + Caption = 'Duration' + object N5min1: TMenuItem + Tag = 5 + Caption = '5 min' + OnClick = Duration1Click + end + object N10min1: TMenuItem + Tag = 10 + Caption = '10 min' + OnClick = Duration1Click + end + object N15min1: TMenuItem + Tag = 15 + Caption = '15 min' + OnClick = Duration1Click + end + object N30min1: TMenuItem + Tag = 30 + Caption = '30 min' + OnClick = Duration1Click + end + object N60min1: TMenuItem + Tag = 60 + Caption = '60 min' + OnClick = Duration1Click + end + object N90min1: TMenuItem + Tag = 90 + Caption = '90 min' + OnClick = Duration1Click + end + object N120min1: TMenuItem + Tag = 120 + Caption = '120 min' + OnClick = Duration1Click + end + end + object Operator1: TMenuItem + Caption = 'HST Operator...' + OnClick = Operator1Click + end + end + object Help1: TMenuItem + Caption = 'Help' + object WebPage1: TMenuItem + Caption = 'Web Page...' + OnClick = WebPage1Click + end + object Readme1: TMenuItem + Caption = 'Readme...' + OnClick = Readme1Click + end + object N2: TMenuItem + Caption = '-' + end + object About1: TMenuItem + Caption = 'About...' + OnClick = About1Click + end + end + end + object PopupMenu1: TPopupMenu + Left = 356 + Top = 176 + object PileupMNU: TMenuItem + Tag = 1 + Caption = 'Pile-Up' + Default = True + OnClick = RunMNUClick + end + object SingleCallsMNU: TMenuItem + Tag = 2 + Caption = 'Single Calls' + OnClick = RunMNUClick + end + object CompetitionMNU: TMenuItem + Tag = 3 + Caption = 'WPX Competition' + OnClick = RunMNUClick + end + object HSTCompetition1: TMenuItem + Tag = 4 + Caption = 'HST Competition' + OnClick = RunMNUClick + end + object N3: TMenuItem + Caption = '-' + end + object StopMNU: TMenuItem + Caption = 'Stop' + Enabled = False + OnClick = StopMNUClick + end + end + object ImageList1: TImageList + Left = 384 + Top = 176 + Bitmap = { + 494C010102000400040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 0000000000003600000028000000400000001000000001002000000000000010 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000008484840000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000008484840084848400000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000848484000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000084848400848484000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00008484840084848400FFFFFF00000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000FF000000000000848484008484840000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000084848400FFFFFF0084848400FFFFFF000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000FF000000FF0000000000008484840084848400000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000084848400FFFFFF00C6C6C60084848400FFFFFF0000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000FF000000FF000000FF00000000000084848400848484000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000084848400FFFFFF00C6C6C600C6C6C60084848400FFFFFF00000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000FF000000FF000000FF000000FF000000000000848484008484 + 8400000000000000000000000000000000000000000000000000000000000000 + 000084848400FFFFFF00C6C6C600C6C6C600C6C6C60084848400FFFFFF000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000FF000000FF000000FF000000FF000000FF0000000000008484 + 8400848484000000000000000000000000000000000000000000000000000000 + 000084848400FFFFFF00C6C6C600C6C6C600C6C6C600C6C6C600848484000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000FF000000FF000000FF000000FF000000FF000000FF00000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000084848400FFFFFF00C6C6C600C6C6C600C6C6C600C6C6C600C6C6C6008484 + 8400000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000FF000000FF000000FF000000FF000000FF0000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000084848400FFFFFF00C6C6C600C6C6C600C6C6C600C6C6C600848484000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000FF000000FF000000FF000000FF000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000084848400FFFFFF00C6C6C600C6C6C600C6C6C60084848400000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000FF000000FF000000FF00000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000084848400FFFFFF00C6C6C600C6C6C6008484840000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000FF000000FF0000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000084848400FFFFFF00C6C6C600848484000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 00000000000000FF000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000084848400FFFFFF0084848400000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000848484008484840000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000848484000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 0000000000000000000000000000000000000000000000000000000000000000 + 000000000000000000000000000000000000424D3E000000000000003E000000 + 2800000040000000100000000100010000000000800000000000000000000000 + 000000000000000000000000FFFFFF00FBFFFFFF00000000F1FFF7FF00000000 + F0FFF1FF00000000F07FF0FF00000000F03FF07F00000000F01FF03F00000000 + F00FF01F00000000F007F01F00000000F00FF00F00000000F01FF01F00000000 + F03FF03F00000000F07FF07F00000000F0FFF0FF00000000F1FFF1FF00000000 + F3FFF3FF00000000F7FFF7FF0000000000000000000000000000000000000000 + 000000000000} + end + object AlWavFile1: TAlWavFile + Left = 384 + Top = 204 + end +end diff --git a/Main.pas b/Main.pas new file mode 100644 index 0000000..ac0b538 --- /dev/null +++ b/Main.pas @@ -0,0 +1,1160 @@ +//------------------------------------------------------------------------------ +//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 Main; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + Buttons, SndCustm, SndOut, Contest, Ini, MorseKey, CallLst, + VolmSldr, VolumCtl, StdCtrls, Station, Menus, ExtCtrls, Log, MAth, + ComCtrls, Spin, SndTypes, ShellApi, jpeg, ToolWin, ImgList, Crc32, + WavFile, IniFiles; + +const + WM_TBDOWN = WM_USER+1; + +type + TMainForm = class(TForm) + AlSoundOut1: TAlSoundOut; + MainMenu1: TMainMenu; + File1: TMenuItem; + Send1: TMenuItem; + CQ1: TMenuItem; + Number1: TMenuItem; + TU1: TMenuItem; + MyCall1: TMenuItem; + HisCall1: TMenuItem; + QSOB41: TMenuItem; + N1: TMenuItem; + AGN1: TMenuItem; + Bevel1: TBevel; + Panel1: TPanel; + Label1: TLabel; + SpeedButton4: TSpeedButton; + SpeedButton5: TSpeedButton; + SpeedButton6: TSpeedButton; + SpeedButton7: TSpeedButton; + SpeedButton8: TSpeedButton; + SpeedButton9: TSpeedButton; + SpeedButton10: TSpeedButton; + SpeedButton11: TSpeedButton; + Edit1: TEdit; + Label2: TLabel; + Edit2: TEdit; + Label3: TLabel; + Edit3: TEdit; + Bevel2: TBevel; + Panel2: TPanel; + Panel3: TPanel; + Panel4: TPanel; + Help1: TMenuItem; + Readme1: TMenuItem; + About1: TMenuItem; + N2: TMenuItem; + PaintBox1: TPaintBox; + Panel5: TPanel; + Exit1: TMenuItem; + Panel6: TPanel; + RichEdit1: TRichEdit; + Label12: TLabel; + Label13: TLabel; + Label14: TLabel; + Label15: TLabel; + Shape1: TShape; + PopupMenu1: TPopupMenu; + PileupMNU: TMenuItem; + SingleCallsMNU: TMenuItem; + CompetitionMNU: TMenuItem; + N3: TMenuItem; + StopMNU: TMenuItem; + ImageList1: TImageList; + Run1: TMenuItem; + PileUp1: TMenuItem; + SingleCalls1: TMenuItem; + Competition1: TMenuItem; + N4: TMenuItem; + Stop1MNU: TMenuItem; + ViewScoreBoardMNU: TMenuItem; + ViewScoreTable1: TMenuItem; + N5: TMenuItem; + Panel7: TPanel; + Label16: TLabel; + Panel8: TPanel; + Shape2: TShape; + AlWavFile1: TAlWavFile; + Panel9: TPanel; + GroupBox3: TGroupBox; + Label11: TLabel; + CheckBox2: TCheckBox; + CheckBox3: TCheckBox; + CheckBox4: TCheckBox; + CheckBox5: TCheckBox; + CheckBox6: TCheckBox; + SpinEdit3: TSpinEdit; + GroupBox1: TGroupBox; + Label4: TLabel; + Label5: TLabel; + Label6: TLabel; + Label7: TLabel; + Label9: TLabel; + Edit4: TEdit; + SpinEdit1: TSpinEdit; + CheckBox1: TCheckBox; + ComboBox1: TComboBox; + ComboBox2: TComboBox; + Panel10: TPanel; + Label8: TLabel; + SpinEdit2: TSpinEdit; + ToolBar1: TToolBar; + ToolButton1: TToolButton; + Label10: TLabel; + VolumeSlider1: TVolumeSlider; + Label18: TLabel; + WebPage1: TMenuItem; + Settings1: TMenuItem; + Call1: TMenuItem; + QSK1: TMenuItem; + CWSpeed1: TMenuItem; + N10WPM1: TMenuItem; + N15WPM1: TMenuItem; + N20WPM1: TMenuItem; + N25WPM1: TMenuItem; + N30WPM1: TMenuItem; + N35WPM1: TMenuItem; + N40WPM1: TMenuItem; + N45WPM1: TMenuItem; + N50WPM1: TMenuItem; + N55WPM1: TMenuItem; + N60WPM1: TMenuItem; + CWBandwidth1: TMenuItem; + CWBandwidth2: TMenuItem; + N300Hz1: TMenuItem; + N350Hz1: TMenuItem; + N400Hz1: TMenuItem; + N450Hz1: TMenuItem; + N500Hz1: TMenuItem; + N550Hz1: TMenuItem; + N600Hz1: TMenuItem; + N650Hz1: TMenuItem; + N700Hz1: TMenuItem; + N750Hz1: TMenuItem; + N800Hz1: TMenuItem; + N850Hz1: TMenuItem; + N900Hz1: TMenuItem; + N100Hz1: TMenuItem; + N150Hz1: TMenuItem; + N200Hz1: TMenuItem; + N250Hz1: TMenuItem; + N300Hz2: TMenuItem; + N350Hz2: TMenuItem; + N400Hz2: TMenuItem; + N450Hz2: TMenuItem; + N500Hz2: TMenuItem; + N550Hz2: TMenuItem; + N600Hz2: TMenuItem; + MonLevel1: TMenuItem; + N30dB1: TMenuItem; + N20dB1: TMenuItem; + N10dB1: TMenuItem; + N0dB1: TMenuItem; + N10dB2: TMenuItem; + N6: TMenuItem; + QRN1: TMenuItem; + QRM1: TMenuItem; + QSB1: TMenuItem; + Flutter1: TMenuItem; + LIDS1: TMenuItem; + Activity1: TMenuItem; + N11: TMenuItem; + N21: TMenuItem; + N31: TMenuItem; + N41: TMenuItem; + N51: TMenuItem; + N61: TMenuItem; + N71: TMenuItem; + N81: TMenuItem; + N91: TMenuItem; + N7: TMenuItem; + Duration1: TMenuItem; + N5min1: TMenuItem; + N10min1: TMenuItem; + N15min1: TMenuItem; + N30min1: TMenuItem; + N60min1: TMenuItem; + N90min1: TMenuItem; + N120min1: TMenuItem; + PlayRecordedAudio1: TMenuItem; + N8: TMenuItem; + AudioRecordingEnabled1: TMenuItem; + HSTCompetition1: TMenuItem; + HSTCompetition2: TMenuItem; + Panel11: TPanel; + ListView1: TListView; + Operator1: TMenuItem; + procedure FormCreate(Sender: TObject); + procedure AlSoundOut1BufAvailable(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure Edit1KeyPress(Sender: TObject; var Key: Char); + procedure Edit2KeyPress(Sender: TObject; var Key: Char); + procedure Edit3KeyPress(Sender: TObject; var Key: Char); + procedure FormKeyPress(Sender: TObject; var Key: Char); + procedure FormKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); + procedure Edit1Enter(Sender: TObject); + procedure SendClick(Sender: TObject); + procedure Edit4Change(Sender: TObject); + procedure ComboBox2Change(Sender: TObject); + procedure ComboBox1Change(Sender: TObject); + procedure FormClose(Sender: TObject; var Action: TCloseAction); + procedure SpinEdit1Change(Sender: TObject); + procedure CheckBox1Click(Sender: TObject); + procedure CheckBoxClick(Sender: TObject); + procedure SpinEdit2Change(Sender: TObject); + procedure SpinEdit3Change(Sender: TObject); + procedure PaintBox1Paint(Sender: TObject); + procedure Exit1Click(Sender: TObject); + procedure About1Click(Sender: TObject); + procedure Readme1Click(Sender: TObject); + procedure Edit1Change(Sender: TObject); + procedure RunMNUClick(Sender: TObject); + procedure RunBtnClick(Sender: TObject); + procedure ViewScoreBoardMNUClick(Sender: TObject); + procedure ViewScoreTable1Click(Sender: TObject); + procedure FormKeyUp(Sender: TObject; var Key: Word; + Shift: TShiftState); + procedure Panel8MouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); + procedure Shape2MouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); + procedure Edit2Enter(Sender: TObject); + procedure VolumeSliderDblClick(Sender: TObject); + procedure VolumeSlider1Change(Sender: TObject); + procedure WebPage1Click(Sender: TObject); + procedure Call1Click(Sender: TObject); + procedure QSK1Click(Sender: TObject); + procedure NWPMClick(Sender: TObject); + procedure Pitch1Click(Sender: TObject); + procedure Bw1Click(Sender: TObject); + procedure File1Click(Sender: TObject); + procedure PlayRecordedAudio1Click(Sender: TObject); + procedure AudioRecordingEnabled1Click(Sender: TObject); + procedure SelfMonClick(Sender: TObject); + procedure Settings1Click(Sender: TObject); + procedure LIDS1Click(Sender: TObject); + procedure Activity1Click(Sender: TObject); + procedure Duration1Click(Sender: TObject); + procedure Operator1Click(Sender: TObject); + procedure StopMNUClick(Sender: TObject); + private + MustAdvance: boolean; + procedure ProcessSpace; + procedure SendMsg(Msg: TStationMessage); + procedure ProcessEnter; + procedure EnableCtl(Ctl: TWinControl; AEnable: boolean); + procedure WmTbDown(var Msg: TMessage); message WM_TBDOWN; + procedure SetToolbuttonDown(Toolbutton: TToolbutton; ADown: boolean); + procedure IncRit(dF: integer); + procedure UpdateRitIndicator; + procedure DecSpeed; + procedure IncSpeed; + public + CompetitionMode: boolean; + procedure Run(Value: TRunMode); + procedure WipeBoxes; + procedure PopupScoreWpx; + procedure PopupScoreHst; + procedure Advance; + + procedure SetQsk(Value: boolean); + procedure SetMyCall(ACall: string); + procedure SetPitch(PitchNo: integer); + procedure SetBw(BwNo: integer); + procedure ReadCheckboxes; + end; + +var + MainForm: TMainForm; + +implementation + +uses ScoreDlg; + +{$R *.DFM} + +procedure TMainForm.FormCreate(Sender: TObject); +begin + Randomize; + Tst := TContest.Create; + LoadCallList; + + AlSoundOut1.BufCount := 4; + FromIni; + + MakeKeyer; + Keyer.Rate := 11025; + Keyer.BufSize := Ini.BufSize; + + Panel2.DoubleBuffered := true; + RichEdit1.Align := alClient; +end; + + +procedure TMainForm.FormDestroy(Sender: TObject); +begin + ToIni; + Tst.Free; + DestroyKeyer; +end; + + + +procedure TMainForm.AlSoundOut1BufAvailable(Sender: TObject); +begin + if AlSoundOut1.Enabled then + try AlSoundOut1.PutData(Tst.GetAudio); except end; +end; + + +procedure TMainForm.SendClick(Sender: TObject); +var + Msg: TStationMessage; +begin + Msg := TStationMessage((Sender as TComponent).Tag); + + SendMsg(Msg); + + case Msg of + msgHisCall: CallSent:= true; + msgNR: NrSent:= true; + end; +end; + + + +procedure TMainForm.SendMsg(Msg: TStationMessage); +begin + if Msg = msgHisCall then + begin + if Edit1.Text <> '' then Tst.Me.HisCall := Edit1.Text; + CallSent := true; + end; + + if Msg = msgNR then NrSent := true; + + Tst.Me.SendMsg(Msg); +end; + + +procedure TMainForm.Edit1KeyPress(Sender: TObject; var Key: Char); +begin + if not (Key in ['A'..'Z', 'a'..'z', '0'..'9', '/', '?', #8]) then Key := #0; +end; + +procedure TMainForm.Edit2KeyPress(Sender: TObject; var Key: Char); +begin + if not (Key in ['0'..'9', #8]) then Key := #0; +end; + +procedure TMainForm.Edit3KeyPress(Sender: TObject; var Key: Char); +begin + if not (Key in ['0'..'9', #8]) then Key := #0; +end; + + +procedure TMainForm.FormKeyPress(Sender: TObject; var Key: Char); +begin + case Key of +{ + #13: //^M = ESM + Ini.Esm := not Ini.Esm; +} + #23: //^W = Wipe + WipeBoxes; + + #25: //^Y = Edit + ; + + #27: //Esc = Abort send + begin + if msgHisCall in Tst.Me.Msg then CallSent := false; + if msgNR in Tst.Me.Msg then NrSent := false; + Tst.Me.AbortSend; + end; + + ';': // <#> + begin + SendMsg(msgHisCall); + SendMsg(msgNr); + end; + + '.', '+', '[', ',': //TU & Save + begin + if not CallSent then SendMsg(msgHisCall); + SendMsg(msgTU); + Log.SaveQso; + end; + + ' ': //next field + ProcessSpace; + + '\': // = F1 + SendMsg(msgCQ); + + else Exit; + end; + + Key := #0; +end; + + +procedure TMainForm.FormKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); +begin + case Key of + VK_INSERT: // <#> + begin + SendMsg(msgHisCall); + SendMsg(msgNr); + Key := 0; + end; + + VK_RETURN: //Save + ProcessEnter; + + VK_F11: + WipeBoxes; + + 87, 119: //Alt-W = Wipe + if GetKeyState(VK_MENU) < 0 then WipeBoxes else Exit; + +{ + 'M': //Alt-M = Auto CW + if GetKeyState(VK_MENU) < 0 + then Ini.AutoCw := not Ini.AutoCw + else Exit; +} + + VK_UP: + if GetKeyState(VK_CONTROL) >= 0 then IncRit(1) + else if RunMode <> rmHst then SetBw(ComboBox2.ItemIndex+1); + + VK_DOWN: + if GetKeyState(VK_CONTROL) >= 0 then IncRit(-1) + else if RunMode <> rmHst then SetBw(ComboBox2.ItemIndex-1); + + VK_PRIOR: //PgUp + IncSpeed; + + VK_NEXT: //PgDn + DecSpeed; + + + VK_F9: + if (ssAlt in Shift) or (ssCtrl in Shift) then DecSpeed; + + VK_F10: + if (ssAlt in Shift) or (ssCtrl in Shift) then IncSpeed; + + else Exit; + end; + + Key := 0; +end; + + +procedure TMainForm.FormKeyUp(Sender: TObject; var Key: Word; + Shift: TShiftState); +begin + case Key of + VK_INSERT, VK_RETURN: Key := 0; + end; +end; + + +procedure TMainForm.ProcessSpace; +begin + MustAdvance := false; + + if ActiveControl = Edit1 then + begin + if Edit2.Text = '' then Edit2.Text := '599'; + ActiveControl := Edit3; + end + else if ActiveControl = Edit2 then + begin + if Edit2.Text = '' then Edit2.Text := '599'; + ActiveControl := Edit3; + end + else + ActiveControl := Edit1; +end; + + +procedure TMainForm.ProcessEnter; +var + C, N, R: boolean; +begin + MustAdvance := false; + + if (GetKeyState(VK_CONTROL) or GetKeyState(VK_SHIFT) or GetKeyState(VK_MENU)) < 0 + then begin Log.SaveQso; Exit; end; + + //no QSO in progress, send CQ + if Edit1.Text = '' then begin SendMsg(msgCq); Exit; end; + + //current state + C := CallSent; + N := NrSent; + R := Edit3.Text <> ''; + + //send his call if did not send before, or if call changed + if (not C) or ((not N) and (not R)) then SendMsg(msgHisCall); + if not N then SendMsg(msgNR); + if N and not R then SendMsg(msgQm); + + if R and (C or N) + then + begin + SendMsg(msgTU); + Log.SaveQso; + end + else + MustAdvance := true; +end; + + +procedure TMainForm.Edit1Enter(Sender: TObject); +var + P: integer; +begin + P := Pos('?', Edit1.Text); + if P > 1 then + begin Edit1.SelStart := P-1; Edit1.SelLength := 1; end; +end; + + +procedure TMainForm.IncSpeed; +begin + Wpm := Trunc(Wpm / 5) * 5 + 5; + Wpm := Max(10, Min(120, Wpm)); + SpinEdit1.Value := Wpm; + Tst.Me.Wpm := Wpm; +end; + + +procedure TMainForm.DecSpeed; +begin + Wpm := Ceil(Wpm / 5) * 5 - 5; + Wpm := Max(10, Min(120, Wpm)); + SpinEdit1.Value := Wpm; + Tst.Me.Wpm := Wpm; +end; + + +procedure TMainForm.Edit4Change(Sender: TObject); +begin + SetMyCall(Trim(Edit4.Text)); +end; + +procedure TMainForm.SetMyCall(ACall: string); +begin + Ini.Call := ACall; + Edit4.Text := ACall; + Tst.Me.MyCall := ACall; +end; + +procedure TMainForm.SetPitch(PitchNo: integer); +begin + Ini.Pitch := 300 + PitchNo * 50; + ComboBox1.ItemIndex := PitchNo; + Tst.Modul.CarrierFreq := Ini.Pitch; +end; + + +procedure TMainForm.SetBw(BwNo: integer); +begin + if (BwNo < 0) or (BwNo >= ComboBox2.Items.Count) then Exit; + + Ini.Bandwidth := 100 + BwNo * 50; + ComboBox2.ItemIndex := BwNo; + + Tst.Filt.Points := Round(0.7 * 11025 / Ini.BandWidth); + Tst.Filt.GainDb := 10 * Log10(500/Ini.Bandwidth); + Tst.Filt2.Points := Tst.Filt.Points; + Tst.Filt2.GainDb := Tst.Filt.GainDb; + + UpdateRitIndicator; +end; + + + + +procedure TMainForm.ComboBox2Change(Sender: TObject); +begin + SetBw(ComboBox2.ItemIndex); +end; + +procedure TMainForm.ComboBox1Change(Sender: TObject); +begin + SetPitch(ComboBox1.ItemIndex); +end; + +procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction); +begin + AlSoundOut1.Enabled := false; + if AlWavFile1.IsOpen then AlWavFile1.Close; +end; + +procedure TMainForm.SpinEdit1Change(Sender: TObject); +begin + Ini.Wpm := SpinEdit1.Value; + Tst.Me.Wpm := Ini.Wpm; +end; + +procedure TMainForm.CheckBox1Click(Sender: TObject); +begin + SetQsk(CheckBox1.Checked); + ActiveControl := Edit1; +end; + +procedure TMainForm.CheckBoxClick(Sender: TObject); +begin + ReadCheckboxes; + ActiveControl := Edit1; +end; + + +procedure TMainForm.ReadCheckboxes; +begin + Ini.Qrn := CheckBox4.Checked; + Ini.Qrm := CheckBox3.Checked; + Ini.Qsb := CheckBox2.Checked; + Ini.Flutter := CheckBox5.Checked; + Ini.Lids := CheckBox6.Checked; +end; + + +procedure TMainForm.SpinEdit2Change(Sender: TObject); +begin + Ini.Duration := SpinEdit2.Value; +end; + +procedure TMainForm.SpinEdit3Change(Sender: TObject); +begin + Ini.Activity := SpinEdit3.Value; +end; + +procedure TMainForm.PaintBox1Paint(Sender: TObject); +begin + Log.PaintHisto; +end; + +procedure TMainForm.Exit1Click(Sender: TObject); +begin + Close; +end; + + +procedure TMainForm.WipeBoxes; +begin + Edit1.Text := ''; + Edit2.Text := ''; + Edit3.Text := ''; + ActiveControl := Edit1; + + CallSent := false; + NrSent := false; +end; + + +procedure TMainForm.About1Click(Sender: TObject); +const + Msg = 'CW CONTEST SIMULATOR'#13#13 + + 'Copyright © 2004-2006 Alex Shovkoplyas, VE3NEA'#13#13 + + 've3nea@dxatlas.com'#13; +begin + Application.MessageBox(Msg, 'Morse Runner 1.68', MB_OK or MB_ICONINFORMATION); +end; + + +procedure TMainForm.Readme1Click(Sender: TObject); +var + FileName: string; +begin + FileName := ExtractFilePath(ParamStr(0)) + 'readme.txt'; + ShellExecute(GetDesktopWindow, 'open', PChar(FileName), '', '', SW_SHOWNORMAL); +end; + + +procedure TMainForm.Edit1Change(Sender: TObject); +begin + if Edit1.Text = '' then NrSent := false; + if not Tst.Me.UpdateCallInMessage(Edit1.Text) + then CallSent := false; +end; + + +procedure TMainForm.RunMNUClick(Sender: TObject); +begin + Run(TRunMode((Sender as TComponent).Tag)); +end; + + +procedure TMainForm.Edit2Enter(Sender: TObject); +begin + if Length(Edit2.Text) = 3 then + begin Edit2.SelStart := 1; Edit2.SelLength := 1; end; +end; + + + +procedure TMainForm.EnableCtl(Ctl: TWinControl; AEnable: boolean); +const + Clr: array[boolean] of TColor = (clBtnFace, clWindow); +begin + Ctl.Enabled := AEnable; + if Ctl is TSpinEdit then (Ctl as TSpinEdit).Color := Clr[AEnable] + else if Ctl is TEdit then (Ctl as TEdit).Color := Clr[AEnable]; +end; + + +procedure TMainForm.Run(Value: TRunMode); +const + Title: array[TRunMode] of string = + ('', 'Pile-Up', 'Single Calls', 'COMPETITION', 'H S T', 'Custom'); +var + BCompet, BStop: boolean; +begin + if Value = Ini.RunMode then Exit; + + BStop := Value = rmStop; + BCompet := Value in [rmWpx, rmHst]; + RunMode := Value; + + //main ctls + EnableCtl(Edit4, BStop); + EnableCtl(SpinEdit2, BStop); + SetToolbuttonDown(ToolButton1, not BStop); + + //condition checkboxes + EnableCtl(CheckBox2, not BCompet); + EnableCtl(CheckBox3, not BCompet); + EnableCtl(CheckBox4, not BCompet); + EnableCtl(CheckBox5, not BCompet); + EnableCtl(CheckBox6, not BCompet); + if RunMode = rmWpx then + begin + CheckBox2.Checked := true; + CheckBox3.Checked := true; + CheckBox4.Checked := true; + CheckBox5.Checked := true; + CheckBox6.Checked := true; + SpinEdit2.Value := CompDuration; + end + else if RunMode = rmHst then + begin + CheckBox2.Checked := false; + CheckBox3.Checked := false; + CheckBox4.Checked := false; + CheckBox5.Checked := false; + CheckBox6.Checked := false; + SpinEdit2.Value := CompDuration; + end; + + //button menu + PileupMNU.Enabled := BStop; + SingleCallsMNU.Enabled := BStop; + CompetitionMNU.Enabled := BStop; + HSTCompetition1.Enabled := BStop; + StopMNU.Enabled := not BStop; + + //main menu + PileUp1.Enabled := BStop; + SingleCalls1.Enabled := BStop; + Competition1.Enabled := BStop; + HSTCompetition2.Enabled := BStop; + Stop1MNU.Enabled := not BStop; + + Call1.Enabled := BStop; + Duration1.Enabled := BStop; + QRN1.Enabled := not BCompet; + QRM1.Enabled := not BCompet; + QSB1.Enabled := not BCompet; + Flutter1.Enabled := not BCompet; + Lids1.Enabled := not BCompet; + + + + //hst specific + Activity1.Enabled := Value <> rmHst; + CWBandwidth2.Enabled := Value <> rmHst; + + EnableCtl(SpinEdit3, RunMode <> rmHst); + if RunMode = rmHst then SpinEdit3.Value := 4; + + EnableCtl(ComboBox2, RunMode <> rmHst); + if RunMode = rmHst then begin ComboBox2.ItemIndex :=10; SetBw(10); end; + + if RunMode = rmHst then ListView1.Visible := false + else if RunMode <> rmStop then ListView1.Visible := true; + + + //mode caption + Panel4.Caption := Title[Value]; + if BCompet + then Panel4.Font.Color := clRed else Panel4.Font.Color := clGreen; + + if not BStop then + begin + Tst.Me.AbortSend; + Tst.BlockNumber := 0; + Tst.Me.Nr := '1'; + Log.Clear; + WipeBoxes; + RichEdit1.Visible := true; + {! ?}Panel5.Update; + end; + + if not BStop then IncRit(0); + + + + if BStop + then + begin + if AlWavFile1.IsOpen then AlWavFile1.Close; + end + else + begin + AlWavFile1.FileName := ChangeFileExt(ParamStr(0), '.wav'); + if SaveWav then AlWavFile1.OpenWrite; + end; + + AlSoundOut1.Enabled := not BStop; +end; + + + +procedure TMainForm.RunBtnClick(Sender: TObject); +begin + if RunMode = rmStop + then Run(rmPileUp) + else Tst.FStopPressed := true; +end; + +procedure TMainForm.WmTbDown(var Msg: TMessage); +begin + TToolbutton(Msg.LParam).Down := Boolean(Msg.WParam); +end; + + +procedure TMainForm.SetToolbuttonDown(Toolbutton: TToolbutton; + ADown: boolean); +begin + Windows.PostMessage(Handle, WM_TBDOWN, Integer(ADown), Integer(Toolbutton)); +end; + + + +procedure TMainForm.PopupScoreWpx; +var + S, FName: string; + Score: integer; +begin + S := Format('%s %s %s %s ', [ + FormatDateTime('yyyy-mm-dd', Now), + Ini.Call, + ListView1.Items[0].SubItems[1], + ListView1.Items[1].SubItems[1]]); + + S := S + '[' + IntToHex(CalculateCRC32(S, $C90C2086), 8) + ']'; + + + FName := ChangeFileExt(ParamStr(0), '.lst'); + with TStringList.Create do + try + if FileExists(FName) then LoadFromFile(FName); + Add(S); + SaveToFile(FName); + finally Free; end; + + ScoreDialog.Edit1.Text := S; + + + Score := StrToIntDef(ListView1.Items[2].SubItems[1], 0); + if Score > HiScore + then ScoreDialog.Height := 192 + else ScoreDialog.Height := 129; + HiScore := Max(HiScore, Score); + ScoreDialog.ShowModal; +end; + + +procedure TMainForm.PopupScoreHst; +var + S: string; + FName: TFileName; +begin + S := Format('%s'#9'%s'#9'%s'#9'%s', [ + FormatDateTime('yyyy-mm-dd hh:nn', Now), + Ini.Call, + Ini.HamName, + Panel11.Caption]); + + FName := ExtractFilePath(ParamStr(0)) + 'HstResults.txt'; + with TStringList.Create do + try + if FileExists(FName) then LoadFromFile(FName); + Add(S); + SaveToFile(FName); + finally Free; end; + + ShowMessage('HST Score: ' + ListView1.Items[2].SubItems[1]); +end; + + +procedure OpenWebPage(Url: string); +begin + ShellExecute(GetDesktopWindow, 'open', PChar(Url), '', '', SW_SHOWNORMAL); +end; + + +procedure TMainForm.ViewScoreBoardMNUClick(Sender: TObject); +begin + OpenWebPage('http://www.dxatlas.com/MorseRunner/MrScore.asp'); +end; + +procedure TMainForm.ViewScoreTable1Click(Sender: TObject); +var + FName: string; +begin + RichEdit1.Clear; + FName := ChangeFileExt(ParamStr(0), '.lst'); + if FileExists(FName) + then RichEdit1.Lines.LoadFromFile(FName) + else RichEdit1.Lines.Add('Your score table is empty'); + RichEdit1.Visible := true; +end; + + +procedure TMainForm.Panel8MouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); +begin + if X < Shape2.Left then IncRit(-1) + else if X > (Shape2.Left + Shape2.Width) then IncRit(1); +end; + + +procedure TMainForm.Shape2MouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); +begin + IncRit(0); +end; + + +procedure TMainForm.IncRit(dF: integer); +begin + case dF of + -1: Inc(Ini.Rit, -50); + 0: Ini.Rit := 0; + 1: Inc(Ini.Rit, 50); + end; + + Ini.Rit := Min(500, Max(-500, Ini.Rit)); + UpdateRitIndicator; +end; + + +procedure TMainForm.UpdateRitIndicator; +begin + Shape2.Width := Ini.Bandwidth div 9; + Shape2.Left := ((Panel8.Width - Shape2.Width) div 2) + (Ini.Rit div 9); +end; + + +procedure TMainForm.Advance; +begin + if not MustAdvance then Exit; + + if Edit2.Text = '' then Edit2.Text := '599'; + + if Pos('?', Edit1.Text) = 0 then ActiveControl := Edit3 + else if ActiveControl = Edit1 then Edit1Enter(nil) + else ActiveControl := Edit1; + + MustAdvance := false; +end; + + + +procedure TMainForm.VolumeSliderDblClick(Sender: TObject); +begin + with Sender as TVolumeSlider do + begin + Value := 0.75; + OnChange(Sender); + end; +end; + +procedure TMainForm.VolumeSlider1Change(Sender: TObject); +begin + with VolumeSlider1 do + begin + //-60..+20 dB + Db := 80 * (Value - 0.75); + if dB > 0 + then Hint := Format('+%.0f dB', [dB]) + else Hint := Format( '%.0f dB', [dB]); + end; +end; + + +procedure TMainForm.WebPage1Click(Sender: TObject); +begin + OpenWebPage('http://www.dxatlas.com/MorseRunner'); +end; + + + + +//------------------------------------------------------------------------------ +// accessibility +//------------------------------------------------------------------------------ +procedure TMainForm.Call1Click(Sender: TObject); +begin + SetMyCall(Trim(InputBox('Callsign', 'Callsign', Edit4.Text))); +end; + + +procedure TMainForm.SetQsk(Value: boolean); +begin + Qsk := Value; + CheckBox1.Checked := Qsk; +end; + + +procedure TMainForm.QSK1Click(Sender: TObject); +begin + SetQsk(not QSK1.Checked); +end; + + +procedure TMainForm.NWPMClick(Sender: TObject); +begin + Wpm := (Sender as TMenuItem).Tag; + Wpm := Max(10, Min(120, Wpm)); + SpinEdit1.Value := Wpm; + Tst.Me.Wpm := Wpm; +end; + + + +procedure TMainForm.Pitch1Click(Sender: TObject); +begin + SetPitch((Sender as TMenuItem).Tag); + +end; + +procedure TMainForm.Bw1Click(Sender: TObject); +begin + SetBw((Sender as TMenuItem).Tag); +end; + +procedure TMainForm.File1Click(Sender: TObject); +var + Stp: boolean; +begin + Stp := RunMode = rmStop; + + AudioRecordingEnabled1.Enabled := Stp; + PlayRecordedAudio1.Enabled := Stp and FileExists(ChangeFileExt(ParamStr(0), '.wav')); + + AudioRecordingEnabled1.Checked := Ini.SaveWav; +end; + +procedure TMainForm.PlayRecordedAudio1Click(Sender: TObject); +var + FileName: string; +begin + FileName := ChangeFileExt(ParamStr(0), '.wav'); + ShellExecute(GetDesktopWindow, 'open', PChar(FileName), '', '', SW_SHOWNORMAL); +end; + + +procedure TMainForm.AudioRecordingEnabled1Click(Sender: TObject); +begin + Ini.SaveWav := not Ini.SaveWav; +end; + + + +procedure TMainForm.SelfMonClick(Sender: TObject); +begin + VolumeSlider1.Value := (Sender as TMenuItem).Tag / 80 + 0.75; + VolumeSlider1.OnChange(Sender); +end; + +procedure TMainForm.Settings1Click(Sender: TObject); +begin + QSK1.Checked := Ini.Qsk; + QRN1.Checked := Ini.Qrn; + QRM1.Checked := Ini.Qrm; + QSB1.Checked := Ini.Qsb; + Flutter1.Checked := Ini.Flutter; + LIDS1.Checked := Ini.Lids; +end; + +//ALL checkboxes +procedure TMainForm.LIDS1Click(Sender: TObject); +begin + with Sender as TMenuItem do Checked := not Checked; + + CheckBox4.Checked := QRN1.Checked; + CheckBox3.Checked := QRM1.Checked; + CheckBox2.Checked := QSB1.Checked; + CheckBox5.Checked := Flutter1.Checked; + CheckBox6.Checked := LIDS1.Checked; + + ReadCheckboxes; +end; + + + +procedure TMainForm.Activity1Click(Sender: TObject); +begin + Ini.Activity := (Sender as TMenuItem).Tag; + SpinEdit3.Value := Ini.Activity; +end; + + +procedure TMainForm.Duration1Click(Sender: TObject); +begin + Ini.Duration := (Sender as TMenuItem).Tag; + SpinEdit2.Value := Ini.Duration; +end; + + +procedure TMainForm.Operator1Click(Sender: TObject); +begin + HamName := InputBox('HST Operator', 'Enter operator''s name', HamName); + + if HamName <> '' + then Caption := 'Morse Runner: ' + HamName + else Caption := 'Morse Runner'; + + with TIniFile.Create(ChangeFileExt(ParamStr(0), '.ini')) do + try WriteString(SEC_STN, 'Name', HamName); + finally Free; end; +end; + +procedure TMainForm.StopMNUClick(Sender: TObject); +begin + Tst.FStopPressed := true; +end; + +end. + diff --git a/MorseRunner.dpr b/MorseRunner.dpr new file mode 100644 index 0000000..37a5e55 --- /dev/null +++ b/MorseRunner.dpr @@ -0,0 +1,44 @@ +program MorseRunner; + +uses + Forms, + Main in 'Main.pas' {MainForm}, + Contest in 'Contest.pas', + RndFunc in 'RndFunc.pas', + Ini in 'Ini.pas', + Station in 'Station.pas', + MorseKey in 'VCL\MorseKey.pas', + StnColl in 'StnColl.pas', + DxStn in 'DxStn.pas', + MyStn in 'MyStn.pas', + CallLst in 'CallLst.pas', + QrmStn in 'QrmStn.pas', + Log in 'Log.pas', + Qsb in 'Qsb.pas', + DxOper in 'DxOper.pas', + QrnStn in 'QrnStn.pas', + ScoreDlg in 'ScoreDlg.pas' {ScoreDialog}, + BaseComp in 'VCL\BaseComp.pas', + PermHint in 'VCL\PermHint.pas', + Crc32 in 'VCL\Crc32.pas', + SndCustm in 'VCL\SndCustm.pas', + SndTypes in 'VCL\SndTypes.pas', + SndOut in 'VCL\SndOut.pas', + MorseTbl in 'VCL\MorseTbl.pas', + QuickAvg in 'VCL\QuickAvg.pas', + MovAvg in 'VCL\MovAvg.pas', + Mixers in 'VCL\Mixers.pas', + VolumCtl in 'VCL\VolumCtl.pas', + VolmSldr in 'VCL\VolmSldr.pas', + WavFile in 'VCL\WavFile.pas'; + +{$R *.RES} + +begin + Application.Initialize; + Application.Title := 'Morse Runner'; + Application.CreateForm(TMainForm, MainForm); + Application.CreateForm(TScoreDialog, ScoreDialog); + Application.Run; +end. + diff --git a/MorseRunner.ico b/MorseRunner.ico new file mode 100644 index 0000000000000000000000000000000000000000..59dc7421860389a6d9cd0d2db0c9238e47026280 GIT binary patch literal 1078 zcmbtTv2NQi5PggaPy&ib9g1eNry?IwH2s9G{R?*}q|GeSK+2?y@#J4&(F`2~=oh@T zV>Z!%;Oir4*)EVFK+b-=dw0A$iZ}uaXPD0mc=>wgjNF zL^|Y69ZP5*9dcLiJET<|X;tleSGA8;&D2saJ#7ye&?V{EPZfX#Y1g?afw`pJNrEBm zLPEA$0XlMa$nM3_QN3o|vcO74+1>?iQ=WLuTk7wa&!Ljdu;Mx7?&v%q?{v&;%C9)RTX%VMHHduKe~ru)=HrtDqIZZP0D$liG*rj8s|R)>fKkbD87W3sO1V6bKsG0dqa3V@~!WP VU)=SbP}f{qg3nSB*931d;2-NHCQ1MR literal 0 HcmV?d00001 diff --git a/MorseRunner16.bmp b/MorseRunner16.bmp new file mode 100644 index 0000000000000000000000000000000000000000..249c3170ba0f03c2bdb7f8703248968d1877ea93 GIT binary patch literal 246 zcmX|&F$%&!5Jg82>_m%zO-Sn@tn592MebmuyN$4dA=~9jDN~{B}aZbP*T6{I3X)GMPnU9LW-_T&mxe;)jkfXY;QAk`8(F?-U2*wzr#ykth zh{2RNdT*>hAh5QgQVUPwbFi=4`Zt~5Je|ZqzzICS4f$2q|aTb7B^Ao%oY(_hH9@uu_Y4jOyfJGgO!k+KV$5W zff?rg&)9~y_v1ZD98q79FI(Qx13Co!>vPB;#99;Krn(LfRJ6#N`o4$ZQ@`=vCU zU;XVY+&}6MbHQI4&lngPUDp0UIOVn$beZ>s_ctuSu5%ftiI@f1M}RH6@LT3n{19g@ jqpU9`O58s(&bRXUQiSs-#KiU+lVnmC8rn^>@{fN3v|)jo literal 0 HcmV?d00001 diff --git a/MyStn.pas b/MyStn.pas new file mode 100644 index 0000000..f287a94 --- /dev/null +++ b/MyStn.pas @@ -0,0 +1,192 @@ +//------------------------------------------------------------------------------ +//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 + SysUtils, Classes, Station, RndFunc, Ini, SndTypes, MorseKey; + +type + TMyStation = class(TStation) + private + Pieces: TStringList; + procedure AddToPieces(AMsg: string); + procedure SendNextPiece; + public + constructor CreateStation; + destructor Destroy; override; + procedure Init; + procedure ProcessEvent(AEvent: TStationEvent); override; + procedure AbortSend; + procedure SendText(AMsg: string); override; + function GetBlock: TSingleArray; override; + function UpdateCallInMessage(ACall: string): boolean; + end; + + +implementation + +uses + Contest, Main; + +{ TMyStation } + +constructor TMyStation.CreateStation; +begin + inherited Create(nil); + Pieces := TStringList.Create; + Init; +end; + + +destructor TMyStation.Destroy; +begin + Pieces.Free; + inherited; +end; + + +procedure TMyStation.Init; +begin + MyCall := Ini.Call; + NR := '1'; + RST := 599; + Pitch := Ini.Pitch; + Wpm := Ini.Wpm; + Amplitude := 300000; +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 + 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('', AMsg); + while p > 0 do + begin + Pieces.Add(Copy(AMsg, 1, p-1)); + Pieces.Add('@'); //his callsign indicator + Delete(AMsg, 1, p+4); + p := Pos('', AMsg); + end; + Pieces.Add(AMsg); + + for i:= Pieces.Count-1 downto 0 do + if Pieces[i] = '' then Pieces.Delete(i); +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.Wpm := Wpm; + 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. + diff --git a/QrmStn.pas b/QrmStn.pas new file mode 100644 index 0000000..a0380c0 --- /dev/null +++ b/QrmStn.pas @@ -0,0 +1,61 @@ +//------------------------------------------------------------------------------ +//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 QrmStn; + +interface + +uses + SysUtils, Classes, Station, RndFunc, Ini, CallLst, QuickAvg, SndTypes, + Math; + +type + TQrmStation = class(TStation) + private + Patience: integer; + public + constructor CreateStation; + procedure ProcessEvent(AEvent: TStationEvent); override; + end; + +implementation + +constructor TQrmStation.CreateStation; +begin + inherited Create(nil); + + Patience := 1 + Random(5); + MyCall := PickCall; + HisCall := Ini.Call; + Amplitude := 5000 + 25000 * Random; + Pitch := Round(RndGaussLim(0, 300)); + Wpm := 30 + Random(20); + + case Random(7) of + 0: SendMsg(MsgQrl); + 1,2: SendMsg(MsgQrl2); + 3,4,5: SendMsg(msgLongCQ); + 6: SendMsg(MsqQsy); + end; +end; + + +procedure TQrmStation.ProcessEvent(AEvent: TStationEvent); +begin + case AEvent of + evMsgSent: + begin + Dec(Patience); + if Patience = 0 + then Free + else Timeout := Round(RndGaussLim(SecondsToBlocks(4), 2)); + end; + evTimeout: + SendMsg(msgLongCQ); + end; +end; + +end. + diff --git a/QrnStn.pas b/QrnStn.pas new file mode 100644 index 0000000..92e82dc --- /dev/null +++ b/QrnStn.pas @@ -0,0 +1,46 @@ +//------------------------------------------------------------------------------ +//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 QrnStn; + +interface + +uses + SysUtils, Classes, Station, RndFunc, Ini, CallLst, QuickAvg, SndTypes, + Math; + +type + TQrnStation = class(TStation) + public + constructor CreateStation; + procedure ProcessEvent(AEvent: TStationEvent); override; + end; + +implementation + +constructor TQrnStation.CreateStation; +var + i: integer; + Dur: integer; +begin + inherited Create(nil); + + Dur := SecondsToBlocks(Random) * Ini.BufSize; + SetLength(Envelope, Dur); + Amplitude := 1E5*Power(10, 2*Random); + for i:=0 to High(Envelope) do + if Random < 0.01 then Envelope[i] := (Random-0.5) * Amplitude; + + State := stSending; +end; + + +procedure TQrnStation.ProcessEvent(AEvent: TStationEvent); +begin + if AEvent = evMsgSent then Free; +end; + +end. + diff --git a/Qsb.pas b/Qsb.pas new file mode 100644 index 0000000..041148e --- /dev/null +++ b/Qsb.pas @@ -0,0 +1,80 @@ +//------------------------------------------------------------------------------ +//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 Qsb; + +interface + +uses + SysUtils, QuickAvg, SndTypes, RndFunc, Math, Ini; + +type + TQsb = class + private + Filt: TQuickAverage; + FGain: Single; + FBandwidth: Single; + function NewGain: Single; + procedure SetBandwidth(const Value: Single); + public + QsbLevel: Single; + constructor Create; + procedure ApplyTo(Arr: TSingleArray); + property Bandwidth: Single read FBandwidth write SetBandwidth; + end; + + +implementation + + +constructor TQsb.Create; +begin + Filt := TQuickAverage.Create(nil); + Filt.Passes := 3; + QsbLevel := 1;//0.5 + 0.5 * RndUShaped; + Bandwidth := 0.1; +end; + +function TQsb.NewGain: Single; +begin + with Filt.Filter(RndUniform, RndUniform) do + Result := Sqrt((Sqr(Re) + Sqr(Im)) * 3 * Filt.Points); + Result := Result * QsbLevel + (1-QsbLevel); +end; + + +procedure TQsb.SetBandwidth(const Value: Single); +var + i: integer; +begin + FBandwidth := Value; + Filt.Points := Ceil(0.37 * 11025 / ((Ini.BufSize div 4) * Value)); + for i:=0 to Filt.Points*3 do FGain := NewGain; +end; + + +procedure TQsb.ApplyTo(Arr: TSingleArray); +var + b, i: integer; + dG: Single; + BlkCnt: integer; +begin + BlkCnt := Length(Arr) div (Ini.BufSize div 4); + + for b:=0 to BlkCnt-1 do + begin + dG := (NewGain - FGain) / (Ini.BufSize div 4); + for i:=0 to (Ini.BufSize div 4)-1 do + begin + Arr[b * (Ini.BufSize div 4) + i] := Arr[b * (Ini.BufSize div 4) + i] * FGain; + FGain := FGain + dG; + end; + end; +end; + + + +end. + diff --git a/Readme.txt b/Readme.txt new file mode 100644 index 0000000..2947080 --- /dev/null +++ b/Readme.txt @@ -0,0 +1,321 @@ + MORSE RUNNER 1.68 + + Contest Simulator + + freeware + + Copyright (C) 2004-2006 Alex Shovkoplyas, VE3NEA + + http://www.dxatlas.com/MorseRunner/ + + + + +PLATFORMS + + - Windows 95/98/ME/NT4/2000/XP; + - works on Linux systems under WINE (info TNX F8BQQ). + + + +INSTALLATION + + - run Setup.exe and follow the on-screen instructions. + + + +UNINSTALLATION + + - click on Add/Remove Programs in the Windows Control Panel; + - select Morse Runner in the list of installed programs and click on Remove. + + + +CONFIGURATION + + Station + + Call - enter your contest callsign here. + + QSK - simulates the semi-duplex operation of the radio. Enable it if your + physical radio supports QSK. If it doesn't, enable QSK anyway to see + what you are missing. + + CW Speed - select the CW speed, in WPM (PARIS system) that matches your + skills. The calling stations will call you at about the same speed. + + CW Pitch - pitch in Hz. + + RX Bandwidth - the receiver bandwidth, in Hz. + + Audio Recording Enabled - when this menu option is checked, MR saves + the audio in the MorseRunner.wav file. If this file already + exists, MR overwrites it. + + + + Band Conditions + + I tried to make the sound as realistic as possible, and included a few + effects based on the mathematical model of the ionospheric propagation. + Also, some of the calling stations exhibit less then perfect operating + skills, again to make the simulation more realistic. These effects can + be turned on and off using the checkboxes described below. + + + QRM - interference form other running stations occurs from time to time. + + QRN - electrostatic interference. + + QSB - signal strength varies with time (Rayleigh fading channel). + + Flutter - some stations have "auroral" sound. + + LIDS - some stations call you when you are working another station, + make mistakes when they send code, copy your messages incorrectly, + and send RST other than 599. + + Activity - band activity, determines how many stations on average + reply to your CQ. + + + + Audio buffer size + + You can adjust the audio buffer size by changing the BufSize value in the + MorseRunner.ini file. Acceptable values are 1 through 5, the default is 3. + Increase the buffer size for smooth audio without clicks and interruptions; + decrease the size for faster response to keyboard commands. + + + Competition duration + + The default duration of a competition session is 60 minutes. You can set it + to a smaller value by changing the CompetitionDuration entry in the + MorseRunner.ini file, e.g.: + + [Contest] + CompetitionDuration=15 + + + Calls From Keyer + + If you have an electronic keyer that simulates a keyboard - that is, sends + all transmitted characters to the PC as if they were entered from a keyboard, + you can add the following to the INI file: + + [Station] + CallsFromKeyer=1 + + With this option enabled, the callsign entered into the CALL field is not + transmitted by the computer when the corresponding key is pressed. This option + has no effect in the WPX and HST competition modes. + + + + +STARTING A CONTEST + +The contest can be started in one of four modes. + + Pile-Up mode: a random number of stations calls you after you send a CQ. Good + for improving copying skills. + + Single Calls mode: a single station calls you as soon as you finish the + previous QSO. Good for improving typing skills. + + WPX Compteition mode: similar to the Pile-Up mode, but band conditions and contest + duration are fixed and cannot be changed. The keying speed and band activity + are still under your control; + + HST Competition mode: all settings conform to the IARU High Speed Telegraphy + competition rules. + + + +To start a contest, set the duration of the exercise in the Run for NN Minutes +box (only for Pile-Up and Single Calls modes), and click on the desired mode +in the Run button's menu. In the Pile-Up and Competition mode, hit F1 or Enter +to send a CQ. + + + + +KEY ASSIGNMENTS + + F1-F8 - sends one of the pre-defined messages. The buttons under the input + fields have the same functions as these keys, and the captions + of the buttons show what each key sends. + + "\" - equivalent to F1. + + Esc - stop sending. + + Alt-W, Ctrl-W, F11 - wipe the input fields. + + Alt-Enter, Shift-Enter, Ctrl-Enter - save QSO. + + + - auto-complete input, jump between the input fields. + + , Shift- - move to the next/previous field. + + ";", - equivalent to F5 + F2. + + "+", ".", ",", "[" - equivalent to F3 + Save. + + Enter - sends various messages, depending on the state of the QSO; + + Up/Down arrows - RIT; + + Ctrl-Up/Ctrl-Down arrows - bandwidth; + + PgUp/PgDn, Ctrl-F10/Ctrl-F9, Alt-F10/Alt-F9 - keying speed, + in 5 WPM increments. + + + +WPX COMPETITION RULES + +The exchange consists of the RST and the serial number of the QSO. + +The score is a product of points (# of QSO) and multiplier (# of different +prefixes). + +The bottom right panel shows your current score, both Raw (calculated +from your log) and Verified (calculated after comparing your log to other +stations' logs). The histogram shows your raw QSO rate in 5-minute blocks. + +The log window marks incorrect entries in your log as follows: + + DUP - duplicate QSO. + + NIL - not in other station's log: you made a mistake in the callsign, or forgot + to send the corrected call to the station. + + RST - incorrect RST in your log. + + NR - incorrect exchange number in your log. + + + + + +SUBMITTING YOUR SCORE + +If you complete a full 60-minute session in the WPX Competition mode, Morse Runner +will generate a score string that you can post to the Score Board on the web: +. Copy and paste your score +string into the box on the web page and click on the Submit button. + +You can view your previous score strings using the File -> View Score menu +command. + + + + + + +VERSION HISTORY + + +1.68 + - TU + MyCall after the QSO is now equivalent to CQ + + + +1.67 + - small changes in the HST competition mode. + + + +1.65, 1.66 + - a few small bugs fixed. + + + +1.61 - 1.64 + - small changes in the HST competition mode. + + + +1.6 + - HST competition mode added; + - CallsFromKeyer option added. + + + +1.52 + - the CompetitionDuration setting added. + + + +1.51 + - minor bugs fixed. + + + +1.5 + - more realistic behavior of calling stations; + - self-monitoring volume control; + - more creative LIDS; + - CW speed hotkeys; + - WAV recording; + - menu commands for all settings (for blind hams). + + + +1.4 + - RIT function; + - callsign completion/correction when sending; + - faster response to keyboard commands; + - bandwidth adjustment in 50 Hz steps; + - the middle digit is selected when the cursor enters the RST field; + - the QSO rate is now expressed in Q/hr; + - the problem with the Finnish character set fixed. + + +1.3 + + - some key assignments corrected for compatibility with popular contesting + programs; + - statistical models refined for more realistic simulation; + - rate display added; + - a few bugs fixed. + + +1.2 (first public release) + + - Competetion mode added; + - some bugs fixed. + + +1.1 + - ESM (Enter Sends Messages) mode added; + - a lot of bugs fixed. + + + + + +DISCLAIMER OF WARRANTY + +THE SOFTWARE PRODUCT IS PROVIDED AS IS WITHOUT WARRANTY OF ANY KIND. TO THE +MAXIMUM EXTENT PERMITTED BY APPLICABLE LAW, THE AUTHOR FURTHER +DISCLAIMS ALL WARRANTIES, INCLUDING WITHOUT LIMITATION ANY IMPLIED WARRANTIES +OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, AND NONINFRINGEMENT. +THE ENTIRE RISK ARISING OUT OF THE USE OR PERFORMANCE OF THE SOFTWARE PRODUCT +AND DOCUMENTATION REMAINS WITH RECIPIENT. TO THE MAXIMUM EXTENT PERMITTED BY +APPLICABLE LAW, IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY +CONSEQUENTIAL, INCIDENTAL, DIRECT, INDIRECT, SPECIAL, PUNITIVE, OR OTHER DAMAGES +WHATSOEVER (INCLUDING, WITHOUT LIMITATION, DAMAGES FOR LOSS OF PROFITS, +BUSINESS INTERRUPTION, LOSS OF INFORMATION, OR OTHER PECUNIARY LOSS) ARISING +OUT OF THIS AGREEMENT OR THE USE OF OR INABILITY TO USE THE SOFTWARE PRODUCT, +EVEN IF THE AUTHOR HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH +DAMAGES. + + + + + +END OF DOCUMENT \ No newline at end of file diff --git a/RndFunc.pas b/RndFunc.pas new file mode 100644 index 0000000..d0287a1 --- /dev/null +++ b/RndFunc.pas @@ -0,0 +1,142 @@ +//------------------------------------------------------------------------------ +//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 RndFunc; + +interface + +uses + SysUtils, Math, SndTypes, Ini; + +function RndNormal: Single; +function RndGaussLim(AMean, ALim: Single): Single; +function RndRayleigh(AMean: Single): Single; +function BlocksToSeconds(Blocks: Single): Single; +function SecondsToBlocks(Sec: Single): integer; +function RndUniform: Single; +function RndUShaped: Single; +function RndPoisson(AMean: Single): integer; + + +implementation + +function RndNormal: Single; +begin + repeat + try + Result := Sqrt(-2 * Ln(Random)) * Cos(TWO_PI * Random); + Exit; + except + end; + until + False; +end; + + +function RndGaussLim(AMean, ALim: Single): Single; +begin + Result := AMean + RndNormal * 0.5 * ALim; + Result := Max(AMean-ALim, Min(AMean+ALim, Result)); +end; + + +function RndRayleigh(AMean: Single): Single; +begin + Result := AMean * Sqrt(-Ln(Random) - Ln(Random)); +end; + + +function SecondsToBlocks(Sec: Single): integer; +begin + Result := Round(11025 / Ini.BufSize * Sec); +end; + +function BlocksToSeconds(Blocks: Single): Single; +begin + Result := Blocks * Ini.BufSize / 11025; +end; + +function RndUniform: Single; +begin + Result := 2*Random - 1; +end; + + +function RndUShaped: Single; +begin + Result := Sin(Pi*(Random-0.5)); +end; + + +//http://www.library.cornell.edu/nr/bookcpdf/c7-3.pdf +function RndPoisson(AMean: Single): integer; +var + g, t: Single; +begin + g := Exp(-AMean); + t := 1; + for Result:=0 to 30 do + begin + t := t * Random; + if t <= g then Break; + end; +end; + +{ +//http://www.esbconsult.com.au/ +function RndPoisson(AMean: Single): integer; +var + p,q,p0,u: Extended; + l,m,j,k: integer; + pp: array [1..35] of Extended; +begin + // C A S E B. mu < 10 + // START NEW TABLE AND CALCULATE P0 IF NECESSARY + + m := Max(1, Trunc (AMean)); + l := 0; + p := Exp(-AMean); + q := p; + p0 := p; + + // STEP U. UNIFORM SAMPLE FOR INVERSION METHOD + + repeat + u := Random; + Result := 0; + if (u <= p0) then Exit; + + // STEP T. TABLE COMPARISON UNTIL THE END PP(L) OF THE + // PP-TABLE OF CUMULATIVE POISSON PROBABILITIES + // (0.458=PP(9) FOR MU=10) + if l <> 0 then + begin + j := 1; + if (u > 0.458) then j := Min(l, m); + for k := j to l do + if (u <= pp [k]) then + begin Result := K; Exit; end; + + if l = 35 then Continue; + end; + + // STEP C. CREATION OF NEW POISSON PROBABILITIES P + // AND THEIR CUMULATIVES Q=PP(K) + l := l + 1; // 150 + for k := l to 35 do + begin + p := p * AMean / k; + q := q + p; + pp [k] := q; + if (u <= q) then begin Result := K; Exit; end; + end; + l := 35; + until False; +end; +} + + +end. + diff --git a/ScoreDlg.dfm b/ScoreDlg.dfm new file mode 100644 index 0000000..eadd2f9 --- /dev/null +++ b/ScoreDlg.dfm @@ -0,0 +1,94 @@ +object ScoreDialog: TScoreDialog + Left = 212 + Top = 107 + BorderStyle = bsDialog + Caption = 'The contest is over' + ClientHeight = 102 + ClientWidth = 394 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'MS Sans Serif' + Font.Style = [] + OldCreateOrder = False + Position = poMainFormCenter + PixelsPerInch = 96 + TextHeight = 13 + object Label1: TLabel + Left = 14 + Top = 8 + Width = 92 + Height = 13 + Anchors = [akLeft, akBottom] + Caption = 'Your score string is:' + end + object Label2: TLabel + Left = 29 + Top = -35 + Width = 336 + Height = 24 + Anchors = [akLeft, akBottom] + Caption = 'Congratulations on a new record!' + Font.Charset = ANSI_CHARSET + Font.Color = clAqua + Font.Height = -21 + Font.Name = 'Arial' + Font.Style = [fsBold] + ParentFont = False + Transparent = True + end + object Label3: TLabel + Left = 28 + Top = -37 + Width = 336 + Height = 24 + Anchors = [akLeft, akBottom] + Caption = 'Congratulations on a new record!' + Font.Charset = ANSI_CHARSET + Font.Color = clGreen + Font.Height = -21 + Font.Name = 'Arial' + Font.Style = [fsBold] + ParentFont = False + Transparent = True + end + object Edit1: TEdit + Left = 14 + Top = 28 + Width = 365 + Height = 23 + Anchors = [akLeft, akBottom] + AutoSelect = False + Font.Charset = ANSI_CHARSET + Font.Color = clWindowText + Font.Height = -12 + Font.Name = 'Courier New' + Font.Style = [] + ParentFont = False + ReadOnly = True + TabOrder = 0 + end + object Button1: TButton + Left = 172 + Top = 64 + Width = 113 + Height = 25 + Anchors = [akLeft, akBottom] + Caption = 'Hi-Score web page' + Default = True + TabOrder = 1 + OnClick = Button1Click + end + object Button2: TButton + Left = 292 + Top = 64 + Width = 75 + Height = 25 + Anchors = [akLeft, akBottom] + Caption = 'Close' + ModalResult = 2 + TabOrder = 2 + OnClick = Button2Click + end +end diff --git a/ScoreDlg.pas b/ScoreDlg.pas new file mode 100644 index 0000000..e316b97 --- /dev/null +++ b/ScoreDlg.pas @@ -0,0 +1,46 @@ +//------------------------------------------------------------------------------ +//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 ScoreDlg; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls; + +type + TScoreDialog = class(TForm) + Label1: TLabel; + Edit1: TEdit; + Button1: TButton; + Button2: TButton; + Label2: TLabel; + Label3: TLabel; + procedure Button1Click(Sender: TObject); + procedure Button2Click(Sender: TObject); + end; + +var + ScoreDialog: TScoreDialog; + +implementation + +uses Main; + +{$R *.DFM} + +procedure TScoreDialog.Button1Click(Sender: TObject); +begin + MainForm.ViewScoreBoardMNU.Click; +end; + +procedure TScoreDialog.Button2Click(Sender: TObject); +begin + Close; +end; + +end. + diff --git a/Station.pas b/Station.pas new file mode 100644 index 0000000..4914212 --- /dev/null +++ b/Station.pas @@ -0,0 +1,236 @@ +//------------------------------------------------------------------------------ +//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 Station; + +interface + +uses + SysUtils, Classes, Math, SndTypes, Ini, MorseKey; + +const + NEVER = MAXINT; + +type + TStationMessage = (msgNone, msgCQ, msgNR, msgTU, msgMyCall, msgHisCall, + msgB4, msgQm, msgNil, msgGarbage, msgR_NR, msgR_NR2, msgDeMyCall1, msgDeMyCall2, + msgDeMyCallNr1, msgDeMyCallNr2, msgNrQm, msgLongCQ, msgMyCallNr2, + msgQrl, msgQrl2, msqQsy, msgAgn); + + TStationMessages = set of TStationMessage; + TStationState = (stListening, stCopying, stPreparingToSend, stSending); + TStationEvent = (evTimeout, evMsgSent, evMeStarted, evMeFinished); + + + TStation = class (TCollectionItem) + private + FBfo: Single; + dPhi: Single; + FPitch: integer; + function GetBfo: Single; + procedure SetPitch(const Value: integer); + protected + SendPos: integer; + TimeOut: integer; + NrWithError: boolean; + function NrAsText: string; + public + Amplitude: Single; + Wpm: integer; + Envelope: TSingleArray; + State: TStationState; + + NR: string; + RST: integer; + MyCall, HisCall: string; + + Msg: TStationMessages; + MsgText: string; + + constructor CreateStation; + + procedure Tick; + function GetBlock: TSingleArray; virtual; + procedure ProcessEvent(AEvent: TStationEvent); virtual; abstract; + + procedure SendMsg(AMsg: TStationMessage); + procedure SendText(AMsg: string); virtual; + procedure SendMorse(AMorse: string); + + property Pitch: integer read FPitch write SetPitch; + property Bfo: Single read GetBfo; + end; + +implementation + +{ TStation } + +constructor TStation.CreateStation; +begin + inherited Create(nil); +end; + +function TStation.GetBfo: Single; +begin + Result := FBfo; + FBfo := FBfo + dPhi; + if FBfo > TWO_PI then FBfo := FBfo - TWO_PI; +end; + + +function TStation.GetBlock: TSingleArray; +begin + Result := Copy(Envelope, SendPos, Ini.BufSize); + + //advance TX buffer + Inc(SendPos, Ini.BufSize); + if SendPos = Length(Envelope) then Envelope := nil; +end; + + +procedure TStation.SendMsg(AMsg: TStationMessage); +begin + if Envelope = nil then Msg := []; + if AMsg = msgNone then begin State := stListening; Exit; End; + Include(Msg, AMsg); + + case AMsg of + msgCQ: SendText('CQ TEST'); + msgNR: SendText('<#>'); + msgTU: SendText('TU'); + msgMyCall: SendText(''); + msgHisCall: SendText(''); + msgB4: SendText('QSO B4'); + msgQm: SendText('?'); + msgNil: SendText('NIL'); + msgR_NR: SendText('R <#>'); + msgR_NR2: SendText('R <#> <#>'); + msgDeMyCall1: SendText('DE '); + msgDeMyCall2: SendText('DE '); + msgDeMyCallNr1: SendText('DE <#>'); + msgDeMyCallNr2: SendText('DE <#>'); + msgMyCallNr2: SendText(' <#>'); + msgNrQm: SendText('NR?'); + msgLongCQ: SendText('CQ CQ TEST TEST'); + msgQrl: SendText('QRL?'); + msgQrl2: SendText('QRL? QRL?'); + msqQsy: SendText(' QSY QSY'); + msgAgn: SendText('AGN'); + end; +end; + +procedure TStation.SendText(AMsg: string); +begin + if Pos('<#>', AMsg) > 0 then + begin + //with error + AMsg := StringReplace(AMsg, '<#>', NrAsText, []); + //error cleared + AMsg := StringReplace(AMsg, '<#>', NrAsText, [rfReplaceAll]); + end; + + AMsg := StringReplace(AMsg, '', MyCall, [rfReplaceAll]); + +{ + if CallsFromKeyer + then AMsg := StringReplace(AMsg, '', ' ', [rfReplaceAll]) + else AMsg := StringReplace(AMsg, '', HisCall, [rfReplaceAll]); +} + + if MsgText <> '' + then MsgText := MsgText + ' ' + AMsg + else MsgText := AMsg; + SendMorse(Keyer.Encode(MsgText)); +end; + + +procedure TStation.SendMorse(AMorse: string); +var + i: integer; +begin + if Envelope = nil then + begin + SendPos := 0; + FBfo := 0; + end; + + Keyer.Wpm := Wpm; + Keyer.MorseMsg := AMorse; + Envelope := Keyer.Envelope; + for i:=0 to High(Envelope) do Envelope[i] := Envelope[i] * Amplitude; + + State := stSending; + TimeOut := NEVER; +end; + + + +procedure TStation.SetPitch(const Value: integer); +begin + FPitch := 11025; + dPhi := TWO_PI * FPitch / DEFAULTRATE; +end; + + +procedure TStation.Tick; +begin + //just finished sending + if (State = stSending) and (Envelope = nil) then + begin + MsgText := ''; + State := stListening; + ProcessEvent(evMsgSent); + end + + //check timeout + else if State <> stSending then + begin + if TimeOut > -1 then Dec(TimeOut); + if TimeOut = 0 then ProcessEvent(evTimeout); + end; +end; + + + +function TStation.NrAsText: string; +var + Idx: integer; +begin + Result := Format('%d%.3d', [RST, NR]); + + if NrWithError then + begin + Idx := Length(Result); + if not (Result[Idx] in ['2'..'7']) then Dec(Idx); + if Result[Idx] in ['2'..'7'] then + begin + if Random < 0.5 then Dec(Result[Idx]) else Inc(Result[Idx]); + Result := Result + Format('EEEEE %.3d', [NR]); + end; + NrWithError := false; + end; + + Result := StringReplace(Result, '599', '5NN', [rfReplaceAll]); + + if Ini.RunMode <> rmHst then + begin + Result := StringReplace(Result, '000', 'TTT', [rfReplaceAll]); + Result := StringReplace(Result, '00', 'TT', [rfReplaceAll]); + + if Random < 0.4 + then Result := StringReplace(Result, '0', 'O', [rfReplaceAll]) + else if Random < 0.97 + then Result := StringReplace(Result, '0', 'T', [rfReplaceAll]); + + if Random < 0.97 + then Result := StringReplace(Result, '9', 'N', [rfReplaceAll]); + end; +end; + + + + +end. + diff --git a/StnColl.pas b/StnColl.pas new file mode 100644 index 0000000..b49625b --- /dev/null +++ b/StnColl.pas @@ -0,0 +1,69 @@ +//------------------------------------------------------------------------------ +//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 StnColl; + +interface + +uses + SysUtils, Classes, Station, DxStn, QrnStn, QrmStn; + +type + TStations = class(TCollection) + private + function GetItem(Index: Integer): TStation; + public + constructor Create; + //destructor Destroy; override; + function AddCaller: TStation; + function AddQrn: TStation; + function AddQrm: TStation; + property Items[Index: Integer]: TStation read GetItem; default; + end; + +implementation + +{ TCallerCollection } + + +{ TStations } + +constructor TStations.Create; +begin + inherited Create(TStation); +end; + + +function TStations.GetItem(Index: Integer): TStation; +begin + Result := (inherited GetItem(Index)) as TStation; +end; + + +function TStations.AddCaller: TStation; +begin + Result := TDxStation.CreateStation; + Result.Collection := Self; +end; + + +function TStations.AddQrn: TStation; +begin + Result := TQrnStation.CreateStation; + Result.Collection := Self; +end; + + +function TStations.AddQrm: TStation; +begin + Result := TQrmStation.CreateStation; + Result.Collection := Self; +end; + + + + +end. + diff --git a/VCL/BaseComp.pas b/VCL/BaseComp.pas new file mode 100644 index 0000000..afa62e2 --- /dev/null +++ b/VCL/BaseComp.pas @@ -0,0 +1,106 @@ +//------------------------------------------------------------------------------ +//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 BaseComp; + +interface + +uses + Windows, Messages, SysUtils, Classes, Controls, Forms; + +type + {this component adds a window handle to the standard TControl + in order to receive windows messages and makes sure that + DoSetEnabled is called only at run time} + + TBaseComponent = class (TComponent) + private + FHandle: THandle; + FEnabled : boolean; + procedure SetEnabled(AEnabled: boolean); + procedure WndProc(var Message: TMessage); + procedure WMQueryEndSession(var Message: TMessage); message WM_QUERYENDSESSION; + protected + procedure DoSetEnabled(AEnabled: boolean); virtual; + procedure Loaded; override; + property Handle: THandle read FHandle; + public + property Enabled: boolean read FEnabled write SetEnabled default false; + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + end; + + +implementation + + { TBaseComponent } + +constructor TBaseComponent.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FHandle := 0; + FEnabled := false; +end; + + +destructor TBaseComponent.Destroy; +begin + Enabled := false; + inherited Destroy; +end; + + +procedure TBaseComponent.Loaded; +begin + inherited Loaded; + + if FEnabled then + begin + FEnabled := false; + SetEnabled(true); + end; +end; + + +procedure TBaseComponent.WndProc(var Message: TMessage); +begin + try + Dispatch(Message); + except + Application.HandleException(Self); + end; +end; + +procedure TBaseComponent.WMQueryEndSession(var Message: TMessage); +begin + try Enabled := false; except; end; + inherited; + Message.Result := integer(true); +end; + +procedure TBaseComponent.SetEnabled (AEnabled: boolean); +begin + if (not (csDesigning in ComponentState)) and + (not (csLoading in ComponentState)) and + (AEnabled <> FEnabled) + then DoSetEnabled(AEnabled); + FEnabled := AEnabled; +end; + + +procedure TBaseComponent.DoSetEnabled (AEnabled: boolean); +begin + if AEnabled + then + FHandle := AllocateHwnd(WndProc) + else + begin + if FHandle <> 0 then DeallocateHwnd(FHandle); + FHandle := 0; + end; +end; + + +end. diff --git a/VCL/Crc32.pas b/VCL/Crc32.pas new file mode 100644 index 0000000..f240c46 --- /dev/null +++ b/VCL/Crc32.pas @@ -0,0 +1,70 @@ +//------------------------------------------------------------------------------ +//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 Crc32; + +interface + +uses SysUtils, Windows; + +function CalculateCRC32(AStr: string; ACrc: DWord): DWord; + + +implementation + +const + Crc32Table: array[0..255] of DWord = ( + $00000000, $77073096, $EE0E612C, $990951BA, $076DC419, $706AF48F, $E963A535, $9E6495A3, + $0EDB8832, $79DCB8A4, $E0D5E91E, $97D2D988, $09B64C2B, $7EB17CBD, $E7B82D07, $90BF1D91, + $1DB71064, $6AB020F2, $F3B97148, $84BE41DE, $1ADAD47D, $6DDDE4EB, $F4D4B551, $83D385C7, + $136C9856, $646BA8C0, $FD62F97A, $8A65C9EC, $14015C4F, $63066CD9, $FA0F3D63, $8D080DF5, + $3B6E20C8, $4C69105E, $D56041E4, $A2677172, $3C03E4D1, $4B04D447, $D20D85FD, $A50AB56B, + $35B5A8FA, $42B2986C, $DBBBC9D6, $ACBCF940, $32D86CE3, $45DF5C75, $DCD60DCF, $ABD13D59, + $26D930AC, $51DE003A, $C8D75180, $BFD06116, $21B4F4B5, $56B3C423, $CFBA9599, $B8BDA50F, + $2802B89E, $5F058808, $C60CD9B2, $B10BE924, $2F6F7C87, $58684C11, $C1611DAB, $B6662D3D, + + $76DC4190, $01DB7106, $98D220BC, $EFD5102A, $71B18589, $06B6B51F, $9FBFE4A5, $E8B8D433, + $7807C9A2, $0F00F934, $9609A88E, $E10E9818, $7F6A0DBB, $086D3D2D, $91646C97, $E6635C01, + $6B6B51F4, $1C6C6162, $856530D8, $F262004E, $6C0695ED, $1B01A57B, $8208F4C1, $F50FC457, + $65B0D9C6, $12B7E950, $8BBEB8EA, $FCB9887C, $62DD1DDF, $15DA2D49, $8CD37CF3, $FBD44C65, + $4DB26158, $3AB551CE, $A3BC0074, $D4BB30E2, $4ADFA541, $3DD895D7, $A4D1C46D, $D3D6F4FB, + $4369E96A, $346ED9FC, $AD678846, $DA60B8D0, $44042D73, $33031DE5, $AA0A4C5F, $DD0D7CC9, + $5005713C, $270241AA, $BE0B1010, $C90C2086, $5768B525, $206F85B3, $B966D409, $CE61E49F, + $5EDEF90E, $29D9C998, $B0D09822, $C7D7A8B4, $59B33D17, $2EB40D81, $B7BD5C3B, $C0BA6CAD, + + $EDB88320, $9ABFB3B6, $03B6E20C, $74B1D29A, $EAD54739, $9DD277AF, $04DB2615, $73DC1683, + $E3630B12, $94643B84, $0D6D6A3E, $7A6A5AA8, $E40ECF0B, $9309FF9D, $0A00AE27, $7D079EB1, + $F00F9344, $8708A3D2, $1E01F268, $6906C2FE, $F762575D, $806567CB, $196C3671, $6E6B06E7, + $FED41B76, $89D32BE0, $10DA7A5A, $67DD4ACC, $F9B9DF6F, $8EBEEFF9, $17B7BE43, $60B08ED5, + $D6D6A3E8, $A1D1937E, $38D8C2C4, $4FDFF252, $D1BB67F1, $A6BC5767, $3FB506DD, $48B2364B, + $D80D2BDA, $AF0A1B4C, $36034AF6, $41047A60, $DF60EFC3, $A867DF55, $316E8EEF, $4669BE79, + $CB61B38C, $BC66831A, $256FD2A0, $5268E236, $CC0C7795, $BB0B4703, $220216B9, $5505262F, + $C5BA3BBE, $B2BD0B28, $2BB45A92, $5CB36A04, $C2D7FFA7, $B5D0CF31, $2CD99E8B, $5BDEAE1D, + + $9B64C2B0, $EC63F226, $756AA39C, $026D930A, $9C0906A9, $EB0E363F, $72076785, $05005713, + $95BF4A82, $E2B87A14, $7BB12BAE, $0CB61B38, $92D28E9B, $E5D5BE0D, $7CDCEFB7, $0BDBDF21, + $86D3D2D4, $F1D4E242, $68DDB3F8, $1FDA836E, $81BE16CD, $F6B9265B, $6FB077E1, $18B74777, + $88085AE6, $FF0F6A70, $66063BCA, $11010B5C, $8F659EFF, $F862AE69, $616BFFD3, $166CCF45, + $A00AE278, $D70DD2EE, $4E048354, $3903B3C2, $A7672661, $D06016F7, $4969474D, $3E6E77DB, + $AED16A4A, $D9D65ADC, $40DF0B66, $37D83BF0, $A9BCAE53, $DEBB9EC5, $47B2CF7F, $30B5FFE9, + $BDBDF21C, $CABAC28A, $53B39330, $24B4A3A6, $BAD03605, $CDD70693, $54DE5729, $23D967BF, + $B3667A2E, $C4614AB8, $5D681B02, $2A6F2B94, $B40BBE37, $C30C8EA1, $5A05DF1B, $2D02EF8D + ); + + +function CalculateCRC32(AStr: string; ACrc: DWord): DWord; +var + i: integer; +begin + Result := ACrc; + if AStr = '' then Exit; + + for i:=1 to Length(AStr) do + Result := (Result shr 8) xor Crc32Table[Ord(AStr[i]) xor (Result and $FF)]; +end; + + +end. + diff --git a/VCL/Mixers.pas b/VCL/Mixers.pas new file mode 100644 index 0000000..abd5b1a --- /dev/null +++ b/VCL/Mixers.pas @@ -0,0 +1,383 @@ +//------------------------------------------------------------------------------ +//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 Mixers; + +interface + +uses + SysUtils, Classes, SndTypes, Math; + +type + TDownMixer = class + private + Phase: Double; + TwoPiDt: Single; + FSamplesPerSec: integer; + procedure SetSamplesPerSec(const Value: integer); + public + Freq: Single; + + constructor Create; + procedure Reset; + function Mix(Data: TSingleArray): TComplexArray; overload; + function Mix(DataRe, DataIm: TSingleArray): TReImArrays; overload; + function Mix(Data: TComplexArray): TComplexArray; overload; + + property SamplesPerSec: integer read FSamplesPerSec write SetSamplesPerSec; + end; + + + + TFastDownMixer = class + private + CurrT, HighT: integer; + Osc: TComplexArray; + FFrequency: Double; + public + constructor Create; + procedure SetParams(ASamplingRate, AFrequency: Double; ATableSize: integer = 0); + procedure Reset; + + function Mix(Data: TSingleArray): TComplexArray; overload; + function Mix(DataRe, DataIm: TSingleArray): TReImArrays; overload; + function Mix(Data: TComplexArray): TComplexArray; overload; + + property Frequency: Double read FFrequency; + end; + + + TModulator = class + private + FSamplesPerSec: integer; + FCarrierFreq: Single; + FSampleNo: integer; + Sn, Cs: TSingleArray; + FGain: Single; + procedure SetSamplesPerSec(const Value: integer); + procedure SetCarrierFreq(const Value: Single); + procedure CalcSinCos; + procedure SetGain(const Value: Single); + public + constructor Create; + function Modulate(Data: TSingleArray): TSingleArray; overload; + function Modulate(Data: TReImArrays): TSingleArray; overload; + function Modulate(Data: TComplexArray): TSingleArray; overload; + property SamplesPerSec: integer read FSamplesPerSec write SetSamplesPerSec; + property CarrierFreq: Single read FCarrierFreq write SetCarrierFreq; + property Gain: Single read FGain write SetGain; + end; + + + +implementation + + +//------------------------------------------------------------------------------ +// TDownMixer +//------------------------------------------------------------------------------ + +{ TDownMixer } + +constructor TDownMixer.Create; +begin + SamplesPerSec := 5512; +end; + + +function TDownMixer.Mix(Data: TSingleArray): TComplexArray; +var + i: integer; +begin + Integer(Result) := 0; + SetLength(Result, Length(Data)); + if Phase > TWO_PI then Phase := Phase - TWO_PI * Trunc(Phase/TWO_PI); + + for i:=0 to High(Data) do + begin + Result[i].Re := Data[i] * Cos(Phase); + Result[i].Im := - Data[i] * Sin(Phase); + + Phase := Phase + Freq * TwoPiDt; + end; +end; + + +function TDownMixer.Mix(Data: TComplexArray): TComplexArray; +var + i: integer; + Sn, Cs, rr, ii: Single; +begin + Integer(Result) := 0; + SetLength(Result, Length(Data)); + if Phase > TWO_PI then Phase := Phase - TWO_PI*Trunc(Phase/TWO_PI); + + //mix with exp(-j*2Pi*Freq[i]), minus shifts spectrum down + for i:=0 to High(Data) do + begin + Sn := Sin(Phase); + Cs := Cos(Phase); + rr := Data[i].Re; + ii := Data[i].Im; + + Result[i].Re := rr * Cs - ii * Sn; + Result[i].Im := ii * Cs + rr * Sn; + + Phase := Phase + Freq * TwoPiDt; + end; +end; + + +function TDownMixer.Mix(DataRe, DataIm: TSingleArray): TReImArrays; +var + i: integer; + Sn, Cs, rr, ii: Single; +begin + SetLengthReIm(Result, Length(DataRe)); + if Phase > TWO_PI then Phase := Phase - TWO_PI*Trunc(Phase/TWO_PI); + + for i:=0 to High(DataRe) do + begin + Sn := Sin(Phase); + Cs := Cos(Phase); + rr := DataRe[i]; + ii := DataIm[i]; + + Result.Re[i] := rr * Cs - ii * Sn; + Result.Im[i] := ii * Cs + rr * Sn; + + Phase := Phase + Freq * TwoPiDt; + end; +end; + + +procedure TDownMixer.Reset; +begin + Phase := 0; +end; + + +procedure TDownMixer.SetSamplesPerSec(const Value: integer); +begin + FSamplesPerSec := Value; + TwoPiDt := 2* Pi / FSamplesPerSec; +end; + + + + +//------------------------------------------------------------------------------ +// TModulator +//------------------------------------------------------------------------------ + +{ TModulator } + +constructor TModulator.Create; +begin + FCarrierFreq := 600; + FSamplesPerSec := 5512; + FGain := 1; + CalcSinCos; + FSampleNo := 0; +end; + + +procedure TModulator.SetCarrierFreq(const Value: Single); +begin + FCarrierFreq := Value; + CalcSinCos; + FSampleNo := 0; +end; + + +procedure TModulator.SetGain(const Value: Single); +begin + CalcSinCos; + FGain := Value; +end; + +procedure TModulator.SetSamplesPerSec(const Value: integer); +begin + FSamplesPerSec := Value; + CalcSinCos; + FSampleNo := 0; +end; + + +procedure TModulator.CalcSinCos; +var + Cnt: integer; + dFi: Single; + i: integer; +begin + Cnt := Round(FSamplesPerSec / FCarrierFreq); + FCarrierFreq := FSamplesPerSec / Cnt; + dFi := TWO_PI / Cnt; + + SetLength(Sn, Cnt); + SetLength(Cs, Cnt); + + Sn[0] := 0; Sn[1] := Sin(dFi); + Cs[0] := 1; Cs[1] := Cos(dFi); + + //phase + for i:=2 to Cnt-1 do + begin + Cs[i] := Cs[1] * Cs[i-1] - Sn[1] * Sn[i-1]; + Sn[i] := Cs[1] * Sn[i-1] + Sn[1] * Cs[i-1]; + end; + + //gain + for i:=0 to Cnt-1 do + begin + Cs[i] := Cs[i] * FGain; + Sn[i] := Cs[i] * FGain; + end; +end; + + +function TModulator.Modulate(Data: TReImArrays): TSingleArray; +var + i: integer; +begin + Integer(Result) := 0; + SetLength(Result, Length(Data.Re)); + for i:=0 to High(Result) do + begin + Result[i] := Data.Re[i] * Sn[FSampleNo] - Data.Im[i] * Cs[FSampleNo]; + FSampleNo := (FSampleNo+1) mod Length(Cs); + end; +end; + + +function TModulator.Modulate(Data: TSingleArray): TSingleArray; +var + i: integer; +begin + Integer(Result) := 0; + SetLength(Result, Length(Data)); + for i:=0 to High(Result) do + begin + Result[i] := Data[i] * Cs[FSampleNo]; + FSampleNo := (FSampleNo+1) mod Length(Cs); + end; +end; + + +function TModulator.Modulate(Data: TComplexArray): TSingleArray; +var + i: integer; +begin + Integer(Result) := 0; + SetLength(Result, Length(Data)); + for i:=0 to High(Result) do + begin + Result[i] := Data[i].Re * Sn[FSampleNo] - Data[i].Im * Cs[FSampleNo]; + FSampleNo := (FSampleNo+1) mod Length(Cs); + end; +end; + + + + + +{ TFastDownMixer } + +constructor TFastDownMixer.Create; +begin + SetParams(48000, 0, 2048); +end; + +function TFastDownMixer.Mix(Data: TComplexArray): TComplexArray; +var + i: integer; +begin + Integer(Result) := 0; + SetLength(Result, Length(Data)); + + for i:=0 to High(Data) do + begin + Result[i].Re := Data[i].Re * Osc[CurrT].Re - Data[i].Im * Osc[CurrT].Im; + Result[i].Im := Data[i].Im * Osc[CurrT].Re + Data[i].Re * Osc[CurrT].Im; + + Inc(CurrT); + if CurrT > HighT then CurrT := 0; + end; +end; + + +function TFastDownMixer.Mix(DataRe, DataIm: TSingleArray): TReImArrays; +var + i: integer; +begin + SetLengthReIm(Result, Length(DataRe)); + + for i:=0 to High(DataRe) do + begin + Result.Re[i] := DataRe[i] * Osc[CurrT].Re - DataIm[i] * Osc[CurrT].Im; + Result.Im[i] := DataIm[i] * Osc[CurrT].Re + DataRe[i] * Osc[CurrT].Im; + + Inc(CurrT); + if CurrT > HighT then CurrT := 0; + end; +end; + + +function TFastDownMixer.Mix(Data: TSingleArray): TComplexArray; +var + i: integer; +begin + Integer(Result) := 0; + SetLength(Result, Length(Data)); + + for i:=0 to High(Data) do + begin + Result[i].Re := Data[i] * Osc[CurrT].Re; + Result[i].Im := Data[i] * Osc[CurrT].Im; + + Inc(CurrT); + if CurrT > HighT then CurrT := 0; + end; +end; + + +procedure TFastDownMixer.Reset; +begin + CurrT := 0; +end; + + +procedure TFastDownMixer.SetParams(ASamplingRate, AFrequency: Double; ATableSize: integer = 0); +var + t, Periods: integer; + Omega: Single; +begin + FFrequency := AFrequency; + if ATableSize = 0 then ATableSize := Round(ASamplingRate); + + HighT := ATableSize-1; + + SetLength(Osc, ATableSize); + Periods := Round(ATableSize * (AFrequency / ASamplingRate)); + Omega := 2*Pi * Periods / ATableSize; + + for t:=0 to High(Osc) do + begin + Osc[t].Re := Cos(Omega * t); + Osc[t].Im := -Sin(Omega * t); + end; + + Reset; + +{ + if Omega <> 0 + then CurrT := Round(CurrPhi / Omega) + else CurrT := 0; +} +end; + + +end. + diff --git a/VCL/MorseKey.pas b/VCL/MorseKey.pas new file mode 100644 index 0000000..80b5ef3 --- /dev/null +++ b/VCL/MorseKey.pas @@ -0,0 +1,208 @@ +//------------------------------------------------------------------------------ +//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 MorseKey; + +interface + +uses + SysUtils, Classes, SndTypes, MorseTbl, Math, Ini; + + +type + TKeyer = class + private + Morse: array[Char] of string; + RampLen: integer; + RampOn, RampOff: TSingleArray; + FRiseTime: Single; + + function GetEnvelope: TSingleArray; + procedure LoadMorseTable; + procedure MakeRamp; + function BlackmanHarrisKernel(x: Single): Single; + function BlackmanHarrisStepResponse(Len: integer): TSingleArray; + procedure SetRiseTime(const Value: Single); + public + Wpm: integer; + BufSize: integer; + Rate: integer; + MorseMsg: string; + TrueEnvelopeLen: integer; + + constructor Create; + function Encode(Txt: string): string; + + property RiseTime: Single read FRiseTime write SetRiseTime; + property Envelope: TSingleArray read GetEnvelope; + end; + + +procedure MakeKeyer; +procedure DestroyKeyer; + +var + Keyer: TKeyer; + + +implementation + +procedure MakeKeyer; +begin + Keyer := TKeyer.Create; +end; + + +procedure DestroyKeyer; +begin + Keyer.Free; +end; + + + +{ TKeyer } + +constructor TKeyer.Create; +begin + LoadMorseTable; + Rate := 11025; + RiseTime := 0.005; +end; + + +procedure TKeyer.SetRiseTime(const Value: Single); +begin + FRiseTime := Value; + MakeRamp; +end; + + +procedure TKeyer.LoadMorseTable; +var + i: integer; + S: string; + Ch: Char; +begin + for i:=0 to High(MorseTable) do + begin + S := MorseTable[i]; + if S[2] <> '[' then Continue; + Ch := S[1]; + Morse[Ch] := Copy(S, 3, Pos(']', S)-3) + ' '; + end; +end; + + +function TKeyer.BlackmanHarrisKernel(x: Single): Single; +const + a0 = 0.35875; a1 = 0.48829; a2 = 0.14128; a3 = 0.01168; +begin + Result := a0 - a1*Cos(2*Pi*x) + a2*Cos(4*Pi*x) - a3*Cos(6*Pi*x); +end; + + +function TKeyer.BlackmanHarrisStepResponse(Len: integer): TSingleArray; +var + i: integer; + Scale: Single; +begin + SetLength(Result, Len); + //generate kernel + for i:=0 to High(Result) do Result[i] := BlackmanHarrisKernel(i/Len); + //integrate + for i:=1 to High(Result) do Result[i] := Result[i-1] + Result[i]; + //normalize + Scale := 1 / Result[High(Result)]; + for i:=0 to High(Result) do Result[i] := Result[i] * Scale; +end; + + +procedure TKeyer.MakeRamp; +var + i: integer; +begin + RampLen := Round(2.7 * FRiseTime * Rate); + RampOn := BlackmanHarrisStepResponse(RampLen); + + SetLength(RampOff, RampLen); + for i:=0 to RampLen-1 do RampOff[High(RampOff)-i] := RampOn[i]; +end; + + +function TKeyer.Encode(Txt: string): string; +var + i: integer; +begin + Result := ''; + for i:=1 to Length(Txt) do + if Txt[i] in [' ', '_'] + then Result := Result + ' ' + else Result := Result + Morse[Txt[i]]; + if Result <> '' then Result[Length(Result)] := '~'; +end; + + +function TKeyer.GetEnvelope: TSingleArray; +var + UnitCnt, Len, i, p: integer; + SamplesInUnit: integer; + + procedure AddRampOn; + begin + Move(RampOn[0], Result[p], RampLen * SizeOf(Single)); + Inc(p, Length(RampOn)); + end; + + procedure AddRampOff; + begin + Move(RampOff[0], Result[p], RampLen * SizeOf(Single)); + Inc(p, Length(RampOff)); + end; + + procedure AddOn(Dur: integer); + var + i: integer; + begin + for i:=0 to Dur * SamplesInUnit - RampLen - 1 do Result[p+i] := 1; + Inc(p, Dur * SamplesInUnit - RampLen); + end; + + procedure AddOff(Dur: integer); + begin + Inc(p, Dur * SamplesInUnit - RampLen); + end; + +begin + //count units + UnitCnt := 0; + for i:=1 to Length(MorseMsg) do + case MorseMsg[i] of + '.': Inc(UnitCnt, 2); + '-': Inc(UnitCnt, 4); + ' ': Inc(UnitCnt, 2); + '~': Inc(UnitCnt, 1); + end; + + //calc buffer size + SamplesInUnit := Round(0.1 * Rate * 12 / Wpm); + TrueEnvelopeLen := UnitCnt * SamplesInUnit + RampLen; + Len := BufSize * Ceil(TrueEnvelopeLen / BufSize); + Result := nil; + SetLength(Result, Len); + + //fill buffer + p := 0; + for i:=1 to Length(MorseMsg) do + case MorseMsg[i] of + '.': begin AddRampOn; AddOn(1); AddRampOff; AddOff(1); end; + '-': begin AddRampOn; AddOn(3); AddRampOff; AddOff(1); end; + ' ': AddOff(2); + '~': AddOff(1); + end; +end; + + +end. + diff --git a/VCL/MorseTbl.pas b/VCL/MorseTbl.pas new file mode 100644 index 0000000..6e51090 --- /dev/null +++ b/VCL/MorseTbl.pas @@ -0,0 +1,70 @@ +//------------------------------------------------------------------------------ +//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 + MorseTbl; + +interface + +const + //char[code]frequency + MorseTable: array[0..47] of string = ( + '1[.----]013', + '2[..---]014', + '3[...--]033', + '4[....-]043', + '5[.....]041', + '6[-....]008', + '7[--...]014', + '8[---..]010', + '9[----.]014', + //#$D8'[-----]011', + '0[-----]011', + + 'A[.-]127', + 'B[-...]062', + 'C[-.-.]069', + 'D[-..]084', + 'E[.]321', + 'F[..-.]055', + 'G[--.]043', + 'H[....]068', + 'I[..]130', + 'J[.---]008', + 'K[-.-]117', + 'L[.-..]100', + 'M[--]076', + 'N[-.]168', + 'O[---]126', + 'P[.--.]057', + 'Q[--.-]068', + 'R[.-.]095', + 'S[...]159', + 'T[-]236', + 'U[..-]061', + 'V[...-]023', + 'W[.--]095', + 'X[-..-]016', + 'Y[-.--]040', + 'Z[--..]012', + + '/[-..-.]019', + '.[.-.-.-]012', + ',[--..--]009', + '?[..--..]016', + '=[-...-]015', + //'=[-....-]0.1', + '\[...-.]0.01', //true=001 + + 'sk[...-.-]007', + 'ar[.-.-.]011', + 'kn[-.--.]001', + 'cq[-.-.--.-]001', + 'bk[-...-.-]002', + 'dx[-..-..-]001'); + +implementation + +end. diff --git a/VCL/MovAvg.pas b/VCL/MovAvg.pas new file mode 100644 index 0000000..23593aa --- /dev/null +++ b/VCL/MovAvg.pas @@ -0,0 +1,233 @@ +//------------------------------------------------------------------------------ +//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 MovAvg; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + SndTypes, Math; + +type + TMovingAverage = class(TComponent) + private + FPasses: integer; + FPoints: integer; + FSamplesInInput: integer; + + BufRe, BufIm: array of TSingleArray; + FNorm: Single; + FDecimateFactor: integer; + FGainDb: Single; + + procedure SetPasses(const Value: integer); + procedure SetPoints(const Value: integer); + procedure SetSamplesInInput(const Value: integer); + procedure SetDecimateFactor(const Value: integer); + procedure PushArray(const Src: TSingleArray; var Dst: TSingleArray); + procedure ShiftArray(var Dst: TSingleArray; Count: integer); + procedure Pass(const Src: TSingleArray; var Dst: TSingleArray); + function GetResult(const Src: TSingleArray): TSingleArray; + function DoFilter(AData: TSingleArray; + var ABuf: array of TSingleArray): TSingleArray; + procedure SetGainDb(const Value: Single); + procedure CalcScale; + public + constructor Create(AOwner: TComponent); override; + procedure Reset; + function Filter(AData: TSingleArray): TSingleArray; overload; + function Filter(AData: TReImArrays): TReImArrays; overload; + published + property Points: integer read FPoints write SetPoints; + property Passes: integer read FPasses write SetPasses; + property SamplesInInput: integer read FSamplesInInput write SetSamplesInInput; + property DecimateFactor: integer read FDecimateFactor write SetDecimateFactor; + property GainDb: Single read FGainDb write SetGainDb; + end; + +procedure Register; + + + + +implementation + +procedure Register; +begin + RegisterComponents('Snd', [TMovingAverage]); +end; + +{ TMovingAverage } + +//------------------------------------------------------------------------------ +// init +//------------------------------------------------------------------------------ +constructor TMovingAverage.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + + FPasses := 3; + FPoints := 129; + FSamplesInInput := 512; + FDecimateFactor := 1; + FGainDb := 0; + Reset; +end; + + +procedure TMovingAverage.Reset; +begin + //resize buffers and init them with 0's + BufRe := nil; + BufIm := nil; + //one buf for the input data and one for each pass + SetLength(BufRe, FPasses+1, FSamplesInInput + FPoints); + SetLength(BufIm, FPasses+1, FSamplesInInput + FPoints); + + //recalculate scaling factor + CalcScale; +end; + + +procedure TMovingAverage.CalcScale; +begin + //(gain, db to linear) * (averaging factor) + FNorm := Power(10, 0.05*FGainDb) * IntPower(FPoints, -FPasses); +end; + + + + + +//------------------------------------------------------------------------------ +// get/set +//------------------------------------------------------------------------------ +procedure TMovingAverage.SetPasses(const Value: integer); +begin + FPasses := Value; + Reset; +end; + +procedure TMovingAverage.SetPoints(const Value: integer); +begin + FPoints := Value; + Reset; +end; + +procedure TMovingAverage.SetSamplesInInput(const Value: integer); +begin + FSamplesInInput := Value; + Reset; +end; + + +procedure TMovingAverage.SetDecimateFactor(const Value: integer); +begin + FDecimateFactor := Value; + Reset; +end; + + +procedure TMovingAverage.SetGainDb(const Value: Single); +begin + FGainDb := Value; + CalcScale; +end; + + + + + +//------------------------------------------------------------------------------ +// filter +//------------------------------------------------------------------------------ +function TMovingAverage.Filter(AData: TSingleArray): TSingleArray; +begin + Result := DoFilter(AData, BufRe); +end; + + +function TMovingAverage.Filter(AData: TReImArrays): TReImArrays; +begin + Result.Re := DoFilter(AData.Re, BufRe); + Result.Im := DoFilter(AData.Im, BufIm); +end; + + +//called internally +function TMovingAverage.DoFilter(AData: TSingleArray; var ABuf: array of TSingleArray): TSingleArray; +var + i: integer; +begin + //put new data at the end of the 0-th buffer + PushArray(AData, ABuf[0]); + //multi-pass + for i:=1 to FPasses do Pass(ABuf[i-1], ABuf[i]); + //the sums are in the last buffer now, normalize and decimate result + Result := GetResult(ABuf[FPasses]); +end; + + + + + +//------------------------------------------------------------------------------ +// low level +//------------------------------------------------------------------------------ +procedure TMovingAverage.PushArray(const Src: TSingleArray; var Dst: TSingleArray); +var + Len: integer; +begin + //shift existing data to the left and append new data + Len := Length(Dst)-Length(Src); + Move(Dst[Length(Src)], Dst[0], Len * SizeOf(Single)); + Move(Src[0], Dst[Len], Length(Src) * SizeOf(Single)); +end; + + +procedure TMovingAverage.ShiftArray(var Dst: TSingleArray; Count: integer); +begin + //shift data to the left + Move(Dst[Count], Dst[0], (Length(Dst)-Count) * SizeOf(Single)); +end; + + +procedure TMovingAverage.Pass(const Src: TSingleArray; var Dst: TSingleArray); +var + i: integer; +begin + //make some free space in the buffer + ShiftArray(Dst, FSamplesInInput); + //calculate moving average recursively + for i:=FPoints to High(Src) do + Dst[i] := Dst[i-1] - Src[i-FPoints] + Src[i]; +end; + + +function TMovingAverage.GetResult(const Src: TSingleArray): TSingleArray; +var + i: integer; +begin + if FDecimateFactor = 1 //save a few cycles on Decimation + then + begin + SetLength(Result, FSamplesInInput); + for i:=0 to High(Result) do + Result[i] := Src[FPoints + i] * FNorm; + end + else + begin + SetLength(Result, FSamplesInInput div FDecimateFactor); + for i:=0 to High(Result) do + Result[i] := Src[FPoints + i * FDecimateFactor] * FNorm; + end; +end; + + + + +end. + diff --git a/VCL/PermHint.pas b/VCL/PermHint.pas new file mode 100644 index 0000000..e867a5e --- /dev/null +++ b/VCL/PermHint.pas @@ -0,0 +1,139 @@ +//------------------------------------------------------------------------------ +//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 PermHint; + +interface + +uses + Windows, SysUtils, Classes, Graphics, Controls, Forms; + +type + TPermanentHintWindow = class(THintWindow) + public + Active: boolean; + + constructor Create(AOwner: TComponent); override; + procedure ShowHint(Txt: string); + procedure ShowHintAt(Txt: string; x, y: integer); + procedure HideHint; + end; + +function GetCursorHeightMargin: Integer; + +implementation + +{ TPermanentHintWindow } + + +constructor TPermanentHintWindow.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + Color := clInfoBk; +end; + + +procedure TPermanentHintWindow.ShowHint(Txt: string); +var + P: TPoint; +begin + GetCursorPos(P); + ShowHintAt(Txt, P.x, P.y + GetCursorHeightMargin); +end; + + +procedure TPermanentHintWindow.HideHint; +begin + ReleaseHandle; + Application.ShowHint := true; + Active := false; +end; + + +procedure TPermanentHintWindow.ShowHintAt(Txt: string; x, y: integer); + +var + R: TRect; +begin + Active := true; + Application.ShowHint := false; + R := CalcHintRect(Screen.Width, Txt, nil); + OffsetRect(R, x, y); + ActivateHint(R, Txt); + Update; +end; + + + +//copied from Forms.pas + +{ Return number of scanlines between the scanline containing cursor hotspot + and the last scanline included in the cursor mask. } +function GetCursorHeightMargin: Integer; +var + IconInfo: TIconInfo; + BitmapInfoSize, BitmapBitsSize, ImageSize: DWORD; + Bitmap: PBitmapInfoHeader; + Bits: Pointer; + BytesPerScanline: Integer; + + function FindScanline(Source: Pointer; MaxLen: Cardinal; + Value: Cardinal): Cardinal; assembler; + asm + PUSH ECX + MOV ECX,EDX + MOV EDX,EDI + MOV EDI,EAX + POP EAX + REPE SCASB + MOV EAX,ECX + MOV EDI,EDX + end; + +begin + { Default value is entire icon height } + Result := GetSystemMetrics(SM_CYCURSOR); + if GetIconInfo(GetCursor, IconInfo) then + try + GetDIBSizes(IconInfo.hbmMask, BitmapInfoSize, BitmapBitsSize); + Bitmap := AllocMem(DWORD(BitmapInfoSize) + BitmapBitsSize); + try + Bits := Pointer(DWORD(Bitmap) + BitmapInfoSize); + if GetDIB(IconInfo.hbmMask, 0, Bitmap^, Bits^) and + (Bitmap^.biBitCount = 1) then + begin + { Point Bits to the end of this bottom-up bitmap } + with Bitmap^ do + begin + BytesPerScanline := ((biWidth * biBitCount + 31) and not 31) div 8; + ImageSize := biWidth * BytesPerScanline; + Bits := Pointer(DWORD(Bits) + BitmapBitsSize - ImageSize); + { Use the width to determine the height since another mask bitmap + may immediately follow } + Result := FindScanline(Bits, ImageSize, $FF); + { In case the and mask is blank, look for an empty scanline in the + xor mask. } + if (Result = 0) and (biHeight >= 2 * biWidth) then + Result := FindScanline(Pointer(DWORD(Bits) - ImageSize), + ImageSize, $00); + Result := Result div BytesPerScanline; + end; + Dec(Result, IconInfo.yHotSpot); + end; + finally + FreeMem(Bitmap, BitmapInfoSize + BitmapBitsSize); + end; + finally + if IconInfo.hbmColor <> 0 then DeleteObject(IconInfo.hbmColor); + if IconInfo.hbmMask <> 0 then DeleteObject(IconInfo.hbmMask); + end; +end; + + + + + +end. + diff --git a/VCL/QuickAvg.pas b/VCL/QuickAvg.pas new file mode 100644 index 0000000..5a89478 --- /dev/null +++ b/VCL/QuickAvg.pas @@ -0,0 +1,156 @@ +//------------------------------------------------------------------------------ +//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 QuickAvg; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + Math, SndTypes; + +type + TDoubleArray2D = array of array of Double; + + TQuickAverage = class(TComponent) + private + FPasses: integer; + FPoints: integer; + FScale: Single; + + ReBufs, ImBufs: TDoubleArray2D; + Idx, PrevIdx: integer; + + procedure SetPasses(const Value: integer); + procedure SetPoints(const Value: integer); + function DoFilter(V: Single; Bufs: TDoubleArray2D): Single; + protected + { Protected declarations } + public + constructor Create(AOwner: TComponent); override; + procedure Reset; + function Filter(V: Single): Single; overload; + function Filter(ARe, AIm: Single): TComplex; overload; + function Filter(V: TComplex): TComplex; overload; + function FilteredModule(ARe, AIm: Single): Single; + published + property Passes: integer read FPasses write SetPasses; + property Points: integer read FPoints write SetPoints; + end; + +procedure Register; + +implementation + +procedure Register; +begin + RegisterComponents('Snd', [TQuickAverage]); +end; + +{ TQuickAverage } + +//------------------------------------------------------------------------------ +// init +//------------------------------------------------------------------------------ +constructor TQuickAverage.Create(AOwner: TComponent); +begin + inherited; + FPoints := 128; + FPasses := 4; + Reset; +end; + + +procedure TQuickAverage.SetPasses(const Value: integer); +begin + FPasses := Max(1, Min(8, Value)); + Reset; +end; + + +procedure TQuickAverage.SetPoints(const Value: integer); +begin + FPoints := Max(1, Value); + Reset; +end; + + +procedure TQuickAverage.Reset; +begin + ReBufs := nil; + SetLength(ReBufs, FPasses+1, FPoints); + + ImBufs := nil; + SetLength(ImBufs, FPasses+1, FPoints); + + FScale := IntPower(FPoints, -FPasses); + Idx := 0; + PrevIdx := FPoints-1; +end; + + + + + + + +//------------------------------------------------------------------------------ +// filter +//------------------------------------------------------------------------------ +function TQuickAverage.Filter(V: Single): Single; +begin + Result := DoFilter(V, ReBufs); + PrevIdx := Idx; + + Idx := (Idx + 1) mod FPoints; +end; + + +function TQuickAverage.Filter(ARe, AIm: Single): TComplex; +begin + Result.Re := DoFilter(ARe, ReBufs); + Result.Im := DoFilter(AIm, ImBufs); + + PrevIdx := Idx; + Idx := (Idx + 1) mod FPoints; +end; + + +function TQuickAverage.Filter(V: TComplex): TComplex; +begin + Result.Re := DoFilter(V.Re, ReBufs); + Result.Im := DoFilter(V.Im, ImBufs); + + PrevIdx := Idx; + Idx := (Idx + 1) mod FPoints; +end; + + +function TQuickAverage.FilteredModule(ARe, AIm: Single): Single; +begin + with Filter(ARe, AIm) do + Result := Sqrt(Sqr(Re) + Sqr(Im)); +end; + +function TQuickAverage.DoFilter(V: Single; Bufs: TDoubleArray2D): Single; +var + p: integer; +begin + Result := V; + for p:=1 to FPasses do + begin + V := Result; + Result := Bufs[p][PrevIdx] - Bufs[p-1][Idx] + V; + Bufs[p-1][Idx] := V; + end; + Bufs[FPasses,Idx] := Result; + Result := Result * FScale; +end; + + + + +end. + diff --git a/VCL/SndCustm.pas b/VCL/SndCustm.pas new file mode 100644 index 0000000..5be38ce --- /dev/null +++ b/VCL/SndCustm.pas @@ -0,0 +1,269 @@ +//------------------------------------------------------------------------------ +//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 SndCustm; + +interface + +uses + Windows, Messages, SysUtils, Classes, Forms, SyncObjs, MMSystem, SndTypes, + Ini; + +type + TCustomSoundInOut = class; + + TWaitThread = class(TThread) + private + Owner: TCustomSoundInOut; + Msg: TMsg; + procedure ProcessEvent; + protected + procedure Execute; override; + public + end; + + + TCustomSoundInOut = class(TComponent) + private + FDeviceID: UINT; + FEnabled : boolean; + procedure SetDeviceID(const Value: UINT); + procedure SetSamplesPerSec(const Value: LongWord); + function GetSamplesPerSec: LongWord; + procedure SetEnabled(AEnabled: boolean); + procedure DoSetEnabled(AEnabled: boolean); + function GetBufCount: LongWord; + procedure SetBufCount(const Value: LongWord); + protected + FThread: TWaitThread; + rc: MMRESULT; + DeviceHandle: HWAVEOUT; + WaveFmt: TPCMWaveFormat; + Buffers: array of TWaveBuffer; + FBufsAdded: LongWord; + FBufsDone: LongWord; + + procedure Loaded; override; + procedure Err(Txt: string); + function GetThreadID: THandle; + + //override these + procedure Start; virtual; abstract; + procedure Stop; virtual; abstract; + procedure BufferDone(AHdr: PWaveHdr); virtual; abstract; + + property Enabled: boolean read FEnabled write SetEnabled default false; + property DeviceID: UINT read FDeviceID write SetDeviceID default WAVE_MAPPER; + property SamplesPerSec: LongWord read GetSamplesPerSec write SetSamplesPerSec default 48000; + property BufsAdded: LongWord read FBufsAdded; + property BufsDone: LongWord read FBufsDone; + property BufCount: LongWord read GetBufCount write SetBufCount; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + end; + + + + +implementation + + +{ TWaitThread } + +//------------------------------------------------------------------------------ +// TWaitThread +//------------------------------------------------------------------------------ + +procedure TWaitThread.Execute; +begin + Priority := tpTimeCritical; + + while GetMessage(Msg, 0, 0, 0) do + if Terminated then Exit + else if Msg.hwnd <> 0 then Continue + else + case Msg.Message of + MM_WIM_DATA, MM_WOM_DONE: Synchronize(ProcessEvent); + MM_WIM_CLOSE: Terminate; + end; +end; + + +procedure TWaitThread.ProcessEvent; +begin + try + if Msg.wParam = Owner.DeviceHandle then + Owner.BufferDone(PWaveHdr(Msg.lParam)); + except on E: Exception do + begin + Application.ShowException(E); + Terminate; + end; + end; +end; + + + + + + +{ TCustomSoundInOut } + +//------------------------------------------------------------------------------ +// system +//------------------------------------------------------------------------------ +constructor TCustomSoundInOut.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + + SetBufCount(DEFAULTBUFCOUNT); + + FDeviceID := WAVE_MAPPER; + + //init WaveFmt + with WaveFmt do + begin + wf.wFormatTag := WAVE_FORMAT_PCM; + wf.nChannels := 1; //mono + wf.nBlockAlign := 2; //SizeOf(SmallInt) * nChannels; + wBitsPerSample := 16; //SizeOf(SmallInt) * 8; + end; + + //fill nSamplesPerSec, nAvgBytesPerSec in WaveFmt + SamplesPerSec := 48000; +end; + + +destructor TCustomSoundInOut.Destroy; +begin + Enabled := false; + inherited; +end; + + +procedure TCustomSoundInOut.Err(Txt: string); +begin + raise ESoundError.Create(Txt); +end; + + + + + +//------------------------------------------------------------------------------ +// enable/disable +//------------------------------------------------------------------------------ +//do not enable component at design or load time +procedure TCustomSoundInOut.SetEnabled(AEnabled: boolean); +begin + if (not (csDesigning in ComponentState)) and + (not (csLoading in ComponentState)) and + (AEnabled <> FEnabled) + then DoSetEnabled(AEnabled); + FEnabled := AEnabled; +end; + + +//enable component after all properties have been loaded +procedure TCustomSoundInOut.Loaded; +begin + inherited Loaded; + + if FEnabled and not (csDesigning in ComponentState) then + begin + FEnabled := false; + SetEnabled(true); + end; +end; + + +procedure TCustomSoundInOut.DoSetEnabled(AEnabled: boolean); +begin + if AEnabled + then + begin + //reset counts + FBufsAdded := 0; + FBufsDone := 0; + //create waiting thread + FThread := TWaitThread.Create(true); + FThread.FreeOnTerminate := true; + FThread.Owner := Self; + //FThread.Priority := tpTimeCritical; + //start + FEnabled := true; + try Start; except FreeAndNil(FThread); raise; end; + //device started ok, wait for events + FThread.Resume; + end + else + begin + FThread.Terminate; + Stop; + end; +end; + + + + + +//------------------------------------------------------------------------------ +// get/set +//------------------------------------------------------------------------------ + +procedure TCustomSoundInOut.SetSamplesPerSec(const Value: LongWord); +begin + Enabled := false; + + with WaveFmt.wf do + begin + nSamplesPerSec := Value; + nAvgBytesPerSec := nSamplesPerSec * nBlockAlign; + end; +end; + + +function TCustomSoundInOut.GetSamplesPerSec: LongWord; +begin + Result := WaveFmt.wf.nSamplesPerSec; +end; + + + +procedure TCustomSoundInOut.SetDeviceID(const Value: UINT); +begin + Enabled := false; + FDeviceID := Value; +end; + + + +function TCustomSoundInOut.GetThreadID: THandle; +begin + Result := FThread.ThreadID; +end; + + +function TCustomSoundInOut.GetBufCount: LongWord; +begin + Result := Length(Buffers); +end; + +procedure TCustomSoundInOut.SetBufCount(const Value: LongWord); +begin + if Enabled then + raise Exception.Create('Cannot change the number of buffers for an open audio device'); + SetLength(Buffers, Value); +end; + + + + + + + +end. + diff --git a/VCL/SndOut.pas b/VCL/SndOut.pas new file mode 100644 index 0000000..cf1c505 --- /dev/null +++ b/VCL/SndOut.pas @@ -0,0 +1,203 @@ +//------------------------------------------------------------------------------ +//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 SndOut; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + BaseComp, MMSystem, SndTypes, SndCustm, Math; + +type + TAlSoundOut = class(TCustomSoundInOut) + private + FOnBufAvailable: TNotifyEvent; + FCloseWhenDone: boolean; + + procedure CheckErr; + function NextEmptyBuffer: PWaveBuffer; + procedure Unprepare(Buf: PWaveBuffer); + protected + procedure BufferDone(AHdr: PWaveHdr); override; + procedure Start; override; + procedure Stop; override; + public + function PutData(Data: TSingleArray): boolean; + procedure Purge; + published + property Enabled; + property DeviceID; + property SamplesPerSec; + property BufsAdded; + property BufsDone; + property BufCount; + property CloseWhenDone: boolean read FCloseWhenDone write FCloseWhenDone default false; + property OnBufAvailable: TNotifyEvent read FOnBufAvailable write FOnBufAvailable; + end; + +procedure Register; + + + +implementation + +procedure Register; +begin + RegisterComponents('Al', [TAlSoundOut]); +end; + + +{ TAlSoundOut } + +//------------------------------------------------------------------------------ +// Err handling +//------------------------------------------------------------------------------ +procedure TAlSoundOut.CheckErr; +var + Buf: array [0..MAXERRORLENGTH-1] of Char; +begin + if rc = MMSYSERR_NOERROR then Exit; + + if waveOutGetErrorText(rc, Buf, MAXERRORLENGTH) = MMSYSERR_NOERROR + then Err(Buf) + else Err('Unknown error: ' + IntToStr(rc)); +end; + + + + + + +//------------------------------------------------------------------------------ +// start/stop +//------------------------------------------------------------------------------ +procedure TAlSoundOut.Start; +var + i: integer; +begin + //open device + rc := waveOutOpen(@DeviceHandle, DeviceID, @WaveFmt, GetThreadID, 0, CALLBACK_THREAD); + CheckErr; + + //send all buffers to the player + if Assigned(FOnBufAvailable) then + for i:=0 to High(Buffers) do + FOnBufAvailable(Self); +end; + + +procedure TAlSoundOut.Stop; +var + i: integer; +begin + //stop playback + rc := waveOutReset(DeviceHandle); + CheckErr; + for i:=0 to High(Buffers) do Unprepare(@Buffers[i]); + //close device + rc := waveOutClose(DeviceHandle); + CheckErr; +end; + + + + + + + + +//------------------------------------------------------------------------------ +// Buffers +//------------------------------------------------------------------------------ +function TAlSoundOut.NextEmptyBuffer: PWaveBuffer; +var + i: integer; +begin + for i:=0 to High(Buffers) do + if (Buffers[i].Hdr.dwFlags and (WHDR_INQUEUE or WHDR_PREPARED)) = 0 then + begin Result := @Buffers[i]; Exit; end; + + Result := nil; + //Err('Output buffers full'); +end; + + + +procedure TAlSoundOut.Unprepare(Buf: PWaveBuffer); +begin + if (Buf.Hdr.dwFlags and WHDR_PREPARED) <> 0 then + begin + rc := WaveOutUnprepareHeader(DeviceHandle, @Buf.Hdr, SizeOf(TWaveHdr)); + Buf.Data := nil; + Inc(FBufsDone); + //CheckErr; + end; +end; + + + +function TAlSoundOut.PutData(Data: TSingleArray): boolean; +var + Buf: PWaveBuffer; + i: integer; +begin + Result := false; + if not Enabled then Exit; + + Buf := NextEmptyBuffer; + Result := Buf <> nil; + if not Result then Exit; + + //data to buffer (Single -> SmallInt) + Buf.Data := nil; + SetLength(Buf.Data, Length(Data)); + for i:=0 to High(Data) do + Buf.Data[i] := Max(-32767, Min(32767, Round(Data[i]))); + + //fill header + FillChar(Buf.Hdr, SizeOf(TWaveHdr), 0); + with Buf.Hdr do + begin + lpData := @Buf.Data[0]; + dwBufferLength := Length(Buf.Data) * SizeOf(SmallInt); + dwUser := DWORD(Buf); + end; + + //send buffer + rc := waveOutPrepareHeader(DeviceHandle, @Buf.Hdr, SizeOf(TWaveHdr)); + CheckErr; + rc := waveOutWrite(DeviceHandle, @Buf.Hdr, SizeOf(TWaveHdr)); + CheckErr; + + Inc(FBufsAdded); +end; + + + + + +//------------------------------------------------------------------------------ +// events +//------------------------------------------------------------------------------ +procedure TAlSoundOut.BufferDone(AHdr: PWaveHdr); +begin + Unprepare(PWaveBuffer(AHdr.dwUser)); + + if FCloseWhenDone and (FBufsDone = FBufsAdded) + then Enabled := false + else if Assigned(FOnBufAvailable) then FOnBufAvailable(Self); +end; + + + +procedure TAlSoundOut.Purge; +begin + Stop; Start; +end; + + + +end. diff --git a/VCL/SndTypes.pas b/VCL/SndTypes.pas new file mode 100644 index 0000000..2732c30 --- /dev/null +++ b/VCL/SndTypes.pas @@ -0,0 +1,75 @@ +unit SndTypes; + +interface + +uses + Windows, SysUtils, MMSystem, Math, ComObj; + +const + FOUR_PI = 4 * Pi; + TWO_PI = 2 * Pi; + HALF_PI = 0.5 * Pi; + RinD = Pi / 180; + SMALL_FLOAT = 1e-12; + + +type + TByteArray = array of byte; + TSmallIntArray = array of SmallInt; + TIntegerArray = array of integer; + TSingleArray = array of Single; + TSingleArray2D = array of TSingleArray; + TDoubleArray = array of Double; + TBooleanArray = array of Boolean; + TExtendedArray = array of Extended; + PSingleArray = array of PSingle; + + TDataBufferF = array of TSingleArray; + TDataBufferI = array of TIntegerArray; + + PHugeSingleArray = ^THugeSingleArray; + THugeSingleArray = array[0..(MAXINT div SizeOf(Single)) -1] of Single; + + PComplex = ^TComplex; + TComplex = record + Re, Im: Single; + end; + + TComplexArray = array of TComplex; + + TCplArr = array[0..MAXINT shr 8] of TComplex; + PComplexArray= ^TCplArr; + + TReImArrays = record Re, Im: TSingleArray; end; + + ESoundError = class (Exception) end; + + + + PWaveBuffer = ^TWaveBuffer; + TWaveBuffer = record + Hdr: TWaveHdr; + Data: TSmallIntArray; + end; + +procedure SetLengthReIm(var Arr: TReImArrays; Len: integer); +procedure ClearReIm(var Arr: TReImArrays); + +implementation + +procedure SetLengthReIm(var Arr: TReImArrays; Len: integer); +begin + SetLength(Arr.Re, Len); + SetLength(Arr.Im, Len); +end; + + +procedure ClearReIm(var Arr: TReImArrays); +begin + Arr.Re := nil; Arr.Im := nil; +end; + + + +end. + diff --git a/VCL/VolmSldr.dcr b/VCL/VolmSldr.dcr new file mode 100644 index 0000000000000000000000000000000000000000..6256154e80577f1c0614c0c8f67bac22e9bb7447 GIT binary patch literal 480 zcmbu3Jr2S!425423tLCVjvRplz<>lo;_n=6=|;AC%awAhZthE*Rs}JERoh=*>?Z?2 z!&J2-zJ*l4mWt{EH#~605qF%h$CY%zj&vy-b-h}S%NxSFWCfEOdVLQM@Pqf(Scy!J z7$YCjajB^_R=ZarzXZLf#o*j?^avuK95e-W)xK*vXfwTZuANx;H|ojjm3{hbJJ%Dt ScBXfEr1%t8oo+DYuQ~wXIK0&W literal 0 HcmV?d00001 diff --git a/VCL/VolmSldr.pas b/VCL/VolmSldr.pas new file mode 100644 index 0000000..141b333 --- /dev/null +++ b/VCL/VolmSldr.pas @@ -0,0 +1,248 @@ +unit VolmSldr; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + Math, PermHint; + +type + TVolumeSlider = class(TGraphicControl) + private + FHintWin: TPermanentHintWindow; + FMargin: integer; + FValue: Single; + FOnChange: TNotifyEvent; + + FDownValue: Single; + FDownX: integer; + FOverloaded: boolean; + FShowHint: boolean; + FDbMax: Single; + FDbScale: Single; + + procedure SetMargin(const Value: integer); + procedure SetValue(const Value: Single); + function ThumbRect: TRect; + procedure SetOverloaded(const Value: boolean); + procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE; + procedure SetShowHint(const Value: boolean); + procedure SetDbMax(const Value: Single); + procedure SetDbScale(const Value: Single); + function GetDb: Single; + procedure UpdateHint; + procedure SetDb(const AdB: Single); + protected + procedure Paint; override; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); override; + procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; + public + constructor Create(AOwner: TComponent); override; + published + property ShowHint: boolean read FShowHint write SetShowHint; + property Margin: integer read FMargin write SetMargin; + property Value: Single read FValue write SetValue; + property Enabled; + property Overloaded: boolean read FOverloaded write SetOverloaded; + property OnChange: TNotifyEvent read FOnChange write FOnChange; + property OnDblClick; + + property DbMax: Single read FDbMax write SetDbMax; + property DbScale: Single read FDbScale write SetDbScale; + property Db: Single read GetDb write SetDb; + end; + +procedure Register; + + + +implementation + +const + VMargin = 6; + + +procedure Register; +begin + RegisterComponents('Snd', [TVolumeSlider]); +end; + +{ TVolumeSlider } + +constructor TVolumeSlider.Create(AOwner: TComponent); +begin + inherited; + FMargin := 5; + FValue := 0.75; + Width := 60; + Height := 20; + ControlStyle := [csCaptureMouse, csClickEvents, csDoubleClicks, csOpaque]; + FHintWin := TPermanentHintWindow.Create(Self); + FShowHint := true; + + FDbMax := 0; + FDbScale := 60; + UpdateHint; +end; + + +function TVolumeSlider.ThumbRect: TRect; +var + x: integer; +begin + x := FMargin + Round((Width - 2 * FMargin) * FValue); + Result := Rect(x-4, VMargin div 2, x+5, Height - (VMargin div 2) + 1); +end; + + +procedure TVolumeSlider.Paint; +var + R: TRect; + Bmp: TBitMap; +begin + Bmp := TBitMap.Create; + try + with Bmp.Canvas do + begin + Bmp.Width := Width; + Bmp.Height := Height; + //background + Brush.Color := clBtnFace; + FillRect(Rect(0, 0, Width, Height)); + //triangle + Pen.Color := clWhite; + MoveTo(FMargin, Height-VMargin); + LineTo(Width-FMargin, Height-VMargin); + LineTo(Width-FMargin, VMargin); + Pen.Color := clBtnShadow; + LineTo(FMargin-1, Height-VMargin-1); + //overload + R := Bounds(FMargin+1, VMargin-2, 7, 5); + DrawEdge(Handle, R, BDR_SUNKENOUTER, BF_MIDDLE or BF_RECT); + + if FOverloaded then + begin + Brush.Color := clRed; + InflateRect(R, -1, -1); + FillRect(R); + end; + //thumb + R := ThumbRect; + if Enabled + then DrawFrameControl(Handle, R, DFC_BUTTON, DFCS_BUTTONPUSH) + else DrawEdge(Handle, R, BDR_SUNKENOUTER, BF_MIDDLE or BF_RECT); + + Canvas.Draw(0, 0, Bmp); + end; + finally + Bmp.Free; + end; +end; + + +procedure TVolumeSlider.SetMargin(const Value: integer); +begin + FMargin := Max(5, Min((Width div 2) - 5, Value)); + Invalidate; +end; + + +procedure TVolumeSlider.SetValue(const Value: Single); +begin + FValue := Max(0, Min(1, Value)); + UpdateHint; + Invalidate; +end; + + +procedure TVolumeSlider.MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +begin + if (Button = mbLeft) and PtInRect(ThumbRect, POINT(X,Y)) + then begin FDownValue := FValue; FDownX := X; end + else ControlState := ControlState - [csClicked]; +end; + + +procedure TVolumeSlider.MouseMove(Shift: TShiftState; X, Y: Integer); +begin + //D5 bug: WM_LBUTTONUP is never received if the mouse button is released + //over TToolButton with tbsDropDown, thus we have to remove csClicked manually + if not (ssLeft in Shift) then + begin + ControlState := ControlState - [csClicked]; + MouseCapture := false; + end; + + if (PtInRect(ClientRect, POINT(X,Y)) or (csClicked in ControlState)) and FShowHint + then FHintWin.ShowHint(Hint) + else FHintWin.HideHint; + + if not (csClicked in ControlState) then Exit; + + Value := FDownValue + (X - FDownX) / (Width - 2 * FMargin); + Repaint; + if Assigned(FOnChange) then FOnChange(Self); + +end; + + + +procedure TVolumeSlider.SetOverloaded(const Value: boolean); +begin + if FOverloaded = Value then Exit; + FOverloaded := Value; + Repaint; +end; + +procedure TVolumeSlider.CMMouseLeave(var Message: TMessage); +begin + if not (csClicked in ControlState) + then FHintWin.HideHint; +end; + +procedure TVolumeSlider.SetShowHint(const Value: boolean); +begin + FShowHint := Value; +end; + +procedure TVolumeSlider.SetDbMax(const Value: Single); +begin + FDbMax := Value; + UpdateHint; +end; + +procedure TVolumeSlider.SetDbScale(const Value: Single); +begin + FDbScale := Value; + UpdateHint; +end; + +function TVolumeSlider.GetDb: Single; +begin + Result := DbMax + (FValue - 1) * DbScale; +end; + +procedure TVolumeSlider.UpdateHint; +begin + Hint := Format('%.1f dB', [dB]); +end; + +procedure TVolumeSlider.SetDb(const AdB: Single); +begin + Value := (AdB - DbMax) / DbScale + 1; +end; + +procedure TVolumeSlider.MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +begin + FHintWin.HideHint; + inherited; +end; + + + +end. + diff --git a/VCL/VolumCtl.dcr b/VCL/VolumCtl.dcr new file mode 100644 index 0000000000000000000000000000000000000000..72e007cfe92f041d23cf60ba3229b44fa58a8439 GIT binary patch literal 484 zcmbu4I}XAy5JV>kDWOYAnUX`$Av!)1!ki=BrgVpom0LmQ%x3LaNHmC%*ZZ^9Hxp|;(uGw%r7R26L8@qORr0WNrNjXRO$ zF^(e*y`Z*ejl11B!u_L{WI6W^Nl)WJA7}PK77mT5VHq!Kq(v^{-Z(w literal 0 HcmV?d00001 diff --git a/VCL/VolumCtl.pas b/VCL/VolumCtl.pas new file mode 100644 index 0000000..8ca425e --- /dev/null +++ b/VCL/VolumCtl.pas @@ -0,0 +1,386 @@ +//------------------------------------------------------------------------------ +//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 VolumCtl; + +interface + +//{$DEFINE DEBUG} + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + SndTypes, Math; + +type + TVolumeControl = class(TComponent) + private + FNoiseIn: Single; + FNoiseOut: Single; + + FBeta: Single; + FEnvelope: Single; + FDefaultGain: Single; + + FComplexBuf: TReImArrays; //complex samples + FRealBuf: TSingleArray; //real samples + FMagBuf: TSingleArray; //log magnitude + FLen, FBufIdx: integer; + + FAgcEnabled: boolean; + FAttackShape: TSingleArray; + FIsOverload: boolean; + + {$IFDEF DEBUG} DebugArr: TSingleArray; {$ENDIF} + FAttackSamples: integer; + FHoldSamples: integer; + FMaxOut: Single; + + function GetNoiseInDb: Single; + function GetNoiseOutDb: Single; + procedure SetNoiseInDb(const Value: Single); + procedure SetNoiseOutDb(const Value: Single); + procedure SetAttackSamples(const Value: integer); + procedure SetHoldSamples(const Value: integer); + procedure SetAgcEnabled(const Value: boolean); + + procedure CalcBeta; + procedure MakeAttackShape; + function CalcAgcGain: Single; + + function ApplyAgc(V: Single): Single; overload; + function ApplyAgc(Re, Im: Single): TComplex; overload; + function ApplyDefaultGain(V: Single): Single; overload; + function ApplyDefaultGain(Re, Im: Single): TComplex; overload; + procedure SetMaxOut(const Value: Single); + public + constructor Create(AOwner: TComponent); override; + procedure Reset; + function Process(Data: TSingleArray): TSingleArray; overload; + function Process(Data: TReImArrays): TReImArrays; overload; + property IsOverload: boolean read FIsOverload; + published + property MaxOut: Single read FMaxOut write SetMaxOut; + property NoiseInDb: Single read GetNoiseInDb write SetNoiseInDb; + property NoiseOutDb: Single read GetNoiseOutDb write SetNoiseOutDb; + property AttackSamples: integer read FAttackSamples write SetAttackSamples default 28; + property HoldSamples: integer read FHoldSamples write SetHoldSamples default 28; + property AgcEnabled: boolean read FAgcEnabled write SetAgcEnabled; + end; + +procedure Register; + + + +implementation + +procedure Register; +begin + RegisterComponents('Snd', [TVolumeControl]); +end; + + +{ TVolumeControl } + + +//------------------------------------------------------------------------------ +// system +//------------------------------------------------------------------------------ +constructor TVolumeControl.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + + FMaxOut := 20000; + FNoiseIn := 1; + FNoiseOut := 2000; + CalcBeta; + + FAttackSamples := 28; //5 ms if SampleRate=5512 + FHoldSamples := 28; + MakeAttackShape; +end; + + +procedure TVolumeControl.Reset; +begin + FRealBuf := nil; + SetLength(FRealBuf, FLen); + + ClearReIm(FComplexBuf); + SetLengthReIm(FComplexBuf, FLen); + + FMagBuf := nil; + SetLength(FMagBuf, FLen); + + FBufIdx := 0; +end; + + + + + + + +//------------------------------------------------------------------------------ +// get/set +//------------------------------------------------------------------------------ +function TVolumeControl.GetNoiseInDb: Single; +begin + Result := 20 * Log10(FNoiseIn); +end; + +function TVolumeControl.GetNoiseOutDb: Single; +begin + Result := 20 * Log10(FNoiseOut); +end; + +procedure TVolumeControl.SetNoiseInDb(const Value: Single); +begin + FNoiseIn := Power(10, 0.05 * Value); + CalcBeta; +end; + +procedure TVolumeControl.SetNoiseOutDb(const Value: Single); +begin + FNoiseOut := Min(0.25 * FMaxOut, Power(10, 0.05 * Value)); + CalcBeta; +end; + +procedure TVolumeControl.SetMaxOut(const Value: Single); +begin + FMaxOut := Value; + CalcBeta; +end; + +procedure TVolumeControl.SetAttackSamples(const Value: integer); +begin + FAttackSamples := Max(1, Value); + MakeAttackShape; +end; + + +procedure TVolumeControl.SetHoldSamples(const Value: integer); +begin + FHoldSamples := Max(1, Value); + MakeAttackShape; +end; + + +procedure TVolumeControl.SetAgcEnabled(const Value: boolean); +begin + if Value and not FAgcEnabled then Reset; + FAgcEnabled := Value; +end; + + + + + + + +//------------------------------------------------------------------------------ +// params +//------------------------------------------------------------------------------ +procedure TVolumeControl.MakeAttackShape; +var + i: integer; +begin + FLen := 2 * (FAttackSamples + FHoldSamples) + 1; + + FAttackShape := nil; + SetLength(FAttackShape, FLen); + + //attack shape + for i:=0 to FAttackSamples-1 do + begin + FAttackShape[i] := Ln(0.5 - 0.5 * Cos((i+1) * Pi / (FAttackSamples+1))); + FAttackShape[FLen-1-i] := FAttackShape[i]; + end; + + Reset; +end; + + +// Amplitude characteristic of AGC: +// Out = FMaxOut * (1 - Exp(-In / FBeta)) +// +// find FBeta that maps FNoiseIn to FNoiseOut + +procedure TVolumeControl.CalcBeta; +begin + FBeta := FNoiseIn / Ln(FMaxOut / (FMaxOut - FNoiseOut)); + + FDefaultGain := FNoiseOut / FNoiseIn; +end; + + + + + + + + +//------------------------------------------------------------------------------ +// gain +//------------------------------------------------------------------------------ +function TVolumeControl.CalcAgcGain: Single; +var + Sample, Envel: Single; + Di, Wi: integer; +begin + //look at both sides of the sample + //and find the max. magnitude, weighed by FAttackShape + Envel := 1E-10; + Di := FBufIdx; + for Wi:=0 to FLen-1 do + begin + Sample := FMagBuf[Di] + FAttackShape[Wi]; + if Sample > Envel then Envel := Sample; + Inc(Di); + if Di = FLen then Di := 0; + end; + + //envelope + FEnvelope := Envel; + Envel := Exp(Envel); + + //gain + Result := FMaxOut * (1 - Exp(-Envel / FBeta)) / Envel; +end; + + +function TVolumeControl.ApplyAgc(V: Single): Single; +begin + //store data + FRealBuf[FBufIdx] := V; + FMagBuf[FBufIdx] := Ln(Abs(V + 1E-10)); + + //increment index + FBufIdx := (FBufIdx+1) mod FLen; + + //output + Result := FRealBuf[(FBufIdx + (FLen div 2)) mod FLen] * CalcAgcGain; +end; + + +function TVolumeControl.ApplyAgc(Re, Im: Single): TComplex; +var + Gain: Single; + Mid: integer; +begin + //store data + FComplexBuf.Re[FBufIdx] := Re; + FComplexBuf.Im[FBufIdx] := Im; + FMagBuf[FBufIdx] := 0.5 * Ln(Sqr(Re) + Sqr(Im)); + + //increment index + FBufIdx := (FBufIdx+1) mod FLen; + + //output + Mid := (FBufIdx + (FLen div 2)) mod FLen; + Gain := CalcAgcGain; + Result.Re := FComplexBuf.Re[Mid] * Gain; + Result.Im := FComplexBuf.Im[Mid] * Gain; +end; + + + +function TVolumeControl.ApplyDefaultGain(V: Single): Single; +begin + Result := Min(FMaxOut, Max(-FMaxOut, V * FDefaultGain)); + FIsOverload := FIsOverload or (Abs(Result) = FMaxOut); +end; + + + +function TVolumeControl.ApplyDefaultGain(Re, Im: Single): TComplex; +begin + Result.Re := Min(FMaxOut, Max(-FMaxOut, Re * FDefaultGain)); + Result.Im := Min(FMaxOut, Max(-FMaxOut, Im * FDefaultGain)); + + FIsOverload := FIsOverload or + (Abs(Result.Re) = FMaxOut) or (Abs(Result.Im) = FMaxOut); +end; + + + + + + + +//------------------------------------------------------------------------------ +// AGC +//------------------------------------------------------------------------------ +function TVolumeControl.Process(Data: TSingleArray): TSingleArray; +var + i: integer; +begin +{$IFDEF DEBUG} SetLength(DebugArr, Length(Data)); {$ENDIF} + + FIsOverload := false; + Result := nil; + SetLength(Result, Length(Data)); + + if FAgcEnabled + then for i:=0 to High(Result) do + begin + Result[i] := ApplyAgc(Data[i]); + {$IFDEF DEBUG} DebugArr[i] := FEnvelope; {$ENDIF} + end + else for i:=0 to High(Result) do + Result[i] := ApplyDefaultGain(Data[i]); + + +{$IFDEF DEBUG} + with TStringList.Create do + try + for i:=0 to High(Result) do Add(Format('%d, %f', [i+(FLen div 2), Data[i]])); + SaveToFile('c:\in.txt'); + Clear; + for i:=0 to High(FAttackShape) do Add(Format('%d, %f', [i, 1000*Exp(FAttackShape[i])])); + SaveToFile('c:\shp.txt'); + Clear; + for i:=0 to High(Result) do Add(Format('%d, %f', [i, Exp(DebugArr[i])])); + SaveToFile('c:\env.txt'); + Clear; + for i:=0 to High(Result) do Add(Format('%d, %f', [i, 0.05*Result[i]])); + SaveToFile('c:\out.txt'); + finally + Free; + end; +{$ENDIF} +end; + + +function TVolumeControl.Process(Data: TReImArrays): TReImArrays; +var + i: integer; +begin + FIsOverload := false; + + ClearReIm(Result); + SetLengthReIm(Result, Length(Data.Re)); + + if FAgcEnabled + then + for i:=0 to High(Result.Re) do + with ApplyAgc(Data.Re[i], Data.Im[i]) do + begin Result.Re[i] := Re; Result.Im[i] := Im; end + else + for i:=0 to High(Result.Re) do + with ApplyDefaultGain(Data.Re[i], Data.Im[i]) do + begin Result.Re[i] := Re; Result.Im[i] := Im; end; +end; + + +{$UNDEF DEBUG} + + + + + + +end. + + diff --git a/VCL/WavFile.pas b/VCL/WavFile.pas new file mode 100644 index 0000000..2c5afb6 --- /dev/null +++ b/VCL/WavFile.pas @@ -0,0 +1,683 @@ +//------------------------------------------------------------------------------ +//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 WavFile; + +//TSingleArray input and output buffers are normalized: Abs() <= 32767 + +//to do: direct read/write mmio buffer like in lowpass.c MS demo (sdk_Graphics_AUDIO_lowpass.exe) +//to do: access buffers by pointer, not by index +//to do: read non-PCM files, convert from different sampling rates via ACM + + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + MMSystem, SndTypes; + +type + TByteArray = array of byte; + + TAlWavFile = class(TComponent) + private + ckInfoRIFF, ckInfo: TMmckInfo; + WaveFmt: TPcmWaveFormat; + + FFileName: TFileName; + FIsOpen: boolean; + rc: HMMIO; + FHandle: HMMIO; + FStereo: boolean; + FSamplesPerSec: LongWord; + FBytesPerSample: LongWord; + FAlignBits: integer; + FSampleCnt: LongWord; + FLData: TSingleArray; + FRData: TSingleArray; + FWriteMode: boolean; + FInfo: TStrings; + FCurrentSample: LongWord; + + procedure SetBytesPerSample(const Value: LongWord); + procedure SetSamplesPerSec(const Value: LongWord); + procedure SetStereo(const Value: boolean); + procedure InfoChanging(Sender: TObject); + procedure SetInfo(const Value: TStrings); + procedure SetFileName(const Value: TFileName); + protected + procedure ChkErr; + procedure ErrIf(IsErr: boolean; Msg: string); + procedure ChkNotOpen; + procedure ReadInfo; + procedure WriteInfo; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure OpenRead; + procedure OpenWrite; + procedure Seek(SampleNo: LongWord); + procedure Read(ASampleCnt: LongWord); + function ReadTo(ALData, ARData: PSingle; ASampleCnt: LongWord): LongWord; + procedure Write; + procedure WriteFrom(ALData, ARData: PSingle; ASampleCnt: LongWord); + procedure NormalizeData; + procedure Close; + + property SampleCnt: LongWord read FSampleCnt; + property CurrentSample: LongWord read FCurrentSample; + property IsOpen: boolean read FIsOpen; + property LData: TSingleArray read FLData write FLData; + property RData: TSingleArray read FRData write FRData; + published + property FileName : TFileName read FFileName write SetFileName; + property Stereo: boolean read FStereo write SetStereo default false; + property SamplesPerSec: LongWord read FSamplesPerSec write SetSamplesPerSec default 11025; + property BytesPerSample: LongWord read FBytesPerSample write SetBytesPerSample default 2; + property Info: TStrings read FInfo write SetInfo; + end; + +procedure Register; + +implementation + +procedure Register; +begin + RegisterComponents('Snd', [TAlWavFile]); +end; + +{ TAlWavFile } + +//------------------------------------------------------------------------------ +// create/destroy +//------------------------------------------------------------------------------ + +constructor TAlWavFile.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + + FBytesPerSample := 2; + FSamplesPerSec := 11025; + Stereo := false; + + FInfo := TStringList.Create; + TStringList(FInfo).OnChanging := InfoChanging; +end; + +destructor TAlWavFile.Destroy; +begin + FInfo.Free; + inherited Destroy; +end; + + + + + + +//------------------------------------------------------------------------------ +// Open/Close/Seek +//------------------------------------------------------------------------------ + +procedure TAlWavFile.OpenRead; +begin + ErrIf(FIsOpen, 'File already open'); + + FWriteMode := false; + FCurrentSample := 0; + + //open + FHandle := mmioOpen(pchar(FFileName), nil, MMIO_READ or MMIO_ALLOCBUF or MMIO_DENYWRITE); + ErrIf(FHandle = 0, 'Unable to open file'); + try + //go to wav section + ckInfoRiff.fccType := mmioStringToFOURCCA('WAVE', 0); + rc := mmioDescend(FHandle, @ckInfoRIFF, nil, MMIO_FINDRIFF); + ChkErr; + + //read Info strings + ReadInfo; + + //go to format header + ckInfo.ckid := mmioStringToFOURCCA('fmt ', 0); + rc := mmioDescend(FHandle, @ckInfo, @ckInfoRIFF, MMIO_FINDCHUNK); + ChkErr; + ErrIf(ckInfo.cksize < SizeOf(TPcmWaveFormat), 'Invalid header size'); + //read header + rc := mmioRead(FHandle, @WaveFmt, SizeOf(TPcmWaveFormat)); + ErrIf(rc <> SizeOf(TPcmWaveFormat), 'Unable to read header'); + ErrIf(WaveFmt.wf.wFormatTag <> WAVE_FORMAT_PCM, 'Unsupported compression method'); + //store parameters + FStereo := WaveFmt.wf.nChannels = 2; + FSamplesPerSec := WaveFmt.wf.nSamplesPerSec; + FBytesPerSample := WaveFmt.wBitsPerSample shr 3; + + case WaveFmt.wf.nBlockAlign of + 1: FAlignBits := 0; + 2: FAlignBits := 1; + 4: FAlignBits := 2; + end; + + //go to data + rc := mmioAscend(FHandle, @ckInfo, 0); + ChkErr; + ckInfo.ckid := mmioStringToFOURCCA('data', 0); + rc := mmioDescend(FHandle, @ckInfo, @ckInfoRiff, MMIO_FINDCHUNK); + ChkErr; + + FSampleCnt := ckInfo.ckSize shr FAlignBits; + except + mmioClose(FHandle, 0); + raise; + end; + + FIsOpen := true; +end; + + +procedure TAlWavFile.OpenWrite; +begin + ErrIf(FIsOpen, 'File already open'); + + FWriteMode := true; + FCurrentSample := 0; + + //open + FHandle := mmioOpen(pchar(FFileName), nil, MMIO_CREATE or MMIO_ALLOCBUF or MMIO_WRITE or MMIO_DENYWRITE); + ErrIf(FHandle = 0, 'Unable to open file'); + try + //fill WaveFmt + with WaveFmt.wf do + begin + wFormatTag := WAVE_FORMAT_PCM; + if FStereo + then nChannels := 2 + else nChannels := 1; + nSamplesPerSec := FSamplesPerSec; + nAvgBytesPerSec := FSamplesPerSec shl FAlignBits; + nBlockAlign := 1 shl FAlignBits; + WaveFmt.wBitsPerSample := (16 shl FAlignBits) shr nChannels; + end; + + ckInfoRIFF.fccType := mmioStringToFOURCCA('WAVE', 0); + rc := mmioCreateChunk(FHandle, @ckInfoRIFF, MMIO_CREATERIFF); + ChkErr; + + //save Info strings + {!}//WriteInfo; + + ckInfo.ckId := mmioStringToFOURCCA('fmt ', 0); + ckInfo.ckSize := SizeOf(TPcmWaveFormat); + rc := mmioCreateChunk(FHandle, @ckInfo, 0); + ChkErr; + rc := mmioWrite(FHandle, @WaveFmt, SizeOf(TPcmWaveFormat)); + ErrIf(rc <> SizeOf(TPcmWaveFormat), 'WAV write error'); + + rc := mmioAscend(FHandle, @ckInfo, 0); + ChkErr; + + ckInfo.ckid := mmioStringToFOURCCA('data', 0); + //ckInfo.ckSize := 0; + rc := mmioCreateChunk(FHandle, @ckInfo, 0); + ChkErr; + except + mmioClose(FHandle, 0); + raise; + end; + + FSampleCnt := 0; + FIsOpen := true; +end; + + +procedure TAlWavFile.Close; +begin + ErrIf(not FIsOpen, 'File not open'); + + if FWriteMode then + begin + //ascend from 'data' + rc := mmioAscend(FHandle, @ckInfo, 0); + {ChkErr;} + + {!} + if FWriteMode then WriteInfo; + + //ascend from 'RIFF' + rc := mmioAscend(FHandle, @ckInfoRiff, 0); + {ChkErr;} + end; + + rc := mmioClose(FHandle, 0); + {ChkErr;} + + FIsOpen := false; + FCurrentSample := 0; +end; + + +procedure TAlWavFile.Seek(SampleNo: LongWord); +var + NewPos: integer; +begin + ErrIf(not IsOpen, 'File not open'); + //ErrIf(FWriteMode, 'Cannot seek in write mode'); + ErrIf(SampleNo > FSampleCnt, 'Invalid Seek position'); + + NewPos := ckInfo.dwDataOffset + (SampleNo shl FAlignBits); + + rc := mmioSeek(FHandle, NewPos, SEEK_SET); + ErrIf(rc <> NewPos, 'WAV seek failed'); + + FCurrentSample := SampleNo; +end; + + + + + + + +//------------------------------------------------------------------------------ +// Read +//------------------------------------------------------------------------------ + +procedure TAlWavFile.Read(ASampleCnt: LongWord); +begin + //free output arrays + FLData := nil; + FRData := nil; + if ASampleCnt = 0 then Exit; + + //allocate output arrays + SetLength(FLData, ASampleCnt); + try + if FStereo + then + begin + SetLength(FRData, ASampleCnt); + ASampleCnt := ReadTo(@FLData[0], @FRData[0], ASampleCnt); + end + else + ASampleCnt := ReadTo(@FLData[0], nil, ASampleCnt); + //resize buffers to reflect the # of samples actually read + SetLength(FLData, ASampleCnt); + if FStereo then SetLength(FRData, ASampleCnt); + except + FRData := nil; + FLData := nil; + raise; + end; +end; + + +function TAlWavFile.ReadTo(ALData, ARData: PSingle; ASampleCnt: LongWord): LongWord; +var + Buf: TByteArray; + DataType: integer; + i: integer; +begin + ErrIf(not IsOpen, 'File not open'); + ErrIf(FWriteMode, 'File open in write mode'); + ErrIf(ALData = nil, 'Left buffer not supplied'); + ErrIf(Stereo and (ARData = nil), 'Right buffer not supplied'); + + //allocate buffer + + //to do: direct read from the mmio buffer like in lowpass.c MS demo + //(sdk_Graphics_AUDIO_lowpass.exe) + + SetLength(Buf, ASampleCnt shl FAlignBits); + try + //read + ASampleCnt := mmioRead(FHandle, @Buf[0], Length(Buf)); + ErrIf(Integer(ASampleCnt) = -1, 'WAV read error'); + //ErrIf(ASampleCnt = 0, 'End of file'); + ASampleCnt := ASampleCnt shr FAlignBits; + + //convert data + + if FStereo + then DataType := BytesPerSample shl 2 + else DataType := BytesPerSample; + + if ASampleCnt > 0 then + case DataType of + 1: //8 bit mono + for i:=0 to ASampleCnt-1 do + begin + //to do: access Buf by pointer + + //Buf[i]: byte = 0..255 + //Integer(Buf[i])-128 = -128..127 + //shl 8 = -32768..32512 + + ALData^ := (Integer(Buf[i]) - 128) shl 8; + Inc(ALData); + end; + + 2: //16 bit mono + for i:=0 to ASampleCnt-1 do + begin + ALData^ := PSmallInt(@Buf[i shl 1])^; + Inc(ALData); + end; + + 4: //8 bit stereo + for i:=0 to ASampleCnt-1 do + begin + ALData^ := (Integer(Buf[i shl 1]) - 128) shl 8; + ARData^ := (Integer(Buf[i shl 1] + 1) - 128) shl 8; + Inc(ALData); + Inc(ARData); + end; + + 8: //16 bit stereo + for i:=0 to ASampleCnt-1 do + begin + ALData^ := PSmallInt(@Buf[i shl 2])^; + ARData^ := PSmallInt(@Buf[(i shl 2) + 2])^; + Inc(ALData); + Inc(ARData); + end; + end; + finally + Buf := nil; + end; + + Inc(FCurrentSample, ASampleCnt); + Result := ASampleCnt; +end; + + + + + + +//------------------------------------------------------------------------------ +// Write +//------------------------------------------------------------------------------ + +procedure TAlWavFile.Write; +begin + if Length(FLData) = 0 then Exit; + if FRData = nil + then WriteFrom(@FLData[0], nil, Length(FLData)) + else WriteFrom(@FLData[0], @FRData[0], Length(FLData)); +end; + + +procedure TAlWavFile.WriteFrom(ALData, ARData: PSingle; ASampleCnt: LongWord); +var + Buf: TByteArray; + DataType: integer; + i: integer; +begin + ErrIf(not IsOpen, 'File not open'); + ErrIf(not FWriteMode, 'File open in read mode'); + ErrIf(ALData = nil, 'Left buffer not supplied'); + ErrIf(Stereo and (ARData = nil), 'Right buffer not supplied'); + + //allocate buffer + + //to do: direct read from the mmio buffer like in lowpass.c MS demo + //(sdk_Graphics_AUDIO_lowpass.exe) + + SetLength(Buf, ASampleCnt shl FAlignBits); + try + if FStereo + then DataType := BytesPerSample shl 2 + else DataType := BytesPerSample; + + case DataType of + 1: //8 bit mono + for i:=0 to ASampleCnt-1 do + begin + //ALData^ = -32767..32767 Single + //Round() = -32767..32767 integer + //shr 8 = -128..127 + + Buf[i] := (Round(ALData^) shr 8) + 128; + Inc(ALData); + end; + + 2: //16 bit mono + for i:=0 to ASampleCnt-1 do + begin + PSmallInt(@Buf[i shl 1])^ := Round(ALData^); + Inc(ALData); + end; + + 4: //8 bit stereo + for i:=0 to ASampleCnt-1 do + begin + Buf[i shl 1] := (Round(ALData^) shr 8) + 128; + Buf[(i shl 1)+1] := (Round(ARData^) shr 8) + 128; + Inc(ALData); + Inc(ARData); + end; + + 8: //16 bit stereo + for i:=0 to ASampleCnt-1 do + begin + PSmallInt(@Buf[i shl 2])^ := Round(ALData^); + PSmallInt(@Buf[(i shl 2)+2])^ := Round(ARData^); + Inc(ALData); + Inc(ARData); + end; + end; + + //write + rc := mmioWrite(FHandle, @Buf[0], Length(Buf)); + ErrIf(rc <> Length(Buf), 'WAV write error'); + Inc(FSampleCnt, ASampleCnt); + FCurrentSample := FSampleCnt; + finally + Buf := nil; + end; +end; + + + + +//------------------------------------------------------------------------------ +// Property get/set +//------------------------------------------------------------------------------ + +procedure TAlWavFile.SetBytesPerSample(const Value: LongWord); +begin + ChkNotOpen; + FBytesPerSample := Value; + + FAlignBits := FBytesPerSample shr 1; + if FStereo then Inc(FAlignBits); +end; + + +procedure TAlWavFile.SetSamplesPerSec(const Value: LongWord); +begin + ChkNotOpen; + FSamplesPerSec := Value; +end; + + +procedure TAlWavFile.SetStereo(const Value: boolean); +begin + ChkNotOpen; + FStereo := Value; + + FAlignBits := FBytesPerSample shr 1; + if FStereo then Inc(FAlignBits); +end; + + +procedure TAlWavFile.SetFileName(const Value: TFileName); +begin + ChkNotOpen; + FFileName := Value; +end; + + +procedure TAlWavFile.InfoChanging(Sender: TObject); +begin + // ChkNotOpen; +end; + + +procedure TAlWavFile.SetInfo(const Value: TStrings); +begin + FInfo.Assign(Value); +end; + + + + + +//------------------------------------------------------------------------------ +// Read/write LIST/INFO chunk +//------------------------------------------------------------------------------ +procedure TAlWavFile.WriteInfo; +var + i: integer; + InfName: string; + InfValue: string; + ckInfoLIST, ckInfoPiece: TMmckInfo; +begin + //remove invalid info entries + for i:= FInfo.Count-1 downto 0 do + if (Length(FInfo[i]) < 6) or (FInfo[i][5] <> '=') then FInfo.Delete(i); + //do not save empty info list + if FInfo.Count = 0 then Exit; + + //create LIST chunk + ckInfoLIST.fccType := mmioStringToFOURCCA('INFO', 0); + rc := mmioCreateChunk(FHandle, @ckInfoLIST, MMIO_CREATELIST); + ChkErr; + + //save info entries + for i:= 0 to FInfo.Count-1 do + begin + InfName := Copy(FInfo[i], 1, 4); + InfValue := Copy(FInfo[i], 6, MAXINT); + //create subchunk + ckInfoPiece.ckId := mmioStringToFOURCCA(PChar(InfName), 0); + ckInfoPiece.ckSize := Length(InfValue); + rc := mmioCreateChunk(FHandle, @ckInfoPiece, 0); + ChkErr; + //save subchunk data + rc := mmioWrite(FHandle, PChar(InfValue), Length(InfValue)); + ErrIf(rc <> Length(InfValue), 'WAV write error'); + //exit subchunk + rc := mmioAscend(FHandle, @ckInfoPiece, 0); + ChkErr; + end; + + //exit LIST + rc := mmioAscend(FHandle, @ckInfoLIST, 0); + ChkErr; +end; + + +procedure TAlWavFile.ReadInfo; +var + Data: string; + ckInfoLIST: TMmckInfo; + InfName: string; + InfValue: string; + Len: integer; +begin + FInfo.Clear; + //descend into LIST/INFO + ckInfoLIST.fccType := mmioStringToFOURCCA('INFO', 0); + rc := mmioDescend(FHandle, @ckInfoLIST, @ckInfoRIFF, MMIO_FINDLIST); + try + if rc <> MMSYSERR_NOERROR then Exit; + //read info + SetLength(Data, ckInfoLIST.cksize - 4 {4-char list type}); + rc := mmioRead(FHandle, @Data[1], Length(Data)); + ErrIf(rc <> Length(Data), 'Unable to read header'); + //exit LIST + rc := mmioAscend(FHandle, @ckInfoLIST, 0); + ChkErr; + finally + //always rewind + mmioSeek(FHandle, ckInfoRIFF.dwDataOffset + 4, SEEK_SET); + end; + + //parse info + while Length(Data) > 8 {4 for chunk ID and 4 for length} do + begin + InfName := Copy(Data, 1, 4); + Len := PInteger(@Data[5])^; + InfValue := Copy(Data, 9, Len); + Delete(Data, 1, 8+Len); + if Copy(Data, 1, 1) = #0 then Delete(Data, 1, 1); //padded byte + FInfo.Add(InfName + '=' + InfValue); + end; +end; + + + + + + + +//------------------------------------------------------------------------------ +// Error checking +//------------------------------------------------------------------------------ + +procedure TAlWavFile.ChkErr; +var + Buf: array [0..MAXERRORLENGTH-1] of Char; +begin + if rc = MMSYSERR_NOERROR then Exit; + + if waveInGetErrorText(rc, Buf, MAXERRORLENGTH) = MMSYSERR_NOERROR + then raise Exception.Create(Buf) + else raise Exception.Create('Unknown error: ' + IntToStr(rc)); +end; + + +procedure TAlWavFile.ErrIf(IsErr: boolean; Msg: string); +begin + if IsErr then raise Exception.Create(Msg); +end; + + +procedure TAlWavFile.ChkNotOpen; +begin + ErrIf(FIsOpen, 'Cannot change parameter when the file is open'); +end; + + + + +procedure TAlWavFile.NormalizeData; +var + i: integer; + Mx: Single; +begin + //find max in L + Mx := 0; + if FLData <> nil then + for i:=0 to High(FLData) do + if Abs(FLData[i]) > Mx then Mx := Abs(FLData[i]); + //find max in R + if FRData <> nil then + for i:=0 to High(FRData) do + if Abs(FRData[i]) > Mx then Mx := Abs(FRData[i]); + //scale + if Mx > 0 then + begin + Mx := 32767 / Mx; + if FLData <> nil then + for i:=0 to High(FLData) do FLData[i] := FLData[i] * Mx; + if FRData <> nil then + for i:=0 to High(FRData) do FRData[i] := FRData[i] * Mx; + end; +end; + + +end. From ea2bb5f2f3f01fcb69a2789e8597d718b60c89a2 Mon Sep 17 00:00:00 2001 From: Alex Shovkoplyas Date: Wed, 25 Nov 2015 14:59:20 -0500 Subject: [PATCH 2/2] Remove unfinished changes --- Contest.pas | 8 ++++---- DxOper.pas | 8 +++----- Ini.pas | 3 +-- Log.pas | 6 +++--- Main.dfm | 1 + Main.pas | 8 ++++---- MyStn.pas | 2 +- Qsb.pas | 2 +- RndFunc.pas | 4 ++-- Station.pas | 5 ++--- VCL/Mixers.pas | 2 +- 11 files changed, 23 insertions(+), 26 deletions(-) diff --git a/Contest.pas b/Contest.pas index 3c1cbab..ff54ab7 100644 --- a/Contest.pas +++ b/Contest.pas @@ -54,7 +54,7 @@ constructor TContest.Create; Modul := TModulator.Create; Agc := TVolumeControl.Create(nil); - Filt.Points := Round(0.7 * 11025 / Ini.BandWidth); + Filt.Points := Round(0.7 * DEFAULTRATE / Ini.BandWidth); Filt.Passes := 3; Filt.SamplesInInput := Ini.BufSize; Filt.GainDb := 10 * Log10(500/Ini.Bandwidth); @@ -64,7 +64,7 @@ constructor TContest.Create; Filt2.SamplesInInput := Filt.SamplesInInput; Filt2.GainDb := Filt.GainDb; - Modul.SamplesPerSec := 11025; + Modul.SamplesPerSec := DEFAULTRATE; Modul.CarrierFreq := Ini.Pitch; Agc.NoiseInDb := 76; @@ -140,14 +140,14 @@ function TContest.GetAudio: TSingleArray; Blk := Stations[Stn].GetBlock; for i:=0 to High(Blk) do begin - Bfo := Stations[Stn].Bfo - RitPhase - i * TWO_PI * Ini.Rit / 11025; + Bfo := Stations[Stn].Bfo - RitPhase - i * TWO_PI * Ini.Rit / DEFAULTRATE; ReIm.Re[i] := ReIm.Re[i] + Blk[i] * Cos(Bfo); ReIm.Im[i] := ReIm.Im[i] - Blk[i] * Sin(Bfo); end; end; //Rit - RitPhase := RitPhase + Ini.BufSize * TWO_PI * Ini.Rit / 11025; + RitPhase := RitPhase + Ini.BufSize * TWO_PI * Ini.Rit / DEFAULTRATE; while RitPhase > TWO_PI do RitPhase := RitPhase - TWO_PI; while RitPhase < -TWO_PI do RitPhase := RitPhase + TWO_PI; diff --git a/DxOper.pas b/DxOper.pas index f1e446d..14f7510 100644 --- a/DxOper.pas +++ b/DxOper.pas @@ -33,7 +33,7 @@ TDxOperator = class function GetSendDelay: integer; function GetReplyTimeout: integer; function GetWpm: integer; - function GetNR: string; + function GetNR: integer; procedure MsgReceived(AMsg: TStationMessages); procedure SetState(AState: TOperatorState); function GetReply: TStationMessage; @@ -71,11 +71,9 @@ function TDxOperator.GetWpm: integer; else Result := Round(Ini.Wpm * 0.5 * (1 + Random)); end; -function TDxOperator.GetNR: string; +function TDxOperator.GetNR: integer; begin - if RunMode = rmCustom - then - else Result := IntToStr(1 + Round(Random * Tst.Minute * Skills)); + Result := 1 + Round(Random * Tst.Minute * Skills); end; function TDxOperator.GetReplyTimeout: integer; diff --git a/Ini.pas b/Ini.pas index 848c371..89b5043 100644 --- a/Ini.pas +++ b/Ini.pas @@ -22,8 +22,7 @@ interface type - TRunMode = (rmStop, rmPileup, rmSingle, rmWpx, rmHst, rmCustom); - + TRunMode = (rmStop, rmPileup, rmSingle, rmWpx, rmHst); var Call: string = 'VE3NEA'; diff --git a/Log.pas b/Log.pas index 88cc401..a69c2a7 100644 --- a/Log.pas +++ b/Log.pas @@ -28,7 +28,7 @@ TQso = record T: TDateTime; Call, TrueCall: string; Rst, TrueRst: integer; - Nr, TrueNr: string; + Nr, TrueNr: integer; Pfx: string; Dupe: boolean; Err: string; @@ -222,7 +222,7 @@ procedure SaveQso; Qso.T := BlocksToSeconds(Tst.BlockNumber) / 86400; Qso.Call := StringReplace(Edit1.Text, '?', '', [rfReplaceAll]); Qso.Rst := StrToInt(Edit2.Text); - Qso.Nr := Trim(Edit3.Text); + Qso.Nr := StrToInt(Edit3.Text); Qso.Pfx := ExtractPrefix(Qso.Call); {if PfxList.Find(Qso.Pfx, Idx) then Qso.Pfx := '' else }PfxList.Add(Qso.Pfx); if Ini.RunMode = rmHst then Qso.Pfx := IntToStr(CallToScore(Qso.Call)); @@ -252,7 +252,7 @@ procedure SaveQso; //wipe MainForm.WipeBoxes; //inc NR - Tst.Me.NR := IntToStr(StrToInt(Tst.Me.NR) + 1); + Inc(Tst.Me.NR); end; diff --git a/Main.dfm b/Main.dfm index fa9f0f7..65f7904 100644 --- a/Main.dfm +++ b/Main.dfm @@ -772,6 +772,7 @@ object MainForm: TMainForm end end object AlSoundOut1: TAlSoundOut + SamplesPerSec = 11025 BufCount = 8 OnBufAvailable = AlSoundOut1BufAvailable Left = 384 diff --git a/Main.pas b/Main.pas index ac0b538..cd5e380 100644 --- a/Main.pas +++ b/Main.pas @@ -295,7 +295,7 @@ procedure TMainForm.FormCreate(Sender: TObject); FromIni; MakeKeyer; - Keyer.Rate := 11025; + Keyer.Rate := DEFAULTRATE; Keyer.BufSize := Ini.BufSize; Panel2.DoubleBuffered := true; @@ -582,7 +582,7 @@ procedure TMainForm.SetBw(BwNo: integer); Ini.Bandwidth := 100 + BwNo * 50; ComboBox2.ItemIndex := BwNo; - Tst.Filt.Points := Round(0.7 * 11025 / Ini.BandWidth); + Tst.Filt.Points := Round(0.7 * DEFAULTRATE / Ini.BandWidth); Tst.Filt.GainDb := 10 * Log10(500/Ini.Bandwidth); Tst.Filt2.Points := Tst.Filt.Points; Tst.Filt2.GainDb := Tst.Filt.GainDb; @@ -725,7 +725,7 @@ procedure TMainForm.EnableCtl(Ctl: TWinControl; AEnable: boolean); procedure TMainForm.Run(Value: TRunMode); const Title: array[TRunMode] of string = - ('', 'Pile-Up', 'Single Calls', 'COMPETITION', 'H S T', 'Custom'); + ('', 'Pile-Up', 'Single Calls', 'COMPETITION', 'H S T'); var BCompet, BStop: boolean; begin @@ -812,7 +812,7 @@ procedure TMainForm.Run(Value: TRunMode); begin Tst.Me.AbortSend; Tst.BlockNumber := 0; - Tst.Me.Nr := '1'; + Tst.Me.Nr := 1; Log.Clear; WipeBoxes; RichEdit1.Visible := true; diff --git a/MyStn.pas b/MyStn.pas index f287a94..7258d6c 100644 --- a/MyStn.pas +++ b/MyStn.pas @@ -53,7 +53,7 @@ destructor TMyStation.Destroy; procedure TMyStation.Init; begin MyCall := Ini.Call; - NR := '1'; + NR := 1; RST := 599; Pitch := Ini.Pitch; Wpm := Ini.Wpm; diff --git a/Qsb.pas b/Qsb.pas index 041148e..939efd9 100644 --- a/Qsb.pas +++ b/Qsb.pas @@ -50,7 +50,7 @@ procedure TQsb.SetBandwidth(const Value: Single); i: integer; begin FBandwidth := Value; - Filt.Points := Ceil(0.37 * 11025 / ((Ini.BufSize div 4) * Value)); + Filt.Points := Ceil(0.37 * DEFAULTRATE / ((Ini.BufSize div 4) * Value)); for i:=0 to Filt.Points*3 do FGain := NewGain; end; diff --git a/RndFunc.pas b/RndFunc.pas index d0287a1..2acfd5b 100644 --- a/RndFunc.pas +++ b/RndFunc.pas @@ -50,12 +50,12 @@ function RndRayleigh(AMean: Single): Single; function SecondsToBlocks(Sec: Single): integer; begin - Result := Round(11025 / Ini.BufSize * Sec); + Result := Round(DEFAULTRATE / Ini.BufSize * Sec); end; function BlocksToSeconds(Blocks: Single): Single; begin - Result := Blocks * Ini.BufSize / 11025; + Result := Blocks * Ini.BufSize / DEFAULTRATE; end; function RndUniform: Single; diff --git a/Station.pas b/Station.pas index 4914212..f4deac7 100644 --- a/Station.pas +++ b/Station.pas @@ -42,8 +42,7 @@ TStation = class (TCollectionItem) Envelope: TSingleArray; State: TStationState; - NR: string; - RST: integer; + NR, RST: integer; MyCall, HisCall: string; Msg: TStationMessages; @@ -169,7 +168,7 @@ procedure TStation.SendMorse(AMorse: string); procedure TStation.SetPitch(const Value: integer); begin - FPitch := 11025; + FPitch := Value; dPhi := TWO_PI * FPitch / DEFAULTRATE; end; diff --git a/VCL/Mixers.pas b/VCL/Mixers.pas index abd5b1a..e9d26a6 100644 --- a/VCL/Mixers.pas +++ b/VCL/Mixers.pas @@ -233,7 +233,7 @@ procedure TModulator.CalcSinCos; for i:=0 to Cnt-1 do begin Cs[i] := Cs[i] * FGain; - Sn[i] := Cs[i] * FGain; + Sn[i] := Sn[i] * FGain; end; end;