unit ULDyAdr;{v0.50}
{ server for dynamic addresing of modules on uLan network }

interface
uses
  Windows, SysUtils, Classes, ExtCtrls,
  CommObjs,
  BinHex, UtlType, WinUtl, PropUtl, ExeLogu, Timersu,
  Modulu, ULDrvTyp, ULDrvUtl, ULDriver, ULDrvFilteru;

{
  Periodic timers functions - timersu.pas

  Timers.AddTimerProc(Timer1Timer, 1000);
  Timers.DeleteTimerProc(Timer1Timer);

  procedure TSpectrumForm.Timer1Timer(Sender: TObject);

  ExeLog.Log('SpecForm.Timer begin');
}

const
  MaxuLanAddress   = 100;
  MinuLanDynAddress = 10;

type

  TULDynAddrArrayState = (daasFree,daasReserved,daasOff,daasError,
                          daasNoresp1,daasNoresp2,daasActive,daasPreAlloc);

  TULDynAddrArray = array [1..MaxuLanAddress] of TULDynAddrArrayState;

  TULDynAddrServer = class(TComponent)
  private
    FDynCheckEnabled : boolean;
    FDynCheckDelay : integer;
    FFilter: TULDrvFilter; {ULDrvFilteru}
    FULDynAddrArray :TULDynAddrArray;
    procedure DoEvent(Sender: TObject; const AMsg: TULMessage; var FilterOut: boolean);
    function  GetULDrv: TULDriver;
    procedure DoCheckTimer(Sender: TObject);
    procedure SetModuleAddress(SerNum:DWORD; NewAddr:integer);
    procedure AssignAddress(SerNum:DWORD; OldAddr:integer);
  public
    constructor Create(Owner: TComponent); reintroduce;
    destructor Destroy;override;
    procedure RequestToSendID;

    property ULDrv: TULDriver read GetULDrv;
  end;

function ULDynAddrServer: TULDynAddrServer;

implementation

const
  FServer: TULDynAddrServer =  nil;

function ULDynAddrServer: TULDynAddrServer;
begin
  if FServer = nil then
    FServer := TULDynAddrServer.Create(nil);
  Result := FServer;
end;

function SerNumFromBuf(Buf:PByteArray):DWORD;
begin
  Result := Buf^[0]+(DWORD(Buf^[1]) shl 8)+
           (DWORD(Buf^[2]) shl 16)+(DWORD(Buf^[3]) shl 24);
end;

procedure SerNumToBuf(Buf:PByteArray; SerNum:DWORD);
begin
  Buf^[0]:=byte(SerNum); Buf^[1]:=byte(SerNum shr 8);
  Buf^[2]:=byte(SerNum shr 16); Buf^[3]:=byte(SerNum shr 24);
end;

{TULDynAddrServer.}

constructor TULDynAddrServer.Create;
var i : integer;
begin
  inherited;
  for i:=1 to MaxuLanAddress do FULDynAddrArray[i]:=daasFree;
  FFilter := TULDrvFilter.Create(Self);
  Timers.AddTimerProc(DoCheckTimer, 4000);
  FDynCheckEnabled := false;
  FDynCheckDelay := 4;
end;

destructor TULDynAddrServer.Destroy;
begin
  Timers.DeleteTimerProc(DoCheckTimer);
  FFilter.Destroy;
  inherited;
end;

function TULDynAddrServer.GetULDrv: TULDriver;
begin
  Result := Modules.ULDrv;
end;

procedure TULDynAddrServer.SetModuleAddress(SerNum:DWORD; NewAddr:integer);
var
  buf:array[0..7] of byte;
begin
  buf[0] := ULNCS_SET_ADDR;
  SerNumToBuf(@(buf[1]), SerNum);
  buf[5] := NewAddr;
  {ULDrv.QuerySend(0, UL_CMD_NCS, UL_BFL_NORE*1, @buf, 6);}
  ExeLog.Log('Set address '+IntToString(NewAddr,3)+' for '+LongToHex(SerNum));
end;

procedure TULDynAddrServer.AssignAddress(SerNum:DWORD; OldAddr:integer);
var
  NewAddr : integer;
  i : integer;
begin
  NewAddr := 0;
  for i := MinuLanDynAddress to MaxuLanAddress do
  begin
    if FULDynAddrArray[i]=daasFree then begin
      NewAddr:=i;
      break;
    end;
  end;
  if NewAddr = 0 then exit;
  FULDynAddrArray[NewAddr] := daasPreAlloc;
  SetModuleAddress(SerNum, NewAddr);
end;

procedure TULDynAddrServer.DoEvent(Sender: TObject; const AMsg: TULMessage; var FilterOut: boolean);
var
  NCSRcvBuf: PByteArray;
  ReadBytes: DWORD;
{v0.64}{/v0.64  Result:    Boolean;}
  SerNum:    DWORD;
  ModuleAddr:integer;
  ModuleDes: string;
begin
  with Sender as TULDriver do
    ExeLog.Log(ULMessageGetLogStr(AMsg));
  if AMsg.len <> 0 then
  begin
    GetMem(NCSRcvBuf, AMsg.len);
    try
      with Sender as TULDriver do
        {Result:=} MessageRead(NCSRcvBuf^, AMsg.len, ReadBytes);
      case NCSRcvBuf^[0] of
        ULNCS_RQ_ADDR: begin
            ModuleAddr:=AMsg.sadr;
            SerNum:=SerNumFromBuf(@(NCSRcvBuf^[1]));
            ExeLog.Log(IntToString(ModuleAddr,3)+'  '+LongToHex(SerNum)
                       +' : Requests dynamic address');
            AssignAddress(SerNum, ModuleAddr);
        end;
        ULNCS_SET_ADDR: begin
            ModuleAddr:=AMsg.sadr;
            SerNum:=SerNumFromBuf(@(NCSRcvBuf^[1]));
            ExeLog.Log(IntToString(ModuleAddr,3)+'  '+LongToHex(SerNum)
                       +' : Set dynamic address to '+IntToString(NCSRcvBuf^[5],3));
        end;
        ULNCS_SID_RPLY: begin {UlDrvTyp}
          if ReadBytes>5 then
          begin
            ModuleAddr:=AMsg.sadr;
            SerNum:=SerNumFromBuf(@(NCSRcvBuf^[1]));
            dec(ReadBytes,5);
            SetLength(ModuleDes,ReadBytes);
            Move(NCSRcvBuf^[5],ModuleDes[1],ReadBytes);
            ExeLog.Log(IntToString(ModuleAddr,3)+'  '+LongToHex(SerNum)
                       +' : '+ModuleDes);
            {BinHex}
            {function Format(const Format: string; const Args: array of const): string;}
            FULDynAddrArray[ModuleAddr] := daasActive;
          end;
        end;
      end;
    finally
      FreeMem(NCSRcvBuf);
    end;
    {with Sender as TULDriver do rewmsg}
  end;
end;

procedure TULDynAddrServer.DoCheckTimer(Sender: TObject);
var b: byte;
    i: integer;
    buf : array [0..7] of byte;
begin
  if FFilter.RegisteredAt = nil then begin
    FFilter.Msg.cmd := UL_CMD_NCS;
    FFilter.FilterEvent := DoEvent;
    ULDrv.EventFilterRegister(FFilter);
  end;
  if FDynCheckEnabled then begin
    if FDynCheckDelay=0 then begin
      { send cycle mark }
      b := 0;
      ULDrv.QuerySend(0, UL_CMD_GST, UL_BFL_NORE*1, @b, 1);
    end else dec(FDynCheckDelay);
  end;

  for i:=1 to MaxuLanAddress do begin
    if FULDynAddrArray[i]>daasError then begin
      buf[0]:= $10;
      SerNumToBuf(@buf[1],0);
      ULDrv.QuerySend(i, UL_CMD_GST, UL_BFL_NORE or UL_BFL_PRQ, @b, 5);
    end;
  end
end;

procedure TULDynAddrServer.RequestToSendID;
var b: byte;
begin
  if FFilter.RegisteredAt = nil then begin
    FFilter.Msg.cmd := UL_CMD_NCS;
    FFilter.FilterEvent := DoEvent;
    ULDrv.EventFilterRegister(FFilter);
  end;
  b := ULNCS_SID_RQ;
  ULDrv.QuerySend(0, UL_CMD_NCS, UL_BFL_NORE*1, @b, 1);
  FDynCheckEnabled := true;
  FDynCheckDelay := 5;

end;
{/TULDynAddrServer.}



end.
