ewsdr/CATSerial.pas

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}

{$IFDEF DARWIN}
  {$DEFINE CAT_SERIAL_STUB}
{$ENDIF}

interface

uses
  Classes, SysUtils,
  {$IFNDEF CAT_SERIAL_STUB}
  Serial,   // FPC cross-platform serial unit
  {$ENDIF}
  {$IFDEF MSWINDOWS}Windows,{$ENDIF}
  SyncObjs,
  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;
    Andromeda: Boolean;  // порт — передняя панель Andromeda/G2 (push ZZZI наружу)
  end;

  {$IFDEF CAT_SERIAL_STUB}
  TSerialHandle = PtrInt;
  {$ENDIF}

  TCATSerialPort = class;

  { TCATSerialThread — per-port listener thread }
  TCATSerialThread = class(TThread)
  private
    FOwner:  TCATSerialPort;
    FHandle: TSerialHandle;
    FBuf:    string;
    procedure ProcessBuffer;
  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;
    FLastError: string;
    function  OpenPort: Boolean;   // синхронно, из Start — чтобы отказ был виден сразу
    procedure ClosePort;
  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;
    // Причина, по которой порт не поднялся (пусто, если поднялся). Раньше отказ
    // SerOpen нигде не оседал, а порт продолжал числиться активным.
    property  LastError: string         read FLastError;
  end;

  { TCATSerialManager — manages up to 4 serial ports }
  TCATSerialManager = class
  private
    FPorts:  array[0..CAT_SERIAL_MAX_PORTS-1] of TCATSerialPort;
    FEngine: TCATEngine;
    FAndromedaPort: TCATSerialPort;   // первый активный порт с Andromeda=true (или nil)
  public
    constructor Create(AEngine: TCATEngine);
    destructor  Destroy; override;
    procedure ApplyConfig(const Configs: array of TCATSerialConfig);
    procedure StopAll;
    function  ActiveCount: Integer;
    // Передняя панель: есть ли активный Andromeda-порт и отправка строки в него.
    function  HasAndromeda: Boolean;
    procedure SendToAndromeda(const S: string);  // сигнатура совместима с TAndromedaSend
  end;

implementation

{ ── TCATSerialThread ──────────────────────────────────────────────────────── }

constructor TCATSerialThread.Create(AOwner: TCATSerialPort);
begin
  FOwner := AOwner;
  FBuf   := '';
  FreeOnTerminate := False;
  inherited Create(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;
// Порт уже открыт владельцем (TCATSerialPort.Start) — поток только читает.
// Закрывает тоже владелец, в Stop, после WaitFor.
var
  ch: Byte;
  n:  LongInt;
begin
  {$IFDEF CAT_SERIAL_STUB}
  Exit;
  {$ELSE}
  FHandle := FOwner.Handle;
  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;
  {$ENDIF}
end;

{ ── TCATSerialPort ────────────────────────────────────────────────────────── }

constructor TCATSerialPort.Create(AEngine: TCATEngine; const ACfg: TCATSerialConfig);
begin
  inherited Create;
  FEngine := AEngine;
  FConfig := ACfg;
  {$IFDEF MSWINDOWS}
  FHandle := INVALID_HANDLE_VALUE;
  {$ELSE}
  FHandle := -1;
  {$ENDIF}
  FLock   := TCriticalSection.Create;
  FActive := False;
end;

destructor TCATSerialPort.Destroy;
begin
  Stop;
  FLock.Free;
  inherited;
end;

function TCATSerialPort.OpenPort: Boolean;
  {$IFNDEF CAT_SERIAL_STUB}
var
  h:   TSerialHandle;
  par: TParityType;
  {$ENDIF}
begin
  Result := False;
  {$IFDEF CAT_SERIAL_STUB}
  FLastError := 'serial support not built on this platform';
  {$ELSE}
  h := SerOpen(FConfig.PortName);
  {$IFDEF MSWINDOWS}
  if h = TSerialHandle(INVALID_HANDLE_VALUE) then
  {$ELSE}
  if h < 0 then
  {$ENDIF}
  begin
    FLastError := 'не удалось открыть ' + FConfig.PortName;
    Exit;
  end;

  case FConfig.Parity of
    cspNone: par := Serial.NoneParity;
    cspOdd:  par := Serial.OddParity;
    cspEven: par := Serial.EvenParity;
  else       par := Serial.NoneParity;
  end;

  SerSetParams(h, FConfig.BaudRate, FConfig.DataBits, par, FConfig.StopBits, []);
  FHandle    := h;
  FLastError := '';
  Result     := True;
  {$ENDIF}
end;

procedure TCATSerialPort.ClosePort;
begin
  {$IFNDEF CAT_SERIAL_STUB}
  {$IFDEF MSWINDOWS}
  if FHandle <> INVALID_HANDLE_VALUE then SerClose(FHandle);
  FHandle := INVALID_HANDLE_VALUE;
  {$ELSE}
  if FHandle >= 0 then SerClose(FHandle);
  FHandle := -1;
  {$ENDIF}
  {$ENDIF}
end;

procedure TCATSerialPort.Start;
// Порт открываем ЗДЕСЬ, а не в потоке: иначе отказ SerOpen оставался внутри
// потока, а порт всё это время числился активным — и в ActiveCount, и в UI.
begin
  if FActive or not FConfig.Enabled then Exit;
  if not OpenPort then Exit;          // FActive остаётся False, причина — в LastError
  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;
  ClosePort;
end;

procedure TCATSerialPort.SendStr(const S: string);
var buf: AnsiString;
begin
  {$IFDEF CAT_SERIAL_STUB}
  Exit;
  {$ELSE}
  {$IFDEF MSWINDOWS}
  if FHandle = INVALID_HANDLE_VALUE then Exit;
  {$ELSE}
  if FHandle < 0 then Exit;
  {$ENDIF}
  FLock.Acquire;
  try
    buf := AnsiString(S);
    if Length(buf) > 0 then
      SerWrite(FHandle, buf[1], Length(buf));
  except
    // ignore write errors (port may have been closed)
  end;
  FLock.Release;
  {$ENDIF}
end;

{ ── TCATSerialManager ─────────────────────────────────────────────────────── }

constructor TCATSerialManager.Create(AEngine: TCATEngine);
var i: Integer;
begin
  inherited Create;
  FEngine := AEngine;
  FAndromedaPort := nil;
  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;
    // Панель назначаем только на РЕАЛЬНО поднявшийся порт: раньше хватало галки
    // в настройках, и HasAndromeda рапортовал о панели, которой нет.
    if FPorts[i].Active and Configs[i].Andromeda and (FAndromedaPort = nil) then
      FAndromedaPort := FPorts[i];
  end;
end;

function TCATSerialManager.HasAndromeda: Boolean;
begin
  Result := Assigned(FAndromedaPort);
end;

procedure TCATSerialManager.SendToAndromeda(const S: string);
begin
  if Assigned(FAndromedaPort) then FAndromedaPort.SendStr(S);
end;

procedure TCATSerialManager.StopAll;
var i: Integer;
begin
  FAndromedaPort := nil;   // указывает в FPorts[] — обнулить ДО освобождения
  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.