ew8bak/ewsdr
1
0
Fork 0
mirror of https://git.vladimir.cc/vladimir/ewsdr.git synced 2026-08-25 17:27:32 +00:00
Code Issues Packages Projects Releases Wiki Activity

Add full CAT support (serial + TCP)

Browse Source 
New units: CATEngine (Kenwood + Thetis ZZ* commands), CATSerial
(up to 4 serial ports), CATTcp (multi-client TCP server on port 4992).
MainForm wired with TCATContext callbacks reusing existing WebOn* handlers.
SettingsForm gets a new CAT tab with 4 serial port groups and TCP section.
Settings.pas extended with CAT config fields (per-device, JSON-persisted).

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
ew8bak
2026-04-26 21:46:19 +03:00
co-authored by Claude Sonnet 4.6
parent 537d288e1e
commit 36ae140cad
7 changed files with 3450 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files
CATEngine.pas
+2062
View File
File diff suppressed because it is too large Load Diff
CATSerial.pas
+275
View File
@@ -0,0 +1,275 @@
unit CATSerial;
{
CATSerial.pas — CAT через последовательные порты (до 4 штук).
Каждый порт запускает отдельный поток-слушатель, который:
1. Читает байты из COM/ttyS порта
2. Накапливает их в буфер до символа ';'
3. Передаёт команду в TCATEngine.Parse()
4. Отправляет ответ обратно в порт
Платформы:
• Linux : /dev/ttyS0..3, /dev/ttyUSB0, etc.
• Windows: COM1..COM4 (имя порта вводится вручную)
Зависимости: CATEngine, Serial (FPC fcl-serial RTL unit)
}
{$IFDEF FPC}
{$MODE Delphi}
{$ENDIF}
interface
uses
Classes, SysUtils, SyncObjs,
Serial, // FPC cross-platform serial unit
{$IFDEF MSWINDOWS}Windows,{$ENDIF}
CATEngine;
const
CAT_SERIAL_MAX_PORTS = 4;
CAT_SERIAL_BUF_SIZE = 256;
type
TCATSerialParity = (cspNone, cspOdd, cspEven);
TCATSerialConfig = record
Enabled: Boolean;
PortName: string; // e.g. '/dev/ttyS0' or 'COM1'
BaudRate: Integer; // 1200, 2400, 4800, 9600, 19200, 38400, 57600, 115200
DataBits: Integer; // 7 or 8
StopBits: Integer; // 1 or 2
Parity: TCATSerialParity;
end;
TCATSerialPort = class;
{ TCATSerialThread — per-port listener thread }
TCATSerialThread = class(TThread)
private
FOwner: TCATSerialPort;
FHandle: TSerialHandle;
FBuf: string;
procedure ProcessBuffer;
function TryOpenPort: Boolean;
protected
procedure Execute; override;
public
constructor Create(AOwner: TCATSerialPort);
end;
{ TCATSerialPort — one serial CAT port }
TCATSerialPort = class
private
FConfig: TCATSerialConfig;
FEngine: TCATEngine;
FThread: TCATSerialThread;
FHandle: TSerialHandle;
FLock: TCriticalSection;
FActive: Boolean;
public
constructor Create(AEngine: TCATEngine; const ACfg: TCATSerialConfig);
destructor Destroy; override;
procedure Start;
procedure Stop;
procedure SendStr(const S: string);
property Handle: TSerialHandle read FHandle write FHandle;
property Config: TCATSerialConfig read FConfig;
property Engine: TCATEngine read FEngine;
property Active: Boolean read FActive;
end;
{ TCATSerialManager — manages up to 4 serial ports }
TCATSerialManager = class
private
FPorts: array[0..CAT_SERIAL_MAX_PORTS-1] of TCATSerialPort;
FEngine: TCATEngine;
public
constructor Create(AEngine: TCATEngine);
destructor Destroy; override;
procedure ApplyConfig(const Configs: array of TCATSerialConfig);
procedure StopAll;
function ActiveCount: Integer;
end;
implementation
{ ── TCATSerialThread ──────────────────────────────────────────────────────── }
constructor TCATSerialThread.Create(AOwner: TCATSerialPort);
begin
FOwner := AOwner;
FBuf := '';
FreeOnTerminate := False;
inherited Create(True);
end;
function TCATSerialThread.TryOpenPort: Boolean;
var
cfg: TCATSerialConfig;
h: TSerialHandle;
par: TParityType;
begin
Result := False;
cfg := FOwner.Config;
h := SerOpen(cfg.PortName);
{$IFDEF MSWINDOWS}
if h = TSerialHandle(INVALID_HANDLE_VALUE) then Exit;
{$ELSE}
if h < 0 then Exit;
{$ENDIF}
case cfg.Parity of
cspNone: par := NoneParity;
cspOdd: par := OddParity;
cspEven: par := EvenParity;
else par := NoneParity;
end;
SerSetParams(h, cfg.BaudRate, cfg.DataBits, par, cfg.StopBits, []);
FHandle := h;
FOwner.Handle := h;
Result := True;
end;
procedure TCATSerialThread.ProcessBuffer;
var
tpos: Integer;
cmd, resp: string;
begin
repeat
tpos := Pos(';', FBuf);
if tpos = 0 then Break;
cmd := Copy(FBuf, 1, tpos);
Delete(FBuf, 1, tpos);
resp := FOwner.Engine.Parse(cmd);
if resp <> '' then
FOwner.SendStr(resp);
until tpos = 0;
// Guard against runaway buffers (no terminator seen in 256+ chars)
if Length(FBuf) > CAT_SERIAL_BUF_SIZE then FBuf := '';
end;
procedure TCATSerialThread.Execute;
var
ch: Byte;
n: LongInt;
begin
if not TryOpenPort then Exit;
try
while not Terminated do begin
n := SerReadTimeout(FHandle, ch, 50);
if n = 1 then begin
FBuf := FBuf + Chr(ch);
if ch = Ord(';') then ProcessBuffer;
end;
end;
finally
SerClose(FHandle);
FOwner.Handle := -1;
end;
end;
{ ── TCATSerialPort ────────────────────────────────────────────────────────── }
constructor TCATSerialPort.Create(AEngine: TCATEngine; const ACfg: TCATSerialConfig);
begin
inherited Create;
FEngine := AEngine;
FConfig := ACfg;
FHandle := -1;
FLock := TCriticalSection.Create;
FActive := False;
end;
destructor TCATSerialPort.Destroy;
begin
Stop;
FLock.Free;
inherited;
end;
procedure TCATSerialPort.Start;
begin
if FActive or not FConfig.Enabled then Exit;
FActive := True;
FThread := TCATSerialThread.Create(Self);
FThread.Start;
end;
procedure TCATSerialPort.Stop;
begin
if not FActive then Exit;
FActive := False;
if Assigned(FThread) then begin
FThread.Terminate;
FThread.WaitFor;
FreeAndNil(FThread);
end;
end;
procedure TCATSerialPort.SendStr(const S: string);
var buf: AnsiString;
begin
if FHandle < 0 then Exit;
FLock.Acquire;
try
buf := AnsiString(S);
SerWrite(FHandle, buf[1], Length(buf));
except
// ignore write errors (port may have been closed)
end;
FLock.Release;
end;
{ ── TCATSerialManager ─────────────────────────────────────────────────────── }
constructor TCATSerialManager.Create(AEngine: TCATEngine);
var i: Integer;
begin
inherited Create;
FEngine := AEngine;
for i := 0 to CAT_SERIAL_MAX_PORTS-1 do
FPorts[i] := nil;
end;
destructor TCATSerialManager.Destroy;
begin
StopAll;
inherited;
end;
procedure TCATSerialManager.ApplyConfig(const Configs: array of TCATSerialConfig);
var
i: Integer;
cnt: Integer;
begin
StopAll;
cnt := Length(Configs);
if cnt > CAT_SERIAL_MAX_PORTS then cnt := CAT_SERIAL_MAX_PORTS;
for i := 0 to cnt-1 do begin
FPorts[i] := TCATSerialPort.Create(FEngine, Configs[i]);
if Configs[i].Enabled then FPorts[i].Start;
end;
end;
procedure TCATSerialManager.StopAll;
var i: Integer;
begin
for i := 0 to CAT_SERIAL_MAX_PORTS-1 do begin
if Assigned(FPorts[i]) then begin
FPorts[i].Stop;
FreeAndNil(FPorts[i]);
end;
end;
end;
function TCATSerialManager.ActiveCount: Integer;
var i: Integer;
begin
Result := 0;
for i := 0 to CAT_SERIAL_MAX_PORTS-1 do
if Assigned(FPorts[i]) and FPorts[i].Active then Inc(Result);
end;
end.
CATTcp.pas
+490
View File
@@ -0,0 +1,490 @@
unit CATTcp;
{
CATTcp.pas — TCP CAT сервер (аналог TCPIPcatServer.cs из Thetis).
Архитектура:
• Один listening socket (TCATTcpServer)
• На каждое входящее соединение — отдельный поток (TCATTcpClientThread)
• Команды вида "ZZFA00014250000;" обрабатываются через TCATEngine.Parse()
• Поддержка ZZGA/ZZGR для идентификации клиентов (directed broadcast)
• Welcome-строка при подключении
Порт по умолчанию: 4992
Платформы: Linux / Windows (через WebUtils.SockClose/SockShutdown).
}
{$IFDEF FPC}
{$MODE Delphi}
{$ENDIF}
interface
uses
Classes, SysUtils, SyncObjs,
WebUtils, // SockClose, SockShutdown, SOCK_INVALID
{$IFDEF MSWINDOWS}
Windows, WinSock2
{$ELSE}
BaseUnix, Sockets
{$ENDIF},
CATEngine;
const
CAT_TCP_DEFAULT_PORT = 4992;
CAT_TCP_BUF_SIZE = 4096;
CAT_TCP_WELCOME = '#EWSDR CAT TCP Server;';
type
TCATTcpServer = class;
{ TCATTcpClientThread — один поток на TCP клиента }
TCATTcpClientThread = class(TThread)
private
FServer: TCATTcpServer;
FSocket: TSocket;
FBuf: string;
FClientIds: TStringList;
FIdLock: TCriticalSection;
FMarkDelete: Boolean;
procedure ProcessBuffer;
procedure SendStr(const S: string);
procedure HandleCmd(const Cmd: string);
procedure AddClientId(const Id: string);
procedure RemoveClientId(const Id: string);
protected
procedure Execute; override;
public
constructor Create(AServer: TCATTcpServer; ASocket: TSocket);
destructor Destroy; override;
procedure SendData(const Msg: string; const IdLimit: TStringList = nil);
function IsMarkedForDelete: Boolean;
procedure Disconnect;
end;
{ TCATTcpServer }
TCATTcpServer = class
private
FEngine: TCATEngine;
FPort: Integer;
FListenSock: TSocket;
FServerThread: TThread;
FPurgeThread: TThread;
FClients: TList;
FClientsLock: TCriticalSection;
FRunning: Boolean;
FSendWelcome: Boolean;
FLastError: string;
procedure ServerLoop;
procedure PurgeLoop;
function InitListen: Boolean;
public
constructor Create(AEngine: TCATEngine; APort: Integer = CAT_TCP_DEFAULT_PORT);
destructor Destroy; override;
procedure Start;
procedure Stop;
procedure Broadcast(const Msg: string; const IdLimit: TStringList = nil);
function ClientCount: Integer;
property Port: Integer read FPort write FPort;
property SendWelcome: Boolean read FSendWelcome write FSendWelcome;
property Running: Boolean read FRunning;
property LastError: string read FLastError;
end;
implementation
{ ── internal thread wrappers ─────────────────────────────────────────────── }
type
TServerThread = class(TThread)
private FServer: TCATTcpServer;
protected procedure Execute; override;
public constructor Create(S: TCATTcpServer);
end;
TPurgeThread = class(TThread)
private FServer: TCATTcpServer;
protected procedure Execute; override;
public constructor Create(S: TCATTcpServer);
end;
constructor TServerThread.Create(S: TCATTcpServer);
begin FServer := S; FreeOnTerminate := False; inherited Create(True); end;
procedure TServerThread.Execute; begin FServer.ServerLoop; end;
constructor TPurgeThread.Create(S: TCATTcpServer);
begin FServer := S; FreeOnTerminate := False; inherited Create(True); end;
procedure TPurgeThread.Execute; begin FServer.PurgeLoop; end;
{ ── TCATTcpClientThread ───────────────────────────────────────────────────── }
constructor TCATTcpClientThread.Create(AServer: TCATTcpServer; ASocket: TSocket);
begin
FServer := AServer;
FSocket := ASocket;
FBuf := '';
FMarkDelete := False;
FClientIds := TStringList.Create;
FIdLock := TCriticalSection.Create;
FreeOnTerminate := False;
inherited Create(True);
end;
destructor TCATTcpClientThread.Destroy;
begin
FClientIds.Free;
FIdLock.Free;
inherited;
end;
procedure TCATTcpClientThread.AddClientId(const Id: string);
var lo: string;
begin
lo := LowerCase(Id);
FIdLock.Acquire;
try
if FClientIds.IndexOf(lo) < 0 then FClientIds.Add(lo);
finally FIdLock.Release; end;
end;
procedure TCATTcpClientThread.RemoveClientId(const Id: string);
var lo: string; idx: Integer;
begin
lo := LowerCase(Id);
FIdLock.Acquire;
try
idx := FClientIds.IndexOf(lo);
if idx >= 0 then FClientIds.Delete(idx);
finally FIdLock.Release; end;
end;
procedure TCATTcpClientThread.SendStr(const S: string);
var
buf: AnsiString;
n: Integer;
begin
if FSocket = SOCK_INVALID then Exit;
buf := AnsiString(S);
if Length(buf) = 0 then Exit;
{$IFDEF MSWINDOWS}
n := send(FSocket, buf[1], Length(buf), 0);
if n = SOCKET_ERROR then begin
{$ELSE}
n := fpSend(FSocket, @buf[1], Length(buf), 0);
if n <= 0 then begin
{$ENDIF}
FMarkDelete := True;
Terminate;
end;
end;
procedure TCATTcpClientThread.HandleCmd(const Cmd: string);
const
ZZGA_PFX = 'ZZGA';
ZZGR_PFX = 'ZZGR';
var
cmd2, guid, resp: string;
begin
cmd2 := Trim(Cmd);
if cmd2 = '' then Exit;
if (Length(cmd2) >= 4) and (UpperCase(Copy(cmd2, 1, 4)) = ZZGA_PFX) then begin
if Length(cmd2) >= 40 then begin // 4 + 36
guid := LowerCase(Copy(cmd2, 5, 36));
AddClientId(guid);
SendStr(ZZGA_PFX + guid + ';');
end else
SendStr('?;');
end else if (Length(cmd2) >= 4) and (UpperCase(Copy(cmd2, 1, 4)) = ZZGR_PFX) then begin
if Length(cmd2) >= 40 then begin
guid := LowerCase(Copy(cmd2, 5, 36));
RemoveClientId(guid);
SendStr(ZZGR_PFX + guid + ';');
end else
SendStr('?;');
end else begin
resp := FServer.FEngine.Parse(cmd2);
if resp <> '' then SendStr(resp);
end;
end;
procedure TCATTcpClientThread.ProcessBuffer;
var tpos: Integer; msg: string;
begin
repeat
tpos := Pos(';', FBuf);
if tpos = 0 then Break;
msg := Copy(FBuf, 1, tpos);
Delete(FBuf, 1, tpos);
HandleCmd(msg);
until tpos = 0;
if Length(FBuf) > 1024 then FBuf := '';
end;
procedure TCATTcpClientThread.Execute;
var
rawbuf: array[0..CAT_TCP_BUF_SIZE-1] of Byte;
n: Integer;
chunk: AnsiString;
begin
if FServer.SendWelcome then
SendStr(CAT_TCP_WELCOME);
while not Terminated do begin
{$IFDEF MSWINDOWS}
n := recv(FSocket, rawbuf[0], CAT_TCP_BUF_SIZE, 0);
if n = SOCKET_ERROR then begin FMarkDelete := True; Break; end;
{$ELSE}
n := fpRecv(FSocket, @rawbuf[0], CAT_TCP_BUF_SIZE, 0);
if n <= 0 then begin FMarkDelete := True; Break; end;
{$ENDIF}
SetLength(chunk, n);
Move(rawbuf[0], chunk[1], n);
FBuf := FBuf + string(chunk);
ProcessBuffer;
end;
SockShutdown(FSocket);
SockClose(FSocket);
FSocket := SOCK_INVALID;
end;
procedure TCATTcpClientThread.SendData(const Msg: string; const IdLimit: TStringList);
var
i: Integer;
send: Boolean;
begin
if IdLimit = nil then begin
SendStr(Msg);
Exit;
end;
send := False;
FIdLock.Acquire;
try
for i := 0 to FClientIds.Count-1 do
if IdLimit.IndexOf(FClientIds[i]) >= 0 then begin
send := True;
Break;
end;
finally FIdLock.Release; end;
if send then SendStr(Msg);
end;
function TCATTcpClientThread.IsMarkedForDelete: Boolean;
begin Result := FMarkDelete; end;
procedure TCATTcpClientThread.Disconnect;
begin
Terminate;
SockShutdown(FSocket);
end;
{ ── TCATTcpServer ─────────────────────────────────────────────────────────── }
constructor TCATTcpServer.Create(AEngine: TCATEngine; APort: Integer);
{$IFDEF MSWINDOWS}
var wsa: TWSAData;
{$ENDIF}
begin
inherited Create;
FEngine := AEngine;
FPort := APort;
FListenSock := SOCK_INVALID;
FClients := TList.Create;
FClientsLock := TCriticalSection.Create;
FRunning := False;
FSendWelcome := True;
FLastError := '';
{$IFDEF MSWINDOWS}
WSAStartup($0202, wsa);
{$ENDIF}
end;
destructor TCATTcpServer.Destroy;
begin
Stop;
FClients.Free;
FClientsLock.Free;
{$IFDEF MSWINDOWS}
WSACleanup;
{$ENDIF}
inherited;
end;
function TCATTcpServer.InitListen: Boolean;
var
Addr: {$IFDEF MSWINDOWS}TSockAddrIn{$ELSE}TInetSockAddr{$ENDIF};
One: Integer;
begin
Result := False;
{$IFDEF MSWINDOWS}
FListenSock := socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
{$ELSE}
FListenSock := fpSocket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
{$ENDIF}
if FListenSock = SOCK_INVALID then begin
FLastError := 'Cannot create socket';
Exit;
end;
One := 1;
FillChar(Addr, SizeOf(Addr), 0);
Addr.sin_family := AF_INET;
Addr.sin_port := htons(FPort);
{$IFDEF MSWINDOWS}
setsockopt(FListenSock, SOL_SOCKET, SO_REUSEADDR, PChar(@One), SizeOf(One));
Addr.sin_addr.S_addr := INADDR_ANY;
if bind(FListenSock, @Addr, SizeOf(Addr)) = SOCKET_ERROR then begin
FLastError := 'bind failed';
SockClose(FListenSock); FListenSock := SOCK_INVALID; Exit;
end;
if listen(FListenSock, 8) = SOCKET_ERROR then begin
FLastError := 'listen failed';
SockClose(FListenSock); FListenSock := SOCK_INVALID; Exit;
end;
{$ELSE}
fpSetSockOpt(FListenSock, SOL_SOCKET, SO_REUSEADDR, @One, SizeOf(One));
Addr.sin_addr.s_addr := htonl(INADDR_ANY);
if fpBind(FListenSock, @Addr, SizeOf(Addr)) <> 0 then begin
FLastError := 'bind failed on port ' + IntToStr(FPort);
SockClose(FListenSock); FListenSock := SOCK_INVALID; Exit;
end;
if fpListen(FListenSock, 8) <> 0 then begin
FLastError := 'listen failed';
SockClose(FListenSock); FListenSock := SOCK_INVALID; Exit;
end;
{$ENDIF}
Result := True;
end;
procedure TCATTcpServer.Start;
begin
if FRunning then Exit;
if not InitListen then Exit;
FRunning := True;
FServerThread := TServerThread.Create(Self);
TServerThread(FServerThread).Start;
FPurgeThread := TPurgeThread.Create(Self);
TPurgeThread(FPurgeThread).Start;
end;
procedure TCATTcpServer.Stop;
var
i: Integer;
cli: TCATTcpClientThread;
begin
if not FRunning then Exit;
FRunning := False;
if FListenSock <> SOCK_INVALID then begin
SockShutdown(FListenSock);
SockClose(FListenSock);
FListenSock := SOCK_INVALID;
end;
if Assigned(FServerThread) then begin
FServerThread.Terminate;
FServerThread.WaitFor;
FreeAndNil(FServerThread);
end;
if Assigned(FPurgeThread) then begin
FPurgeThread.Terminate;
FPurgeThread.WaitFor;
FreeAndNil(FPurgeThread);
end;
FClientsLock.Acquire;
try
for i := 0 to FClients.Count-1 do begin
cli := TCATTcpClientThread(FClients[i]);
cli.Disconnect;
cli.WaitFor;
cli.Free;
end;
FClients.Clear;
finally FClientsLock.Release; end;
end;
procedure TCATTcpServer.ServerLoop;
var
cli: TCATTcpClientThread;
clientSock: TSocket;
clientAddr: {$IFDEF MSWINDOWS}TSockAddrIn{$ELSE}TInetSockAddr{$ENDIF};
addrLen: {$IFDEF MSWINDOWS}Integer{$ELSE}TSockLen{$ENDIF};
begin
addrLen := SizeOf(clientAddr);
while FRunning do begin
{$IFDEF MSWINDOWS}
clientSock := accept(FListenSock, @clientAddr, @addrLen);
if clientSock = INVALID_SOCKET then Break;
{$ELSE}
clientSock := fpAccept(FListenSock, @clientAddr, @addrLen);
if clientSock = SOCK_INVALID then Break;
{$ENDIF}
if not FRunning then begin SockClose(clientSock); Break; end;
cli := TCATTcpClientThread.Create(Self, clientSock);
FClientsLock.Acquire;
try FClients.Add(cli);
finally FClientsLock.Release; end;
cli.Start;
end;
end;
procedure TCATTcpServer.PurgeLoop;
var
i: Integer;
cli: TCATTcpClientThread;
del: TList;
begin
del := TList.Create;
try
while FRunning do begin
Sleep(5000);
del.Clear;
FClientsLock.Acquire;
try
for i := FClients.Count-1 downto 0 do begin
cli := TCATTcpClientThread(FClients[i]);
if cli.IsMarkedForDelete then begin
del.Add(cli);
FClients.Delete(i);
end;
end;
finally FClientsLock.Release; end;
for i := 0 to del.Count-1 do begin
cli := TCATTcpClientThread(del[i]);
cli.WaitFor;
cli.Free;
end;
end;
finally del.Free; end;
end;
procedure TCATTcpServer.Broadcast(const Msg: string; const IdLimit: TStringList);
var
i: Integer;
cli: TCATTcpClientThread;
begin
FClientsLock.Acquire;
try
for i := 0 to FClients.Count-1 do begin
cli := TCATTcpClientThread(FClients[i]);
if not cli.IsMarkedForDelete then
cli.SendData(Msg, IdLimit);
end;
finally FClientsLock.Release; end;
end;
function TCATTcpServer.ClientCount: Integer;
var i: Integer;
begin
Result := 0;
FClientsLock.Acquire;
try
for i := 0 to FClients.Count-1 do
if not TCATTcpClientThread(FClients[i]).IsMarkedForDelete then Inc(Result);
finally FClientsLock.Release; end;
end;
end.
MainForm.pas
+308 -1
View File
@@ -29,7 +29,8 @@ uses
WDSP, WDSPEngine, AudioOutput, AudioInput,
IntfGraphics, FPImage,
Settings,
WebServer;
WebServer,
CATEngine, CATSerial, CATTcp;
const
CLR_BG = TColor($00101010);
@@ -286,6 +287,12 @@ type
// --- Settings ---
FSettings: TSettingsManager;
FWebServer: TWebServer; // веб-интерфейс (порт 8080)
// --- CAT ---
FCATEngine: TCATEngine;
FCATSerial: TCATSerialManager;
FCATTcp: TCATTcpServer;
FCATSyncFreq: Double;
FCATLastGlobal: TGlobalSettings; // текущие CAT-настройки (для сохранения)
// Временные поля для передачи параметров в Synchronize-методы
FWebSyncFreq: Double;
FWebSyncInt: Integer;
@@ -532,6 +539,45 @@ type
procedure SyncWebCenter;
procedure SyncWebMOX;
procedure SyncWebDrive;
// --- CAT callbacks -------------------------------------------------------
function CATGetVfoA: Double;
function CATGetVfoB: Double;
function CATGetMode: Integer;
function CATGetActiveVfo: Integer;
function CATGetAGCMode: Integer;
function CATGetVolume: Integer;
function CATGetDriveLevel: Integer;
function CATGetFilterIdx: Integer;
function CATGetFilterBW: Integer;
function CATGetNRMode: Integer;
function CATGetNBMode: Integer;
function CATGetSNB: Boolean;
function CATGetANF: Boolean;
function CATGetTX: Boolean;
function CATGetRunning: Boolean;
function CATGetSMeter: Double;
function CATGetBand: Integer;
procedure CATSetVfoA(V: Double);
procedure CATSetVfoB(V: Double);
procedure CATSetFilterIdx(V: Integer);
procedure CATDoBandUp;
procedure CATDoBandDown;
procedure CATDoTuneUp;
procedure CATDoTuneDown;
procedure SyncCATVfoA;
procedure SyncCATVfoB;
procedure SyncCATBandUp;
procedure SyncCATBandDown;
procedure SyncCATTuneUp;
procedure SyncCATTuneDown;
procedure InitCATEngine;
procedure CATApplySettings(const G: TGlobalSettings);
procedure OnCATSettingsChange(
const SerEnabled: array of Boolean;
const SerPort: array of string;
const SerBaud, SerDataBits, SerStopBits, SerParity: array of Integer;
TcpEnabled: Boolean; TcpPort: Integer);
// -------------------------------------------------------------------------
procedure BtnWfAGCClick(Sender: TObject);
procedure BtnWfNFClick(Sender: TObject);
procedure BtnHidePanelClick(Sender: TObject);
@@ -974,6 +1020,15 @@ begin
// Audio device names
Result.AudioOutDevice := FAudioOutDevName;
Result.AudioInDevice := FAudioInDevName;
// CAT settings — carried from the last loaded/saved device config
Result.CATSerialEnabled := FCATLastGlobal.CATSerialEnabled;
Result.CATSerialPort := FCATLastGlobal.CATSerialPort;
Result.CATSerialBaud := FCATLastGlobal.CATSerialBaud;
Result.CATSerialDataBits := FCATLastGlobal.CATSerialDataBits;
Result.CATSerialStopBits := FCATLastGlobal.CATSerialStopBits;
Result.CATSerialParity := FCATLastGlobal.CATSerialParity;
Result.CATTcpEnabled := FCATLastGlobal.CATTcpEnabled;
Result.CATTcpPort := FCATLastGlobal.CATTcpPort;
end;
procedure TMainForm.SaveCurrentBand;
@@ -1159,6 +1214,8 @@ begin
FWebServer.OnMOX := WebOnMOX;
FWebServer.OnDrive := WebOnDrive;
FWebServer.Start;
FillChar(FCATLastGlobal, SizeOf(FCATLastGlobal), 0);
InitCATEngine;
FSMeterPeak := -130;
FSMeterMin := -130;
FSMeterAvg := -130;
@@ -1298,6 +1355,9 @@ begin
FSettings.Free;
FWebServer.Stop;
FWebServer.Free;
if Assigned(FCATTcp) then begin FCATTcp.Stop; FreeAndNil(FCATTcp); end;
if Assigned(FCATSerial) then begin FCATSerial.StopAll; FreeAndNil(FCATSerial); end;
FreeAndNil(FCATEngine);
end;
procedure TMainForm.FormClose(Sender: TObject; var CloseAction: TCloseAction);
@@ -3909,6 +3969,8 @@ begin
Move(FNetwork.Device.MAC[0], FDevMAC[0], 6);
FDevConnected := True;
FSettings.LoadDevice(FDevMAC, G_Settings, FBandCache);
FCATLastGlobal := G_Settings;
CATApplySettings(G_Settings);
FVolume := G_Settings.Volume;
FActiveVfo := G_Settings.ActiveVfo;
// PA settings
@@ -5790,9 +5852,19 @@ begin
SF.OnVisibilityChange := ApplyVisibility;
SF.OnFPSChange := ApplyFPS;
SF.OnPAChange := OnPASettingsChange;
SF.OnCATChange := OnCATSettingsChange;
end;
SF := TSettingsForm(FSettingsForm);
SF.LoadPASettings(FPAMaxPower, FPABandCal);
SF.LoadCATSettings(
FCATLastGlobal.CATSerialEnabled,
FCATLastGlobal.CATSerialPort,
FCATLastGlobal.CATSerialBaud,
FCATLastGlobal.CATSerialDataBits,
FCATLastGlobal.CATSerialStopBits,
FCATLastGlobal.CATSerialParity,
FCATLastGlobal.CATTcpEnabled,
FCATLastGlobal.CATTcpPort);
// Перечисляем PA устройства
SF.RefreshAudioDevices(FAudioOut, FAudioIn);
SF.LoadVisibility(FShowSpectrum, FShowWaterfall);
@@ -5841,5 +5913,240 @@ begin
EnsureWDSPWisdom;
end;
// ===========================================================================
// CAT subsystem
// ===========================================================================
procedure TMainForm.InitCATEngine;
var
Ctx: TCATContext;
begin
FillChar(Ctx, SizeOf(Ctx), 0);
Ctx.GetVfoA := CATGetVfoA;
Ctx.GetVfoB := CATGetVfoB;
Ctx.GetMode := CATGetMode;
Ctx.GetActiveVfo := CATGetActiveVfo;
Ctx.GetAGCMode := CATGetAGCMode;
Ctx.GetVolume := CATGetVolume;
Ctx.GetDriveLevel := CATGetDriveLevel;
Ctx.GetFilterIdx := CATGetFilterIdx;
Ctx.GetFilterBW := CATGetFilterBW;
Ctx.GetNRMode := CATGetNRMode;
Ctx.GetNBMode := CATGetNBMode;
Ctx.GetSNBEnabled := CATGetSNB;
Ctx.GetANFEnabled := CATGetANF;
Ctx.GetTransmitting := CATGetTX;
Ctx.GetRunning := CATGetRunning;
Ctx.GetSMeter := CATGetSMeter;
Ctx.GetCurrentBand := CATGetBand;
Ctx.SetVfoA := CATSetVfoA;
Ctx.SetVfoB := CATSetVfoB;
Ctx.SetMode := WebOnMode;
Ctx.SetActiveVfo := WebOnActiveVfo;
Ctx.SetAGCMode := WebOnAGC;
Ctx.SetVolume := WebOnVolume;
Ctx.SetDriveLevel := WebOnDrive;
Ctx.SetFilterIdx := CATSetFilterIdx;
Ctx.SetNRMode := WebOnNR;
Ctx.SetNBMode := WebOnNB;
Ctx.SetSNBEnabled := WebOnSNB;
Ctx.SetANFEnabled := WebOnANF;
Ctx.SetTransmitting := WebOnMOX;
Ctx.DoBandUp := CATDoBandUp;
Ctx.DoBandDown := CATDoBandDown;
Ctx.DoTuneUp := CATDoTuneUp;
Ctx.DoTuneDown := CATDoTuneDown;
Ctx.DoBandByIndex := WebOnBand;
FCATEngine := TCATEngine.Create(Ctx);
FCATSerial := TCATSerialManager.Create(FCATEngine);
FCATTcp := TCATTcpServer.Create(FCATEngine);
end;
procedure TMainForm.CATApplySettings(const G: TGlobalSettings);
var
Cfgs: array[0..3] of TCATSerialConfig;
i: Integer;
begin
for i := 0 to 3 do
begin
Cfgs[i].Enabled := G.CATSerialEnabled[i];
Cfgs[i].PortName := G.CATSerialPort[i];
Cfgs[i].BaudRate := G.CATSerialBaud[i];
Cfgs[i].DataBits := G.CATSerialDataBits[i];
Cfgs[i].StopBits := G.CATSerialStopBits[i];
case G.CATSerialParity[i] of
1: Cfgs[i].Parity := cspOdd;
2: Cfgs[i].Parity := cspEven;
else Cfgs[i].Parity := cspNone;
end;
end;
FCATSerial.ApplyConfig(Cfgs);
FCATTcp.Stop;
if G.CATTcpEnabled then
begin
FCATTcp.Port := G.CATTcpPort;
FCATTcp.Start;
end;
end;
procedure TMainForm.OnCATSettingsChange(
const SerEnabled: array of Boolean;
const SerPort: array of string;
const SerBaud, SerDataBits, SerStopBits, SerParity: array of Integer;
TcpEnabled: Boolean; TcpPort: Integer);
var i: Integer;
begin
for i := 0 to 3 do
begin
if i <= High(SerEnabled) then FCATLastGlobal.CATSerialEnabled[i] := SerEnabled[i];
if i <= High(SerPort) then FCATLastGlobal.CATSerialPort[i] := SerPort[i];
if i <= High(SerBaud) then FCATLastGlobal.CATSerialBaud[i] := SerBaud[i];
if i <= High(SerDataBits) then FCATLastGlobal.CATSerialDataBits[i] := SerDataBits[i];
if i <= High(SerStopBits) then FCATLastGlobal.CATSerialStopBits[i] := SerStopBits[i];
if i <= High(SerParity) then FCATLastGlobal.CATSerialParity[i] := SerParity[i];
end;
FCATLastGlobal.CATTcpEnabled := TcpEnabled;
FCATLastGlobal.CATTcpPort := TcpPort;
CATApplySettings(FCATLastGlobal);
if FDevConnected then begin
FSettings.SaveGlobal(FDevMAC, MakeGlobalSettings);
FSettings.Save;
end;
end;
// --- Getters (called from CAT thread — read only, no sync needed) -----------
function TMainForm.CATGetVfoA: Double; begin Result := FVfoA; end;
function TMainForm.CATGetVfoB: Double; begin Result := FVfoB; end;
function TMainForm.CATGetMode: Integer; begin Result := FMode; end;
function TMainForm.CATGetActiveVfo: Integer; begin Result := FActiveVfo; end;
function TMainForm.CATGetAGCMode: Integer; begin Result := FAGCMode; end;
function TMainForm.CATGetVolume: Integer; begin Result := FVolume; end;
function TMainForm.CATGetDriveLevel: Integer;begin Result := TrkDrive.Position; end;
function TMainForm.CATGetFilterIdx: Integer; begin Result := FFilter; end;
function TMainForm.CATGetFilterBW: Integer; begin Result := FFilterBW; end;
function TMainForm.CATGetNRMode: Integer; begin Result := BtnNR.Tag; end;
function TMainForm.CATGetNBMode: Integer; begin Result := BtnNB.Tag; end;
function TMainForm.CATGetSNB: Boolean; begin Result := BtnSNB.Tag <> 0; end;
function TMainForm.CATGetANF: Boolean; begin Result := BtnANF.Tag <> 0; end;
function TMainForm.CATGetTX: Boolean; begin Result := FTransmitting; end;
function TMainForm.CATGetRunning: Boolean; begin Result := FRunning; end;
function TMainForm.CATGetSMeter: Double; begin Result := FLastSMeter; end;
function TMainForm.CATGetBand: Integer; begin Result := FCurrentBand; end;
// --- Setters ----------------------------------------------------------------
procedure TMainForm.CATSetVfoA(V: Double);
begin
FCATSyncFreq := V;
TThread.Synchronize(nil, SyncCATVfoA);
end;
procedure TMainForm.CATSetVfoB(V: Double);
begin
FCATSyncFreq := V;
TThread.Synchronize(nil, SyncCATVfoB);
end;
procedure TMainForm.CATSetFilterIdx(V: Integer);
begin
// WebOnFilter: negative value encodes 0-based index as -(idx+1)
WebOnFilter(-(V + 1));
end;
procedure TMainForm.CATDoBandUp;
begin TThread.Synchronize(nil, SyncCATBandUp); end;
procedure TMainForm.CATDoBandDown;
begin TThread.Synchronize(nil, SyncCATBandDown); end;
procedure TMainForm.CATDoTuneUp;
begin TThread.Synchronize(nil, SyncCATTuneUp); end;
procedure TMainForm.CATDoTuneDown;
begin TThread.Synchronize(nil, SyncCATTuneDown); end;
// --- Sync methods (run in main thread) --------------------------------------
procedure TMainForm.SyncCATVfoA;
var BandIdx: Integer;
begin
FVfoA := FCATSyncFreq;
if FActiveVfo = 0 then
begin
ApplyVfoA(Round(FVfoA));
end
else
begin
// VFO A is not active — just update display and band indicator
FreqDispA.Frequency := Round(FVfoA);
BandIdx := FreqToBandIdx(FVfoA);
if (BandIdx >= 0) and (BandIdx <> FCurrentBand) then
begin
StyleButton(BtnBand[FCurrentBand], False);
FCurrentBand := BandIdx;
StyleButton(BtnBand[FCurrentBand], True);
end;
end;
end;
procedure TMainForm.SyncCATVfoB;
var BandIdx: Integer;
begin
FVfoB := FCATSyncFreq;
FreqDispB.Frequency := Round(FVfoB);
if FActiveVfo = 1 then
begin
FCenterFreq := FVfoB;
if FWDSPReady then FDSPEngine.SetShift(0.0);
if FRunning then
FNetwork.SetRunAndFreq(True, FCenterFreq, FCenterFreq, FDriveLevel);
BandIdx := FreqToBandIdx(FVfoB);
if (BandIdx >= 0) and (BandIdx <> FCurrentBand) then
begin
StyleButton(BtnBand[FCurrentBand], False);
FCurrentBand := BandIdx;
StyleButton(BtnBand[FCurrentBand], True);
end;
FRulerLastFreq := -1.0; FRulerLastVfo := -1.0;
DrawSpectrum; PbSpectrum.Invalidate;
if PbRuler <> nil then PbRuler.Invalidate;
UpdateVfoDisplay;
end;
end;
procedure TMainForm.SyncCATBandUp;
begin
if FCurrentBand < BAND_COUNT - 1 then
WebOnBand(FCurrentBand + 1);
end;
procedure TMainForm.SyncCATBandDown;
begin
if FCurrentBand > 0 then
WebOnBand(FCurrentBand - 1);
end;
procedure TMainForm.SyncCATTuneUp;
begin
if FActiveVfo = 0 then
ApplyVfoA(Round(FVfoA) + 10)
else
begin
FCATSyncFreq := FVfoB + 10;
SyncCATVfoB;
end;
end;
procedure TMainForm.SyncCATTuneDown;
begin
if FActiveVfo = 0 then
ApplyVfoA(Round(FVfoA) - 10)
else
begin
FCATSyncFreq := FVfoB - 10;
SyncCATVfoB;
end;
end;
end.
Settings.pas
+52
View File
@@ -75,6 +75,17 @@ type
// --- PA (Power Amplifier) settings ---
PAMaxPower: Double; // максимальная выходная мощность, Вт (5..200)
PABandCal: array[0..CFG_BAND_COUNT-1] of Double; // калибровка на диапазон 38.8..100.0
// --- CAT (Computer Aided Transceiver) settings ---
// До 4 последовательных портов (Linux: /dev/ttyS0, Windows: COM1 и т.д.)
CATSerialEnabled: array[0..3] of Boolean;
CATSerialPort: array[0..3] of string; // имя порта ОС
CATSerialBaud: array[0..3] of Integer; // скорость: 1200..115200
CATSerialDataBits: array[0..3] of Integer; // 7 или 8
CATSerialStopBits: array[0..3] of Integer; // 1 или 2
CATSerialParity: array[0..3] of Integer; // 0=None, 1=Odd, 2=Even
// TCP CAT сервер (один, многоклиентский)
CATTcpEnabled: Boolean;
CATTcpPort: Integer; // порт, по умолчанию 4992
end;
TSettingsManager = class
@@ -191,6 +202,21 @@ begin
G.ShowSpectrum := True;
G.ShowWaterfall := True;
G.DisplayFPS := 60;
// CAT defaults
for i := 0 to 3 do begin
G.CATSerialEnabled[i] := False;
{$IFDEF MSWINDOWS}
G.CATSerialPort[i] := 'COM' + IntToStr(i+1);
{$ELSE}
G.CATSerialPort[i] := '/dev/ttyS' + IntToStr(i);
{$ENDIF}
G.CATSerialBaud[i] := 9600;
G.CATSerialDataBits[i] := 8;
G.CATSerialStopBits[i] := 1;
G.CATSerialParity[i] := 0; // None
end;
G.CATTcpEnabled := False;
G.CATTcpPort := 4992;
end;
constructor TSettingsManager.Create(const FilePath: string);
@@ -388,6 +414,21 @@ begin
G.PAMaxPower := JD(GObj,'pa_max_power',100.0);
for i := 0 to CFG_BAND_COUNT-1 do
G.PABandCal[i] := JD(GObj,'pa_band_cal_'+IntToStr(i),100.0);
// CAT serial settings
for i := 0 to 3 do begin
G.CATSerialEnabled[i] := JB(GObj,'cat_serial_en_'+IntToStr(i), False);
{$IFDEF MSWINDOWS}
G.CATSerialPort[i] := JS(GObj,'cat_serial_port_'+IntToStr(i), 'COM'+IntToStr(i+1));
{$ELSE}
G.CATSerialPort[i] := JS(GObj,'cat_serial_port_'+IntToStr(i), '/dev/ttyS'+IntToStr(i));
{$ENDIF}
G.CATSerialBaud[i] := JI(GObj,'cat_serial_baud_'+IntToStr(i), 9600);
G.CATSerialDataBits[i] := JI(GObj,'cat_serial_dbits_'+IntToStr(i), 8);
G.CATSerialStopBits[i] := JI(GObj,'cat_serial_sbits_'+IntToStr(i), 1);
G.CATSerialParity[i] := JI(GObj,'cat_serial_parity_'+IntToStr(i), 0);
end;
G.CATTcpEnabled := JB(GObj,'cat_tcp_enabled', False);
G.CATTcpPort := JI(GObj,'cat_tcp_port', 4992);
for i := 0 to CFG_BAND_COUNT-1 do
begin
@@ -449,6 +490,17 @@ begin
JW(O,'pa_max_power',G.PAMaxPower);
for i := 0 to CFG_BAND_COUNT-1 do
JW(O,'pa_band_cal_'+IntToStr(i),G.PABandCal[i]);
// CAT serial settings
for i := 0 to 3 do begin
JW(O,'cat_serial_en_'+IntToStr(i), G.CATSerialEnabled[i]);
JWS(O,'cat_serial_port_'+IntToStr(i),G.CATSerialPort[i]);
JW(O,'cat_serial_baud_'+IntToStr(i), G.CATSerialBaud[i]);
JW(O,'cat_serial_dbits_'+IntToStr(i),G.CATSerialDataBits[i]);
JW(O,'cat_serial_sbits_'+IntToStr(i),G.CATSerialStopBits[i]);
JW(O,'cat_serial_parity_'+IntToStr(i),G.CATSerialParity[i]);
end;
JW(O,'cat_tcp_enabled',G.CATTcpEnabled);
JW(O,'cat_tcp_port',G.CATTcpPort);
end;
procedure TSettingsManager.SaveBand(const MAC: array of Byte; BandIdx: Integer;
SettingsForm.pas
+251 -1
View File
@@ -43,6 +43,14 @@ type
TOnAudioInDevChange = procedure(DevIndex: Integer; const DevName: string) of object;
TOnVisibilityChange = procedure(ShowSpectrum, ShowWaterfall: Boolean) of object;
TOnFPSChange = procedure(FPS: Integer) of object;
TOnCATChange = procedure(
const SerEnabled: array of Boolean;
const SerPort: array of string;
const SerBaud: array of Integer;
const SerDataBits: array of Integer;
const SerStopBits: array of Integer;
const SerParity: array of Integer;
TcpEnabled: Boolean; TcpPort: Integer) of object;
{ TSettingsForm }
TSettingsForm = class(TForm)
@@ -56,12 +64,14 @@ type
FPageWaterfall: TScrollBox;
FPagePA: TScrollBox;
FPageAdvanced: TScrollBox;
FPageCAT: TScrollBox;
FNavAudio: TFlatButton;
FNavDisplay: TFlatButton;
FNavSpectrum: TFlatButton;
FNavWaterfall: TFlatButton;
FNavPA: TFlatButton;
FNavAdvanced: TFlatButton;
FNavCAT: TFlatButton;
// ---- Audio tab controls ----
FCmbRXDev: TComboBox;
@@ -96,10 +106,21 @@ type
FEdMaxPower: TSpinEdit;
FEdBandCal: array[0..10] of TFloatSpinEdit;
// ---- CAT tab controls ----
FCATSerialEn: array[0..3] of TCheckBox;
FCATSerialPort: array[0..3] of TEdit;
FCATSerialBaud: array[0..3] of TComboBox;
FCATSerialDataBits: array[0..3] of TComboBox;
FCATSerialStopBits: array[0..3] of TComboBox;
FCATSerialParity: array[0..3] of TComboBox;
FCATTcpEn: TCheckBox;
FCATTcpPort: TSpinEdit;
// ---- Close button ----
FBtnClose: TFlatButton;
// ---- Callbacks ----
FOnCATChange: TOnCATChange;
FOnPAChange: TOnPASettingsChange;
FOnDisplayChange: TOnDisplayParamChange;
FOnWaterfallChange: TOnWaterfallParamChange;
@@ -116,6 +137,7 @@ type
procedure BuildDisplayTab;
procedure BuildRX1Tab;
procedure BuildPATab;
procedure BuildCATTab;
procedure ApplyTheme;
procedure NavClick(Sender: TObject);
procedure SelectPage(APage: TWinControl; ANav: TFlatButton);
@@ -147,6 +169,9 @@ type
procedure OnFPSCmbChange(Sender: TObject);
procedure OnMaxPowerChange(Sender: TObject);
procedure OnBandCalChange(Sender: TObject);
procedure OnCATSerialChange(Sender: TObject);
procedure OnCATTcpChange(Sender: TObject);
procedure FireCATChange;
procedure BtnCloseClick(Sender: TObject);
procedure FireDisplayChange;
@@ -179,7 +204,13 @@ type
procedure LoadVisibility(ShowSpectrum, ShowWaterfall: Boolean);
procedure LoadFPS(FPS: Integer);
procedure LoadPASettings(MaxPower: Double; const BandCal: array of Double);
procedure LoadCATSettings(
const SerEnabled: array of Boolean;
const SerPort: array of string;
const SerBaud, SerDataBits, SerStopBits, SerParity: array of Integer;
TcpEnabled: Boolean; TcpPort: Integer);
property OnCATChange: TOnCATChange read FOnCATChange write FOnCATChange;
property OnPAChange: TOnPASettingsChange read FOnPAChange write FOnPAChange;
property OnDisplayChange: TOnDisplayParamChange read FOnDisplayChange write FOnDisplayChange;
property OnWaterfallChange: TOnWaterfallParamChange read FOnWaterfallChange write FOnWaterfallChange;
@@ -209,6 +240,9 @@ const
BTN_H = 24;
GRP_TITLE_H = 22; // высота заголовка в group-панелях (title label + divider)
CAT_BAUD_VALS: array[0..7] of Integer = (1200, 2400, 4800, 9600, 19200, 38400, 57600, 115200);
CAT_BAUD_NAMES: array[0..7] of string = ('1200','2400','4800','9600','19200','38400','57600','115200');
FFT_SIZES: array[0..6] of Integer = (4096, 8192, 16384, 32768, 65536, 131072, 262144);
FFT_NAMES: array[0..6] of string = ('4096','8192','16384','32768','65536','131072','262144');
@@ -391,6 +425,7 @@ begin
FNavWaterfall := MakeNavButton('Waterfall', 182);
FNavPA := MakeNavButton('Power Amplifier', 218);
FNavAdvanced := MakeNavButton('Advanced', 254);
FNavCAT := MakeNavButton('CAT', 290);
FContentPanel := TPanel.Create(Self);
FContentPanel.Parent := Self;
@@ -404,11 +439,13 @@ begin
FPageWaterfall := MakeScrollPage;
FPagePA := MakeScrollPage;
FPageAdvanced := MakeScrollPage;
FPageCAT := MakeScrollPage;
BuildAudioTab;
BuildDisplayTab;
BuildRX1Tab;
BuildPATab;
BuildCATTab;
FBtnClose := TFlatButton.Create(Self);
FBtnClose.Parent := Self;
@@ -435,7 +472,8 @@ begin
else if Sender = FNavSpectrum then SelectPage(FPageSpectrum, FNavSpectrum)
else if Sender = FNavWaterfall then SelectPage(FPageWaterfall, FNavWaterfall)
else if Sender = FNavPA then SelectPage(FPagePA, FNavPA)
else if Sender = FNavAdvanced then SelectPage(FPageAdvanced, FNavAdvanced);
else if Sender = FNavAdvanced then SelectPage(FPageAdvanced, FNavAdvanced)
else if Sender = FNavCAT then SelectPage(FPageCAT, FNavCAT);
end;
procedure TSettingsForm.SelectPage(APage: TWinControl; ANav: TFlatButton);
@@ -446,6 +484,7 @@ begin
FPageWaterfall.Visible := APage = FPageWaterfall;
FPagePA.Visible := APage = FPagePA;
FPageAdvanced.Visible := APage = FPageAdvanced;
FPageCAT.Visible := APage = FPageCAT;
FNavAudio.Active := ANav = FNavAudio;
FNavDisplay.Active := ANav = FNavDisplay;
@@ -453,6 +492,7 @@ begin
FNavWaterfall.Active := ANav = FNavWaterfall;
FNavPA.Active := ANav = FNavPA;
FNavAdvanced.Active := ANav = FNavAdvanced;
FNavCAT.Active := ANav = FNavCAT;
end;
// ---------------------------------------------------------------------------
@@ -859,6 +899,7 @@ begin
if Assigned(FPageWaterfall) then FPageWaterfall.Color := CLR_BG;
if Assigned(FPagePA) then FPagePA.Color := CLR_BG;
if Assigned(FPageAdvanced) then FPageAdvanced.Color := CLR_BG;
if Assigned(FPageCAT) then FPageCAT.Color := CLR_BG;
end;
// ---------------------------------------------------------------------------
@@ -1294,4 +1335,213 @@ begin
Close;
end;
// ---------------------------------------------------------------------------
// BuildCATTab
// ---------------------------------------------------------------------------
procedure TSettingsForm.BuildCATTab;
const
MARGIN = 22;
PAD = 18;
LW = 120;
CX = PAD + LW + 8;
GRP_W = 320;
GRP_H = 240;
GRP_GAP = 16;
CMB_W = 140;
EDT_W = 160;
R1 = 42;
STEP = 32;
var
i, col, row, gx, gy, j: Integer;
Grp: TPanel;
Chk: TCheckBox;
Ed: TEdit;
Cmb: TComboBox;
Spin: TSpinEdit;
begin
with TLabel.Create(Self) do
begin
Parent := FPageCAT;
Caption := 'CAT';
SetBounds(MARGIN, 18, 400, 28);
Font.Name := UI_FONT; Font.Size := 16;
Font.Style := [fsBold]; Font.Color := CLR_TEXT;
end;
with TLabel.Create(Self) do
begin
Parent := FPageCAT;
Caption := 'Computer Aided Transceiver — serial port and TCP server settings.';
SetBounds(MARGIN, 48, 680, 20);
Font.Name := UI_FONT; Font.Size := 9; Font.Color := CLR_TEXTDIM;
end;
for i := 0 to 3 do
begin
row := i div 2;
col := i mod 2;
gx := MARGIN + col * (GRP_W + GRP_GAP);
gy := 86 + row * (GRP_H + GRP_GAP);
Grp := MakeGroupPanel(FPageCAT, 'Serial Port ' + IntToStr(i + 1), gx, gy, GRP_W, GRP_H);
Chk := TCheckBox.Create(Self);
Chk.Parent := Grp;
Chk.Caption := 'Enable';
Chk.SetBounds(PAD, R1, GRP_W - PAD * 2, 22);
Chk.Font.Color := CLR_TEXT;
Chk.Font.Name := UI_FONT; Chk.Font.Size := 9;
Chk.Tag := i;
Chk.OnChange := OnCATSerialChange;
FCATSerialEn[i] := Chk;
MakeLbl(Grp, 'Port:', PAD, R1 + STEP + 6, LW);
Ed := TEdit.Create(Self);
Ed.Parent := Grp;
Ed.SetBounds(CX, R1 + STEP, EDT_W, BTN_H);
Ed.Color := CLR_INPUT; Ed.Font.Color := CLR_INPUT_TEXT;
Ed.Font.Name := UI_FONT; Ed.Font.Size := 9;
Ed.Tag := i;
Ed.OnChange := OnCATSerialChange;
{$IFDEF MSWINDOWS}
Ed.Text := 'COM' + IntToStr(i + 1);
{$ELSE}
Ed.Text := '/dev/ttyS' + IntToStr(i);
{$ENDIF}
FCATSerialPort[i] := Ed;
MakeLbl(Grp, 'Baud rate:', PAD, R1 + 2 * STEP + 6, LW);
Cmb := MakeCombo(Grp, CX, R1 + 2 * STEP, CMB_W, OnCATSerialChange);
Cmb.Tag := i;
for j := 0 to High(CAT_BAUD_NAMES) do Cmb.Items.Add(CAT_BAUD_NAMES[j]);
Cmb.ItemIndex := 3; // 9600
FCATSerialBaud[i] := Cmb;
MakeLbl(Grp, 'Data bits:', PAD, R1 + 3 * STEP + 6, LW);
Cmb := MakeCombo(Grp, CX, R1 + 3 * STEP, CMB_W, OnCATSerialChange);
Cmb.Tag := i;
Cmb.Items.Add('7'); Cmb.Items.Add('8');
Cmb.ItemIndex := 1; // 8
FCATSerialDataBits[i] := Cmb;
MakeLbl(Grp, 'Stop bits:', PAD, R1 + 4 * STEP + 6, LW);
Cmb := MakeCombo(Grp, CX, R1 + 4 * STEP, CMB_W, OnCATSerialChange);
Cmb.Tag := i;
Cmb.Items.Add('1'); Cmb.Items.Add('2');
Cmb.ItemIndex := 0; // 1
FCATSerialStopBits[i] := Cmb;
MakeLbl(Grp, 'Parity:', PAD, R1 + 5 * STEP + 6, LW);
Cmb := MakeCombo(Grp, CX, R1 + 5 * STEP, CMB_W, OnCATSerialChange);
Cmb.Tag := i;
Cmb.Items.Add('None'); Cmb.Items.Add('Odd'); Cmb.Items.Add('Even');
Cmb.ItemIndex := 0; // None
FCATSerialParity[i] := Cmb;
end;
// TCP server group below the two rows of serial port panels
gy := 86 + 2 * (GRP_H + GRP_GAP);
Grp := MakeGroupPanel(FPageCAT, 'TCP CAT Server', MARGIN, gy, GRP_W * 2 + GRP_GAP, 116);
FCATTcpEn := TCheckBox.Create(Self);
FCATTcpEn.Parent := Grp;
FCATTcpEn.Caption := 'Enable TCP server (default port 4992)';
FCATTcpEn.SetBounds(PAD, R1, 300, 22);
FCATTcpEn.Font.Color := CLR_TEXT;
FCATTcpEn.Font.Name := UI_FONT; FCATTcpEn.Font.Size := 9;
FCATTcpEn.OnChange := OnCATTcpChange;
MakeLbl(Grp, 'Port:', PAD, R1 + STEP + 6, LW);
Spin := TSpinEdit.Create(Self);
Spin.Parent := Grp;
Spin.SetBounds(CX, R1 + STEP, 100, BTN_H + 2);
Spin.Color := CLR_INPUT; Spin.Font.Color := CLR_INPUT_TEXT;
Spin.Font.Name := UI_FONT; Spin.Font.Size := 9;
Spin.MinValue := 1; Spin.MaxValue := 65535;
Spin.Value := 4992;
Spin.OnChange := OnCATTcpChange;
FCATTcpPort := Spin;
end;
// ---------------------------------------------------------------------------
// CAT event handlers
// ---------------------------------------------------------------------------
procedure TSettingsForm.FireCATChange;
var
SerEn: array[0..3] of Boolean;
SerPort: array[0..3] of string;
SerBaud, SerData, SerStop, SerPar: array[0..3] of Integer;
i, Idx: Integer;
begin
if FLoading then Exit;
if not Assigned(FOnCATChange) then Exit;
for i := 0 to 3 do
begin
SerEn[i] := FCATSerialEn[i].Checked;
SerPort[i] := FCATSerialPort[i].Text;
Idx := FCATSerialBaud[i].ItemIndex;
if (Idx >= 0) and (Idx <= High(CAT_BAUD_VALS)) then
SerBaud[i] := CAT_BAUD_VALS[Idx]
else
SerBaud[i] := 9600;
if FCATSerialDataBits[i].ItemIndex = 0 then SerData[i] := 7 else SerData[i] := 8;
if FCATSerialStopBits[i].ItemIndex = 1 then SerStop[i] := 2 else SerStop[i] := 1;
SerPar[i] := FCATSerialParity[i].ItemIndex;
end;
FOnCATChange(SerEn, SerPort, SerBaud, SerData, SerStop, SerPar,
FCATTcpEn.Checked, FCATTcpPort.Value);
end;
procedure TSettingsForm.OnCATSerialChange(Sender: TObject);
begin FireCATChange; end;
procedure TSettingsForm.OnCATTcpChange(Sender: TObject);
begin FireCATChange; end;
// ---------------------------------------------------------------------------
// LoadCATSettings
// ---------------------------------------------------------------------------
procedure TSettingsForm.LoadCATSettings(
const SerEnabled: array of Boolean;
const SerPort: array of string;
const SerBaud, SerDataBits, SerStopBits, SerParity: array of Integer;
TcpEnabled: Boolean; TcpPort: Integer);
var
i, j, Idx: Integer;
begin
FLoading := True;
try
for i := 0 to 3 do
begin
if i <= High(SerEnabled) then FCATSerialEn[i].Checked := SerEnabled[i];
if i <= High(SerPort) then FCATSerialPort[i].Text := SerPort[i];
if i <= High(SerBaud) then
begin
Idx := 3;
for j := 0 to High(CAT_BAUD_VALS) do
if CAT_BAUD_VALS[j] = SerBaud[i] then begin Idx := j; Break; end;
FCATSerialBaud[i].ItemIndex := Idx;
end;
if i <= High(SerDataBits) then
begin
if SerDataBits[i] = 7 then FCATSerialDataBits[i].ItemIndex := 0
else FCATSerialDataBits[i].ItemIndex := 1;
end;
if i <= High(SerStopBits) then
begin
if SerStopBits[i] = 2 then FCATSerialStopBits[i].ItemIndex := 1
else FCATSerialStopBits[i].ItemIndex := 0;
end;
if i <= High(SerParity) then
FCATSerialParity[i].ItemIndex := EnsureRange(SerParity[i], 0, 2);
end;
FCATTcpEn.Checked := TcpEnabled;
FCATTcpPort.Value := EnsureRange(TcpPort, 1, 65535);
finally
FLoading := False;
end;
end;
end.
ewsdr.lpi
+12
View File
@@ -139,6 +139,18 @@
<Filename Value="Settings.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="CATEngine.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="CATSerial.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="CATTcp.pas"/>
<IsPartOfProject Value="True"/>
</Unit>
</Units>
</ProjectOptions>
<CompilerOptions>