{$A+,B+,D+,E-,F+,I+,L-,N-,O-,R-,S-,V-}
{$M 16384,0,655360}
{ctl-oo}
program irda;

uses dos,async4u,crt;

{define und undef}

const
  version='V0.3';
  {version 0.1=Test-Programm}
  {        0.2=Synchronisationsroutine ohne RESET}
  {        0.3=3-Leitungs-RS232}


  blksize=512;

  r00init=$0B;    {Rec. & Trans. enablen, Echo der Ctl-Char}
  r01init=$11;    {load new baudrate}
  r02init=$20;    {1.6us IRDA}
  r03init=$36;    {8 Bits,Startsync.}
  r04init=$41;    {LED1C als Output verwenden}
  r05init=$51;    {1.6us Puls-Empfang}
  r06init=$63;    {Empfindlichkeit:114nA}
  r07init=$74;    {neg. Flanke ignorieren}
  r08init=$81;    {Baudrate divider}
  r09init=$90;    {Baudrate divider}

  r21init=$50;    {Oszillator in HiPower-Mode}

  reg0_15=$D0;    {Zugriff auf untere Register 0-15}
  reg16_31=$D1;   {Zugriff auf obere Register 16-31}
  regvers=$Cf;    {Hardware-Version}

  sync08=$87;     {9600 Bit/s}
  sync09=$91;
  sync00=$08;     {Echo}

var
  com:byte;
  err:integer;
  last_char_rec:char;


function dth(x:word):char;

  {wandelt Zahl<16 in Char um (hex)}

begin
  x:=x and $f;
  if x>9 then dth:=chr(55+x) else dth:=chr(48+x);
end;


function dths(x,anz:word):string;

  {wandelt x in Hex-String um mit anz Stellen
  z.B. dths(17,2)='11' dths(17,4)='0011'}

var
  s:string[4];

begin
  s:=dth(x shr 12);
  s:=s+dth(x shr 8);
  s:=s+dth(x shr 4);
  s:=s+dth(x);
  dths:=copy(s,5-anz,5);
end;



procedure getanswer;

{diese routine wartet 0.2s auf zeichen vom IRDA-Chip}

var
  st,mi,se,hu:word;
  timebeg,timenow:longint;

begin
  gettime(st,mi,se,hu);
  timebeg:=st*360000+mi*6000+se*100+hu;
  repeat
    if async_buffer_check(last_char_rec) then write(dths(ord(last_char_rec),2),'  ');
    gettime(st,mi,se,hu);
    timenow:=st*360000+mi*6000+se*100+hu;
    if timenow<timebeg then timenow:=timenow+360000*24;
  until timenow>=timebeg+20;
  writeln;
end;


function trysync(baudrate:word):boolean;

var
  test:boolean;

begin
  write('Teste Baudrate ',baudrate,'  ');
  async_close;
  test:=async_open(com,baudrate,'N',1,8);
  async_send_cmd(reg0_15);
  async_send_cmd(sync08);
  async_send_cmd(sync09);
  async_send_cmd(r01init);
  getanswer;
  async_close;
  test:=async_open(com,9600,'N',1,8);
  async_send_cmd(sync00);
  async_send_cmd(sync00);
  getanswer;
  if last_char_rec=#8 then trysync:=true else trysync:=false;
end;


function tryallsync:boolean;

begin
  tryallsync:=false;
  if trysync(9600) then tryallsync:=true            {9k6}
  else begin
    if trysync(2) then tryallsync:=true             {56k8}
    else begin
      if trysync(3) then tryallsync:=true           {38k4}
      else begin
        if trysync(6) then tryallsync:=true         {19k2}
        else begin
          if trysync(1) then tryallsync:=true       {115k}
          else begin
            if trysync(4800) then tryallsync:=true  {4k8}
            else begin
              if trysync(2400) then tryallsync:=true   {2k4}
              else writeln('Keine Synchronisation m”glich!');
            end;
          end;
        end;
      end;
    end;
  end;
end;


procedure sendblock;

{diese prozedur sendet block und berprft empfangenen block}

var
  errpos,is,ir:word;
  err,err1:boolean;
  data:char;
  st,mi,se,hu:word;
  blknum,errblks,timebeg,timenow:longint;

begin
  blknum:=1;
  errblks:=0;
  repeat
    ir:=0;
    err:=false;
    err1:=false;
    for is:=0 to blksize-1 do begin
      async_send_data(chr(is mod 256));
      if async_buffer_check(data) then begin
        if ord(data)<>(ir mod 256) then begin
          err:=true;
          if not err1 then errpos:=ir;
          err1:=true;
        end;
        inc(ir);
      end;
    end;
    gettime(st,mi,se,hu);
    timebeg:=st*360000+mi*6000+se*100+hu;
    repeat
      if async_buffer_check(data) then begin
        if ord(data)<>(ir mod 256) then begin
          err:=true;
          if not err1 then errpos:=ir;
          err1:=true;
        end;
        inc(ir);
      end;
      gettime(st,mi,se,hu);
      timenow:=st*360000+mi*6000+se*100+hu;
      if timenow<timebeg then timenow:=timenow+360000*24;
    until timenow>=timebeg+2;
    if err or (ir<>blksize) then inc(errblks);
    gotoxy(1,wherey);
    write('Block:',blknum,' Fehlerhafte Bl”cke:',errblks);
    if err then write('      Z:',errpos);
    if ir<>blksize then write('      L:',ir,'     ');
    inc(blknum);
  until keypressed;
  data:=readkey;
  if data=#0 then data:=readkey;
end;


function initirda:boolean;

var
  test:boolean;

begin
  initirda:=true;
  if uart_16550 then writeln('UART:16550 kompatibel');
{  async_send_reset;}
  writeln('Device reset!');
  async_send_cmd(reg16_31);
  async_send_cmd(regvers);
  write('Hardware-Version:');
  getanswer;
  if last_char_rec<>#$C2 then begin
    initirda:=false;
    writeln('Unbekannte Hardwareversion');
  end;
  async_send_cmd(reg0_15);
  write('Echo,Tx,Rx aktivieren:');
  async_send_cmd(r00init);
  getanswer;
  write('1.6us IRDA');
  async_send_cmd(r02init);
  getanswer;
  write('8 Databits, Startsynchronisation');
  async_send_cmd(r03init);
  getanswer;
  write('LED1C als Ausgang:');
  async_send_cmd(r04init);
  getanswer;
  write('1.6us als Empfangspulsbreite:');
  async_send_cmd(r05init);
  getanswer;
  write('Empf.:114nA');
  async_send_cmd(r06init);
  getanswer;
  write('Neg. Flanke ignorieren:');
  async_send_cmd(r07init);
  getanswer;
  write('Baudratedivider auf 115kBit:');
  async_send_cmd(r08init);
  async_send_cmd(r09init);
  getanswer;
  write('Oszillator im HiPower-Mode:');
  async_send_cmd(reg16_31);
  async_send_cmd(r21init);
  getanswer;
  write('Oszillator im HiPower-Mode:');
  async_send_cmd(r07init);
  getanswer;
  write('Baudrate 115kBit:');
  async_send_cmd(reg0_15);
  async_send_cmd(r01init);
  getanswer;
  async_close;
  test:=async_open(com,1,'N',1,8);
end;


begin
  writeln;
  writeln('         * * * IRDA-Test   ',version,' * * *');
  writeln('         (c) 96,97 by L. R. Matzinger');
  writeln;
  com:=1;
  last_char_rec:=' ';
  if paramcount>=1 then begin
    val(paramstr(1),com,err);
    if (err>0) or (com<1) or (com>4) then com:=1;
  end;
  writeln('COM-Port:',com);
  async_init;
{
  if not async_open(com,9600,'N',1,8) then writeln('COM-Port nicht gefunden!')
}
  if not async_open(com,1,'N',1,8) then writeln('COM-Port nicht gefunden!')
  else begin
{
    if tryallsync then begin
      if initirda then begin
        writeln('Initialisierung beendet');
}
        writeln('Sende ',blksize,'B-Testbl”cke (Tastendruck beendet Senderoutine)');
        sendblock;
{
      end;
    end;
}
  end;
  async_close;
end.