unit Channelsu;
{
  (C) 2000 - 2001 Jindrich Jindrich, Pavel Pisa, PiKRON Ltd.

  Originators of the CHROMuLAN project:

  Jindrich Jindrich - http://www.jindrich.com
                      http://orgchem.natur.cuni.cz/Chromulan/
                      software developer, project coordinator
  Pavel Pisa        - http://cmp.felk.cvut.cz/~pisa
                      embeded software developer
  PiKRON Ltd.       - http://www.pikron.com
                      project initiator, sponsor, instrument developer

  The CHROMuLAN project is distributed under the GNU General Public Licence.
  See file COPYING for details.

  Originators reserve the right to use and publish sources
  under different conditions too. If third party contributors
  do not accept this condition, they can delete this statement
  and only GNU license will apply.
}

interface
uses
  Messages,
  SysUtils, Classes,
  UtlType, ModuType, Modulu, UlanType, UlanGlob, {v0.65} CuLSharedMemu,{/v0.65}
  ULRecTyp, ULObju, ULLType, ULLObju, ULNType, ULNObju, ULNDType, ULNDObju,
  ULDRType, ULDRObju;

type
  EChannel = Exception;

  TChannels = class;

  TChannel = class({v0.24}TPersistent{/v0.24 TObject})
  private
    FChannels: TChannels;
    function GetDeviceMode: TDeviceMode;
    function GetPortName: TDevicePortName;
    function GetChannelName: TChannelName;
    function GetDetectorAddress: {v0.53}TModuleAddr{/v0.53 integer};
    {v0.65}
    function GetExtDevDeviceName: TDeviceName;
    {/v0.65 function GetExtDevDrvName: TExtDevDrvName;}
    {v0.31}
    function GetDeviceCount: integer;
    function GetDevice(Index:integer): TModule;
    {/v0.31}
    {v0.67}
    function GetDefTemplateFileName: string;
    function GetChannelIndex: integer;
    {/v0.67}
  public
    ULN: TULNObj;
    constructor Create(AChannels: TChannels; AULNObj: TULNObj);reintroduce;
    procedure WMAppMessage(var Msg:TMessage);message WM_APPMESSAGE;
    destructor Destroy;override;
    {v0.50}
    function DeviceFind(const ADeviceName: string; var AModule: TModule): boolean;
    function DeviceAliasToULObjPath(const AAlias: string; var AULObjPath: string): boolean;
    function DeviceAliasToDevice(const AAlias: string ;var AModule: TModule): boolean;
    {/v0.50}
    {v0.53}
    function DeviceFindByAddr(AAddr: TModuleAddr; var AModule: TModule): boolean;
    {/v0.53}
    property DeviceMode: TDeviceMode read GetDeviceMode;
    property PortName: TDevicePortName read GetPortName;
    property ChannelName: TChannelName read GetChannelName;
    property DetectorAddress: {v0.53}TModuleAddr{/v0.53 integer} read GetDetectorAddress;
    {v0.65}
    property ExtDevDeviceName: TDeviceName read GetExtDevDeviceName;
    {/v0.65
    property ExtDevDrvName: TExtDevDrvName read GetExtDevDrvName;}
    {v0.31}
    property DeviceCount: integer read GetDeviceCount;
    property Devices[Index: integer]: TModule read GetDevice;
    {/v0.31}
    {v0.67}
    property DefTemplateFileName: string read GetDefTemplateFileName;
    property ChannelIndex: integer read GetChannelIndex;
    {/v0.67}
  end;

  TChannels = class(TList)
  private
  protected
    function GetChannel(Index: integer): TChannel;
    {v0.50}
    function GetActiveChannel: TChannel;{the active one in the channels browser
      (ULL activechild) }
    {/v0.50}
    {v0.55}
    procedure SetActiveChannel(AChannel: TChannel);
    {/v0.55}
  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; {v0.50}overload;{/v0.50}
    {v0.50}
    function FindChannel(ULN:TULNObj; var AChannel: TChannel): boolean; overload;
    {/v0.50}
    {v0.67}
    //function FindChannel(const AChannelName: TChannelName): TChannel; overload;
    {/v0.67}
    {v0.65}
    procedure UpdateSharedMem;
    {/v0.65}
    property Channels[Index: integer]: TChannel read GetChannel; default;
    {v0.50}
    property ActiveChannel: TChannel read GetActiveChannel {v0.55} write SetActiveChannel{/v0.55};
    {/v0.50}
  end;

{v0.59}
const
  Channels: TChannels = nil;
{/v0.59
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;

{v0.65}
function TChannel.GetExtDevDeviceName: TDeviceName;
var
  nd: TULNDObj;
  i: integer;
  d: TULDRObj;//uldrobju
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
      Result := d.DeviceName;
      exit;
      {
      if d.DeviceExtDevDrvName <> '' then begin
        Result := d.ExtDevDrvName;
        exit;
      end;}
    end;
  end;
end;
{/v0.65
function TChannel.GetExtDevDrvName: TExtDevDrvName;
var
  nd: TULNDObj;
  i: integer;
  d: TULDRObj;//uldrobju
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: {v0.53}TModuleAddr{/v0.53 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;

{v0.31}
function TChannel.GetDeviceCount: integer;
var
  nd: TULNDObj;
  i: integer;
  mi: integer;
begin
  Result := 0;
  for i := 0 to ULN.ChildCount - 1 do begin
    nd := TULNDObj(ULN.Childs[i]);
    for mi := 0 to Modules.Count - 1 do begin
      if Modules[mi].ULDR.DeviceName = nd.DeviceName then begin
        inc(Result);
        break;
      end;
    end;
  end;
end;

function TChannel.GetDevice(Index:integer): TModule;
var
  nd: TULNDObj;
  mi, i: integer;
  cnt: integer;
  fnd: boolean;
begin
  Result := nil;
  cnt := 0;
  for i := 0 to ULN.ChildCount - 1 do begin
    nd := TULNDObj(ULN.Childs[i]);
    fnd := false;
    for mi := 0 to Modules.Count - 1 do begin
      if Modules[mi].DeviceName = nd.DeviceName then begin
        Result := Modules[mi];
        fnd := true;
        break;
      end;
    end;
    if fnd then begin
      if Index = cnt then begin
        exit;
      end else
        Result := nil;
      inc(cnt);
    end;
  end;
end;
{/v0.31}

{v0.50}
function TChannel.DeviceFind(const ADeviceName: string; var AModule: TModule): boolean;
var
  mi: integer;
  dname: string;
begin
  Result := false;
  for mi := 0 to Modules.Count - 1 do begin
    {v0.59}
    dname := Modules[mi].DeviceName;
    if dname = ADeviceName then begin
    {/v0.59
    if Modules[mi].DeviceName = ADeviceName then begin
    }
      AModule := Modules[mi];
      Result := true;
      exit;
    end;
  end;
end;

function TChannel.DeviceAliasToULObjPath(const AAlias: string; var AULObjPath: string): boolean;
var m: TModule;
begin
  Result := false;
  if DeviceAliasToDevice(AAlias, m) then begin
    AULObjPath := m.ULDR.ULObjPath;
    Result := true;
  end;
end;

function TChannel.DeviceAliasToDevice(const AAlias: string ;var AModule: TModule): boolean;
var
  i: integer;
  nd: TULNDObj;
  {AModule: TModule;}
begin
  Result := false;
  for i := 0 to ULN.ChildCount - 1 do begin
    nd := TULNDObj(ULN.Childs[i]);
    if nd.DeviceAlias = AAlias then begin
      if DeviceFind(nd.DeviceName, AModule) then begin
        Result := true;
        exit;
      end;
    end
  end;
  if DeviceFind(AAlias, AModule) then begin
    Result := true;
    exit;
  end;
end;

{/v0.50}
{v0.53}
function TChannel.DeviceFindByAddr(AAddr: TModuleAddr; var AModule: TModule): boolean;
var
  i: integer;
  m: TModule;
begin
  Result := false;
  for i := 0 to DeviceCount -1 do begin
    m := Devices[i];
    if m.Addr = AAddr then begin
      AModule := m;
      Result := true;
      exit;
    end;
  end;
end;
{/v0.53}

{v0.67}
function TChannel.GetDefTemplateFileName: string;
begin
  if ChannelName = pvUlanDefaultChannel then
    Result := pvUlanDefaultTemplate
  else if ChannelName = pvPasiveDefaultChannel then
    Result := pvPasiveDefaultTemplate
  else begin
    Result := ChannelName + ULTExt;
  end;
end;

function TChannel.GetChannelIndex: integer;
begin
  Result := FChannels.IndexOf(Self)
end;
{/v0.67}

{/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
  Clear;
  {v0.22}
  if ULL <> nil then
  {/v0.22}
    ULL.UserUnregister(Self);
  inherited Destroy;
end;

procedure TChannels.CheckDefaultChannels;
var
  n: TULNObj;
  nd: TULNDObj;
  f: TULObjField;
begin
  if not ULL.HasChildWithFieldUsrValue(fnChannelName, pvPasiveDefaultChannel, TULObj(n)) then begin
    n := TULNObj(ULL.Add(ULNID));
    with n as TULObj do begin
      ChannelName := pvPasiveDefaultChannel;
    end;
    nd := TULNDObj(n.FindOrAdd(ULNDID,''));
    nd.DeviceName := pvPasiveDefaultDevice;
  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;
  {v0.41}
  v: string;
  {/v0.41}
begin
  if not ULL.HasChildWithFieldUsrValue(fnChannelName, pvUlanDefaultChannel, TULObj(n)) then begin
    {v0.41}
    if UserMode = umSysOp then
      v := 'dmUlan'
    else
      v := 'Ulan';
    {/v0.41}
    if Modules.ULD.HasChildWithFieldUsrValue(fnDeviceMode, {v0.36}{v0.41}v{/v0.41 'Ulan'}{/v0.36 '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;

{v0.50}
function TChannels.FindChannel(ULN:TULNObj; var AChannel: TChannel): boolean;
var i: integer;
begin
  Result := false;
  for i := 0 to Count - 1 do begin
    if TChannel(Items[i]).ULN = ULN then begin
      AChannel := TChannel(Items[i]);
      Result := true;
      exit;
    end;
  end;
end;
{/v0.50}

procedure TChannels.UpdateFromULL;
var
  n:TULNObj;
  i:integer;
  {v0.50}
  c: TChannel;
  {/v0.50}
begin
  {v0.50}
  if ULL = nil then begin
    Clear;
    exit;
  end;

  for i := 0 to ULL.ChildCount - 1 do begin
    n := TULNObj(ULL.Childs[i]);
    if n.RecID = ULNID then begin
      if not FindChannel(n, c) then
        AddChannel(n);
    end;
  end;
  for i := 0 to Count - 1 do begin
    c := Channels[i];
    if not ULL.OwnsObj(c.ULN) then
      c.Free;
  end;
  {/v0.50
  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);
  {v0.65}
  UpdateSharedMem;
  {/v0.65}
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
        {v0.22}
        ULL.UserUnregister(Self);
        ULL := nil;
        {/v0.22}
        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;

{v0.50}
function TChannels.GetActiveChannel: TChannel;
var
  o: TULObj;
  i: integer;
begin
  Result := nil;
  o := ULL.ActiveChild;
  if o = nil then
    exit;
  for i := 0 to Count - 1 do begin
   if TULObj(Channels[i].ULN) = o then begin
     Result := Channels[i];
     exit;
   end;
  end;
end;
{/v0.50}
{v0.55}
procedure TChannels.SetActiveChannel(AChannel: TChannel);
begin
  if AChannel <> nil then
    ULL.ActiveChild := AChannel.ULN;
end;
{/v0.55}
{v0.65}
procedure TChannels.UpdateSharedMem;
var
  s: string;
  i: integer;
begin
  s := '';
  for i := 0 to Count - 1 do begin
    if s = '' then
      s := Channels[i].ChannelName
    else
      s := s + ',' + Channels[i].ChannelName;
  end;
  CuLSharedMem^.ChannelList := s;
end;
{/v0.65}

{/TChannels.}

{procedure DeleteChannel(AULNObj: TULNObj);}

{ Channels created in Modulu initilization }
{v0.24}
initialization
  RegisterClasses([TChannel]);
{/v0.24}
end.
