unit Channelsu;

interface
uses
  Messages,
  SysUtils, Classes,
  MyType, ModuType, Modulu, UlanType, UlanGlob,
  ULRecTyp, ULObju, ULLType, ULLObju, ULNType, ULNObju, ULNDType, ULNDObju,
  ULDRType, ULDRObju;

type
  EChannel = Exception;

  TChannels = class;

  TChannel = class(TObject)
  private
    FChannels: TChannels;
    function GetDeviceMode: TDeviceMode;
    function GetPortName: TDevicePortName;
    function GetChannelName: TChannelName;
    function GetDetectorAddress: integer;
    function GetExtDevDrvName: TExtDevDrvName;
  public
    ULN: TULNObj;
    constructor Create(AChannels: TChannels; AULNObj: TULNObj);reintroduce;
    procedure WMAppMessage(var Msg:TMessage);message WM_APPMESSAGE;
    destructor Destroy;override;
    property DeviceMode: TDeviceMode read GetDeviceMode;
    property PortName: TDevicePortName read GetPortName;
    property ChannelName: TChannelName read GetChannelName;
    property DetectorAddress: integer read GetDetectorAddress;
    property ExtDevDrvName: TExtDevDrvName read GetExtDevDrvName;
  end;

  TChannels = class(TList)
  private
  protected
    function GetChannel(Index: integer): TChannel;
  public
    ULL: TULLObj;
    constructor Create;reintroduce;
    procedure Clear;override;
    destructor Destroy;override;
    procedure CheckDefaultChannels;
      { called from create to create default apex channel,
        eventually extdev channels }
    procedure CheckExtChannels;
    procedure CheckuLanChannels;
      { called from modules after autodetect to eventually
        create default uLan channel }
    procedure UpdateFromULL;
    procedure WMAppMessage(var Msg:TMessage);message WM_APPMESSAGE;

    function AddChannel(AULNObj: TULNObj): TChannel;
    {procedure DeleteChannel(AULNObj: TULNObj);}
    function FindChannel(const AChannelName: TChannelName): TChannel;
    property Channels[Index: integer]: TChannel read GetChannel; default;
  end;

var
  Channels: TChannels;

implementation

{TChannel}
constructor TChannel.Create(AChannels: TChannels; AULNObj: TULNObj);
begin
  inherited Create;
  FChannels := AChannels;
  ULN := AULNObj;
  ULN.UserRegister(Self);
  FChannels.Add(Self);
end;

destructor TChannel.Destroy;
var i: integer;
begin
  ULN.UserUnregister(Self);
  i := FChannels.IndexOf(Self);
  if i >= 0 then
    FChannels.Delete(i);
  inherited;
end;

procedure TChannel.WMAppMessage(var Msg:TMessage);
begin
  case Msg.wParam of
    cmULObjUpdated: begin
      if TULNObj(Msg.lParam) = ULN then begin
        {UpdateFromULL;}
      end;
    end;
    cmULObjDestroyed: begin
      if TULNObj(Msg.lParam) = ULN then begin
        Free;
      end;
    end;
  end;
end;

function TChannel.GetDeviceMode: TDeviceMode;
var
  nd: TULNDObj;
  i: integer;
  d: TULDRObj;
begin
  Result := dmUnspecified;
  for i := 0 to ULN.ChildCount - 1 do begin
    nd := TULNDObj(ULN.Childs[i]);
    if Modules.ULD.HasChildWithFieldUsrValue(fnDeviceName, nd.DeviceName, TULObj(d)) then begin
      if d.DeviceType = dtDetector then begin
        Result := d.DeviceMode;
        exit;
      end;
    end;
  end;
end;

function TChannel.GetPortName: string;
var
  nd: TULNDObj;
  i: integer;
  d: TULDRObj;
begin
  Result := '';
  for i := 0 to ULN.ChildCount - 1 do begin
    nd := TULNDObj(ULN.Childs[i]);
    if Modules.ULD.HasChildWithFieldUsrValue(fnDeviceName, nd.DeviceName, TULObj(d)) then begin
      if d.DevicePortName <> '' then begin
        Result := d.DevicePortName;
        exit;
      end;
    end;
  end;
end;

function TChannel.GetExtDevDrvName: TExtDevDrvName;
var
  nd: TULNDObj;
  i: integer;
  d: TULDRObj;
begin
  Result := '';
  for i := 0 to ULN.ChildCount - 1 do begin
    nd := TULNDObj(ULN.Childs[i]);
    if Modules.ULD.HasChildWithFieldUsrValue(fnDeviceName, nd.DeviceName, TULObj(d)) then begin
      if d.ExtDevDrvName <> '' then begin
        Result := d.ExtDevDrvName;
        exit;
      end;
    end;
  end;
end;



function TChannel.GetChannelName: TChannelName;
begin
  Result := ULN.ChannelName;
end;

function TChannel.GetDetectorAddress: integer;
var
  nd: TULNDObj;
  i: integer;
  d: TULDRObj;
begin
  Result := 0;
  for i := 0 to ULN.ChildCount - 1 do begin
    nd := TULNDObj(ULN.Childs[i]);
    if Modules.ULD.HasChildWithFieldUsrValue(fnDeviceName, nd.DeviceName, TULObj(d)) then begin
      if d.DeviceType = dtDetector then begin
        Result := StrToInt(d.AddrStr);
        exit;
      end;
    end;
  end;
end;

{/TChannel}
{TChannels}
constructor TChannels.Create;
begin
  inherited Create;
  ULL := TULLObj(Modules.ULF.FindOrAdd(ULLID,''));
  ULL.UserRegister(Self);
  ULL.SetFlag(rfCantDelete, true);
  ULL.FindField(fnChannelName).FldDesc.ValuesSource := TObject(ULL);

  CheckDefaultChannels;
end;

destructor TChannels.Destroy;
begin
  ULL.UserUnregister(Self);
  Clear;
  inherited Destroy;
end;

procedure TChannels.CheckDefaultChannels;
var
  n: TULNObj;
  nd: TULNDObj;
  f: TULObjField;
begin
  if not ULL.HasChildWithFieldUsrValue(fnChannelName, pvApexDefaultChannel, TULObj(n)) then begin
    n := TULNObj(ULL.Add(ULNID));
    with n as TULObj do begin
      ChannelName := pvApexDefaultChannel;
    end;
    nd := TULNDObj(n.FindOrAdd(ULNDID,''));
    nd.DeviceName := pvApexDefaultDevice;
  end;

  n := TULNObj(ULL.FindOrAdd(ULNID,''));
  n.SetFlag(rfCantDelete, true);

{  if n.ChannelName = '' then
    n.ChannelName := 'Default';}

  nd := TULNDObj(n.FindOrAdd(ULNDID, ''));{creates at least device if none present}
  f := nd.FindField(fnDeviceName);
  f.FldDesc.ValuesSource := TObject(Modules.ULD);

  if (ULL.ChannelName = '') then
    ULL.ChannelName := n.ChannelName;

  CheckuLanChannels;
  CheckExtChannels;
end;


procedure TChannels.CheckuLanChannels;
var
  n: TULNObj;
  d: TULDRObj;
  nd: TULNDObj;
  i: integer;
begin
  if not ULL.HasChildWithFieldUsrValue(fnChannelName, pvUlanDefaultChannel, TULObj(n)) then begin
    if Modules.ULD.HasChildWithFieldUsrValue(fnDeviceMode, 'dmUlan', TULObj(d)) then begin
      n := TULNObj(ULL.Add(ULNID));
      n.ChannelName := pvUlanDefaultChannel;
      for i := 0 to Modules.ULD.ChildCount - 1 do begin
        d := TULDRObj(Modules.ULD.Childs[i]);
        if (d.RecID = ULDRID) and (d.DeviceMode = dmUlan) then begin
          nd := TULNDObj(n.Add(ULNDID));
          nd.DeviceName := d.DeviceName;
        end;
      end;

      {if not ULL.IsFlagSet(rfManual) then}
      begin
        ULL.ChannelName := n.ChannelName;
      end;
    end;
  end;
  UpdateFromULL;
end;

procedure TChannels.UpdateFromULL;
var
  n:TULNObj;
  i:integer;
begin
  Clear;
  if ULL = nil then
    exit;
  for i := 0 to ULL.ChildCount - 1 do begin
    n := TULNObj(ULL.Childs[i]);
    if n.RecID = ULNID then begin
      AddChannel(n);
    end;
  end;
end;

function TChannels.AddChannel(AULNObj: TULNObj): TChannel;
begin
  Result := TChannel.Create(Self, AULNObj);
end;

function TChannels.GetChannel(Index: integer): TChannel;
begin
  if (Index < 0) or (Index >= Count) then
    raise EChannel.Create('GetChannel Index OOR ' + IntToStr(Index));
  Result := TChannel(Items[Index]);{TList}
end;

procedure TChannels.WMAppMessage(var Msg:TMessage);
begin
  case Msg.wParam of
    cmULObjUpdated: begin
      if TULLObj(Msg.lParam) = ULL then begin
        UpdateFromULL;
      end;
    end;
    cmULObjDestroyed: begin
      if TULLObj(Msg.lParam) = ULL then begin
        Free;
      end;
    end;
  end;
end;

function TChannels.FindChannel(const AChannelName: TChannelName): TChannel;
var i: integer;
begin
  for i := 0 to Count -1 do begin
    if Channels[i].ChannelName = AChannelName then begin
      Result := Channels[i];
      exit;
    end;
  end;
  raise EChannel.Create('Channel not found ' + AChannelName);
end;

procedure TChannels.CheckExtChannels;
var
  n: TULNObj;
  nd: TULNDObj;
  dname: string;
  d: TULDRObj;
  i: integer;
begin
  for i := 0 to Modules.ULD.ChildCount - 1 do begin
    d := TULDRObj(Modules.ULD.Childs[i]);
    if d.DeviceMode = dmExtDev then begin
      dname := d.DeviceName;
      if not ULL.HasChildWithFieldUsrValue(fnChannelName, dname, TULObj(n)) then begin
        n := TULNObj(ULL.Add(ULNID));
        with n as TULObj do begin
          ChannelName := dname;
        end;
        nd := TULNDObj(n.FindOrAdd(ULNDID,''));
        nd.DeviceName := dname;
      end;
    end;
  end;
end;

procedure TChannels.Clear;
begin
  while Count > 0 do
    Channels[0].Free;
  inherited;
end;

{/TChannels}

{procedure DeleteChannel(AULNObj: TULNObj);}

{ Channels created in Modulu initilization }
end.
