program TstCan2;
{$define NEWCAN}
uses
  DebWin,
  ChnVirt,
  NumToStr,
  StopW,
 {$ifdef NEWCAN}
  ChnCan1,
 {$else}
  ChnCanGl,
  ChnCan1,
 {$endif}
  Crt;

const
  cVer = 'v1.00 ';

{$I sets.inc}

const
 {$ifNdef VerMC}
   {$ifdef NEWCAN}
  {  ParamStr = 'NAM=CAN1 ADD=$0300 CIS=0 SJA=0 IRQ=7 BTR=1000 LRB=20 LTB=200 BER=0 AER=0';}
                                                  {7}
    ParamStr = 'NAM=CAN1 ADD=$0300 CIS=0 SJA=0 IRQ=7 BTR=250 LRB=20 LTB=20 BER=0 AER=0';
   {$else}
    ParamStr = 'NAM=CAN1 ADD=$0300 CIS=0 SJA=0 IRQ=7 BTR=250 LRB=20 LTB=20';
   {$endif}
 {$else}
  ParamStr = 'NAM=CAN1 ADD=$2300 CIS=0 SJA=0 IRQ=5 BTR=250 LRB=20 LTB=20 BER=0 AER=0';
 {$endif}

const
  RecChnCanCt  : longint = 0; {pocitadlo prijatych zprav}
  RecErrCanCt  : longint = 0; {pocitadlo chyb pri prijmu zprav}

  fConnect : boolean  = False; {priznak nainicializovani CAN busu}

  pMyCAN        : pChnVirt = nil;

var
  RecCanFrame: tCanFrame; {prijimaci buffer}

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

function  GetChnCanState : tChState; forward; {vrati stav komunikacniho kanalu}

{--------------------------------------------------------}
function GetChnCanState : tChState;
begin
  if pMyCAN=nil then
       GetChnCanState:=CHS_Close
  else GetChnCanState:=pMyCAN^.ChState;
end;

{--------------------------------------------------------}
function CanComOpen:tChResult; {inicializace komunikace CAN}
var W:tChResult;
begin
 {$ifdef CAN2}
  pMyCAN:=New(pChnCan1, Init);    {dynamicke vytvoreni objektu}
 {$else}
  pMyCAN:=New(pChnCan1, Init);    {dynamicke vytvoreni objektu}
 {$endif}
  with pMyCAN^ do
  begin
    ChSetParam(ParamStr);
    W:=ChResult;
    if W<>res_OK then begin CanComOpen:=W; Exit; end;

    ChOpen;
    W:=ChResult;
    if W<>res_Ok then begin CanComOpen:=W; Exit; end;
    while ChReady<>CHS_Open do
    begin
      W:=ChResult;
      if W<>res_Ok then begin CanComOpen:=W; Exit; end;
    end;

    ChReceiveBuffer(@RecCanFrame,SizeOf(tCanFrame));
    W:=ChReceiveResult;
    if W<>Res_Ok then begin CanComOpen:=W; Exit; end;

    ChConnect;
    W:=ChResult;
    if W<>res_Ok then begin CanComOpen:=W; Exit; end;
    while ChReady<>CHS_Connect do
    begin
      W:=ChResult;
      if W<>res_Ok then begin CanComOpen:=W; Exit; end;
    end;
  end;
  fConnect:=True;
  CanComOpen:=Res_Ok;
end;

{--------------------------------------------------------}
procedure CanComClose; {zruseni komunikace CAN}
begin
  fConnect:=False;
  if pMyCAN<>nil then
  with pMyCAN^ do
  begin
    if ChState=CHS_Connect then
    begin
      ChDisConnect;
    end;
    if ChState=CHS_Open then
    begin
      ChClose;
    end;
    Dispose(pMyCAN,Done); pMyCAN:=nil;
  end;
end;

var
  SaveExit:Pointer;
  Key:char;

procedure MyExitProc; far;
begin
  ExitProc:=SaveExit;
  if (ExitCode<>0) then writeln('Prg - code: ', ExitCode, ' -- addr: $',
                   WordStrHex(Seg(ErrorAddr^)),':$',WordStrHex(Ofs(ErrorAddr^)));
 {$ifdef VerMC}
  {$ifdef Deb_Err}
    asm sti end;
    repeat
    until false;
  {$endif}
 {$endif}
end;

{--------------------------------------------------------}
var
  ch:Char;
  msg:tCanFrame;
  i:Byte;
  bCnt:Byte;
  res:tChResult;
  wLen:Word;
 {$ifdef NEWCAN}
  wTxRd:Word;
  pSubBufferRec:pBufferRec;
 {$endif}
Begin
  InitDebVyp;

  { inicializace exit procedury }
  SaveExit:=ExitProc;
  ExitProc:=@MyExitProc;

  fConnect:=FALSE;

  if CanComOpen<>Res_Ok then
  begin
    Writeln('Nepodarilo se otevrit komunikaci: ', pMyCan^.ChGetParam(''));
    RunError(255);
  end;

  if pMyCAN=nil then RunError(255);

  { test  vysilani pod prerusenim }
  FillChar(msg, sizeof(tCanFrame), 0);
  msg.IDENT:=$71B;
  msg.DLC:=1;
  for i:=0 to 19 do
  begin
    msg.Data[0]:=i;
    if pMyCan^.ChSendReady=CHS_SendReady then
    begin
      { pokud je kanal ChSendReady - nedoslo k zadne chybe }
      pMyCAN^.ChSend(@msg, msg.DLC);
      res:=pMyCAN^.ChSendResult;
      if (res<>Res_Ok) then
      begin
        writeln('Chyba');
      end;
    end
  end;

{  Delay(1000);}

{!@#  gCanStsArr[pChnCan1(pMyCan)^.CH_SJA].fTxPending:=TRUE;}
  I:=0;
  bCnt:=0;
  repeat
    FillChar(msg, sizeof(tCanFrame), 0);
    msg.IDENT:=$71B;
    msg.DLC:=1;

  {$ifdef NEWCAN}
   pError^.LockWin;
    with gCanStsArr[pChnCan1(pMyCan)^.CH_SJA] do
    begin
      gotoxy(1,1);
      write  ('IRQCnt:', WordStrHex(wIRQCnt),
              ',IRQProc:', WordStrHex(wIRQProcCnt),
              ',ITx:', WordStrHex(wITxCnt),
              ',IRx:', WordStrHex(wIRxCnt));
      ClrEol; writeln;
      write  ('IWL:', wIWarnLimitCnt, ',IBusOff:', wIBusOffCnt,
              ',IDO:', wIDataOverCnt, ',IES:', wIErrStateCnt,
              ',IAL:', wIArbitLostCnt, ',IBE:', wIBusErrCnt);
      ClrEol; writeln;
      write  ('TxReq:', wTxReqCnt, ',BusOff:', wBusOffCnt,
              ',RxCnt:', wRxCnt, ',TxCnt:', wTxCnt,
              ',TxFlush:', wTxFlushCnt);
      ClrEol; writeln;
    end; { with }
   pError^.UnlockWin;
  {$endif}


   pReceive^.LockWin;
    msg.Data[0]:=i;
    if pMyCan^.ChSendReady=CHS_SendReady then
    begin
      { pokud je kanal ChSendReady - nedoslo k zadne chybe }
      pMyCAN^.ChSend(@msg, msg.DLC);
      res:=pMyCAN^.ChSendResult;
      if (res=Res_Ok) then
      begin
       {$R-}
        Inc(i);
       {$R+}
      end;
    end
    else
    begin
      res:=pMyCAN^.ChSendResult;
      if Lo(res)=res_ErrCAN1_TxBuffOver then
      begin
{        pChnCan1(pMyCan)^._TryToStartTx;}
        { provadi se pres klavesnici }
      end;
    end;
    write  ('SendResult: ', WordStrHex(res));

    if pMyCan^.ChReceiveReady=CHS_ReceiveReady then
    begin
      pMyCan^.ChReceive(wLen);
      res:=pMyCan^.ChReceiveResult;

      writeln('-- ReceiveResult: ', WordStrHex(res),
              ', Channel:', ByteStrHex(Byte(gCanStsArr[pChnCan1(pMyCan)^.CH_SJA].ChannelState)));
      { pri vysilani nebo prijmu byla detekovana chyba,
        <v testu se pouze vysila> }
      if res<>Res_Ok then
      begin
        with pCanFrame(pMyCan^.CH_RMess)^ do
        begin
          {$ifdef NEWCAN}
           if ((STATUS and fs_NotValid)<>0)  then
           begin
              if ((STATUS and fs_DataOver)=0) and
                 ((STATUS and fs_BuffOver)=0) then
              begin
                with tErrorInfo(Addr(Data)^) do
                begin
                  Write('>> Cnt:', bCnt,',');
                  Write('STATUS:', ByteStrHex(STATUS), '--');
                  Write('IC:', ByteStrHex(bDetectErr));
                  Write(',ArbitLost:', ByteStrHex(bArbitLost),
                        ',ErrCode:', ByteStrHex(bErrCode),
                        ',ErrWarn:', bErrWarn,
                        ',RxErr:', bRxErrCnt,
                        ',TxErr:', bTxErrCnt);
                  ClrEol; Writeln;
                  write('>> ErrorCode: ');
                  case (bErrCode and sja_MskErrCode) shr sja_ShlErrCode of
                  0: write(' BitError');
                  1: write(' FormError');
                  2: write(' StuffError');
                  3: write(' OtherType');
                  else
                    write(' Chyba');
                  end;
                  case (bErrCode and sja_MskDir) shr sja_ShlDir of
                  0: write(' TX');
                  1: write(' RX');
                  else
                    write(' Chyba');
                  end;
                  case (bErrCode and sja_MskSeg) of
                  $00: write(' XXXXX');
                  $03: write(' StartOfFrame');
                  $02: write(' ID.28 to ID.21');
                  $04: write(' SRTR');
                  $05: write(' IDE');
                  $07: write(' ID.17 to ID.13');
                  $0F: write(' ID.12 to ID.5');
                  $0C: write(' RTR');
                  $0D: write(' Reserved bit1');
                  $09: write(' Reserved bit0');
                  $0B: write(' DataLenCode');
                  $0A: write(' DataField');
                  $08: write(' CRC sequence');
                  $18: write(' CRC delimiter');
                  $19: write(' ACK slot');
                  $1B: write(' ACK delimiter');
                  $1A: write(' End of frame');
                  $12: write(' Intermission');
                  $11: write(' ActiveError flag');
                  $16: write(' PassiveError flag');
                  $13: write(' TolerateDominant flag');
                  $17: write(' Error delimiter');
                  $1C: write(' Overload flag');
                  else
                    write(' Chyba');
                  end;
                  write(' -- Channel:', ByteStrHex(Byte(gCanStsArr[pChnCan1(pMyCan)^.CH_SJA].ChannelState)));
                  ClrEol; writeln;
                end;
              end;

              { zotaveni z BUS-OFF }
              if (STATUS and fs_BusOff)<>0 then
              begin

                { Ktera zprava nebyla odvysilana? }
                with gCanStsArr[pChnCan1(pMyCan)^.CH_SJA] do
                begin
                  wTxRd:=wTxRdBuffIx;
                  if wTxRd=0 then
                    wTxRd:=wTxMsgNo-1
                  else
                    Dec(wTxRd);

                  pSubBufferRec:=Addr(pTxMsgBuff^[wTxRd]);
                  write('>> Data: ', ByteStrHex(pSubBufferRec^.StandardFrame.DataArr[0]));
                  ClrEol; writeln;
                end;

                pChnCan1(pMyCan)^._BusOffRecovery;
              end;
           end;
          {$endif}
        end;
      end;
    end
    else
    begin
      ClrEol; Writeln;
    end;

   pReceive^.UnlockWin;

   { pocet pruchodu }
   Inc(bCnt);
{  if I=100 then break;}

{   Delay(500); }
   pError^.LockWin;
    gotoxy(1,5);
    write('Cnt:', bCnt,
         {$ifdef Deb}
          ', Status:', ByteStrHex(gCanStsArr[pChnCan1(pMyCan)^.CH_SJA].bSjaSts),
         {$endif}
          ', MessID:', ByteStrHex(i)); ClrEol;
   pError^.UnlockWin;
 {$ifNdef VerMC}
    if keypressed then
    begin
      ch:=readkey;
      case ch of
      '1':
        bCnt:=bCnt;
      '2':
         begin
           pChnCan1(pMyCan)^._AbortTx;
         end;
      '3':
         begin
           pChnCan1(pMyCan)^._ResumeTx;
         end;
      '4':
         begin
           pChnCan1(pMyCan)^._ResumeTxAtNextFrame;
         end;
      '5':
         begin
           pChnCan1(pMyCan)^._TryToStartTx;
         end;
      '6':
         begin
           pChnCan1(pMyCan)^._BusOffRecovery;
         end;
      end;
    end;
    Delay(100);
  until UpCase(ch)='X';
 {$else}
  until FALSE;
 {$endif}

  {!@#  pChnCan1(pMyCan)^._TryToStartTx;}

  { dovysilani a do prijimani vyslanych zprav }
  Delay(1000);

 {$ifdef NEWCAN}
  pReceive^.LockWin;
   with gCanStsArr[pChnCan1(pMyCan)^.CH_SJA] do
   begin
     gotoxy(1,1);
     write  ('IRQCnt:', WordStrHex(wIRQCnt),
             ',IRQProc:', WordStrHex(wIRQProcCnt),
             ',ITx:', WordStrHex(wITxCnt),
             ',IRx:', WordStrHex(wIRxCnt));
     ClrEol; writeln;
     write  ('IWL:', wIWarnLimitCnt, ',IBusOff:', wIBusOffCnt,
             ',IDO:', wIDataOverCnt, ',IES:', wIErrStateCnt,
             ',IAL:', wIArbitLostCnt, ',IBE:', wIBusErrCnt);
     ClrEol; writeln;
     write  ('TxReq:', wTxReqCnt, ',BusOff:', wBusOffCnt,
             ',RxCnt:', wRxCnt, ',TxCnt:', wTxCnt,
             ',TxFlush:', wTxFlushCnt);
     ClrEol; writeln;
   end;
  pReceive^.UnlockWin;
 {$endif}


  CanComClose;
end.
