program CanCom;

{$I Sets.Inc}

uses
  Kernel,
  Crt,
  ChnVirt,
  Timer,
  ChnCan1,            { HW komunikace pres Can }
  uString,            { dekodovani prikazove radky }
  NumToStr;           { prevody }

function  CanComOpen : tChResult; forward; {inicializace kanalu a nastaveni stavu Connect}
procedure CanComClose; forward;            {zruseni Connect a deinicializace kanalu}


const
 {$ifdef VerMC}
  Can_Addr  = '$2240';
  Can_IRQ   = '5';
 {$else}
  Can_Addr  = '$0300';
  Can_IRQ   = '0';
 {$endif}


  ParamStr = 'NAM=CAN1 ADD='+Can_Addr+' IRQ='+Can_IRQ+' BTR=500 SJA=0 CIS=0 LRB=20 LTB=5';

const
  MyCAN    : pChnVirt = nil;   {ukazatel na komunikacni objekt}

var
  SndCanFrame: tCanFrame; {vysilaci buffer}
  RecCanFrame: tCanFrame; {prijimaci buffer}

  PomCanTimer: tTimer;    {pomocny casovac}
  CanTstTime : longint;   {vypocitany maximalni cas pro cekani na TstConnect}


{--------------------------------------------------------}
function CanComOpen:tChResult; {inicializace komunikace CAN}
var W:tChResult;
begin
  writeln(CanFO,'Wil: Init');
  writeln(      'Wil: Init');
  MyCAN:=New(pChnCan1,Init);    {dynamicke vytvoreni objektu}
  with MyCAN^ do
  begin
    with SndCanFrame do
    begin
      RTR:=0;
      XTD:=1;
      DLC:=8;
      STATUS:=0;
    end;
    writeln(CanFO,'Wil: ChSetParam=',ParamStr);
    writeln(      'Wil: ChSetParam=',ParamStr);
    ChSetParam(ParamStr);
    W:=ChResult;
    writeln(CanFO,'Wil: ChResult=$',WordStrHex(W));
    writeln(      'Wil: ChResult=$',WordStrHex(W));
    if W<>res_OK then begin CanComOpen:=W; Exit; end;

    writeln(CanFO,'Wil: ChOpen');
    writeln(      'Wil: ChOpen');
    ChOpen;
    W:=ChResult;
    writeln(CanFO,'Wil: ChResult=$',WordStrHex(W));
    writeln(      'Wil: ChResult=$',WordStrHex(W));
    if W<>res_Ok then begin CanComOpen:=W; Exit; end;
    while ChReady<>CHS_Open do
    begin
      W:=ChResult;
      writeln(CanFO,'Wil: ChResult=$',WordStrHex(W));
      writeln(      'Wil: ChResult=$',WordStrHex(W));
      if W<>res_Ok then begin CanComOpen:=W; Exit; end;
    end;

    writeln(CanFO,'Wil: ChReceiveBuffer');
    writeln(      'Wil: ChReceiveBuffer');
    ChReceiveBuffer(@RecCanFrame,SizeOf(tCanFrame));
    W:=ChReceiveResult;
    writeln(CanFO,'Wil: ChReceiveResult=$',WordStrHex(W));
    writeln(      'Wil: ChReceiveResult=$',WordStrHex(W));
    if W<>Res_Ok then begin CanComOpen:=W; Exit; end;

    writeln(CanFO,'Wil: ChConnect');
    writeln(      'Wil: ChConnect');
    ChConnect;
    W:=ChResult;
    writeln(CanFO,'Wil: ChResult=$',WordStrHex(W));
    writeln(      'Wil: ChResult=$',WordStrHex(W));
    if W<>res_Ok then begin CanComOpen:=W; Exit; end;
    while ChReady<>CHS_Connect do
    begin
      W:=ChResult;
      writeln(CanFO,'Wil: ChResult=$',WordStrHex(W));
      writeln(      'Wil: ChResult=$',WordStrHex(W));
      if W<>res_Ok then begin CanComOpen:=W; Exit; end;
    end;
  end;
  CanComOpen:=Res_Ok;
  PomCANTimer.SaveTime;
end;

{--------------------------------------------------------}
procedure CanComClose; {zruseni komunikace CAN}
begin
  if MyCAN<>nil then
  with MyCAN^ do
  begin
    if ChState=CHS_Connect then
    begin
      writeln(CanFO,'Wil: ChDisConnect');
      writeln(      'Wil: ChDisConnect');
      ChDisConnect;
      while ChReady<>CHS_DisConnect do ;
    end;
    if ChState=CHS_Open then
    begin
      writeln(CanFO,'Wil: ChClose');
      writeln(      'Wil: ChClose');
      ChClose;
      while ChReady<>CHS_Close do ;
    end;
    writeln(CanFO,'Wil: Done');
    writeln(      'Wil: Done');
    Dispose(MyCAN,Done); MyCAN:=nil;
  end;
end;

{--------------------------------------------------------}
var
  W:word;

Begin
  ClrScr;

  StartMain(100,254);
  InitInterruptStack(1,254);
  StartTimeSlicing(8);

  W:=CanComOpen;
  CanComClose;
  W:=CanComOpen;
  CanComClose;
  W:=CanComOpen;
  if W<>res_Ok then
  begin
    CanComClose;
  end;

  repeat
    write('*');
    Wait(1);
  until keypressed;
End.
