program camcheck;

uses crt,format,ucamac;


procedure error(i:integer);
begin
 case i of 1:writeln('dataway display fail to answer x');
           2:writeln('dataway display fail to answer q');
           3:writeln('cannot enable lam on dataway');
           4:writeln('cannot set lam on dataway');
           5:writeln('error in reading and testing lam pattern');
           6:writeln('error in reading lam pattern');
           7:writeln('you abort the lam test');
 end;
 if not enquire('continue ')then begin
  writeln('program aborted');
  halt;
 end;
end;

procedure testlam(ndataway:integer);
var
    dummy,i,j:word;
    ch:char;
begin
 writeln('lam test');
 camac(ndataway,0,26,dummy);
 if not xcamac then error(1);
 if not qcamac then error(2);
 camac(ndataway,0,27,dummy);
 if not xcamac then error(1);
 if not qcamac then error(3);
 camac(ndataway,0,25,dummy);
 if not xcamac then error(1);
 if not qcamac then error(2);
 camac(ndataway,0,8,dummy);
 if not xcamac then error(1);
 if not qcamac then error(4);
 if not lamonstation(ndataway) then error(5);
 if rlam=0 then error(6);
 camac(ndataway,0,10,dummy);
 writeln('now try to press on lam button or press any key');
 repeat
 until lam or keypressed;
 if lam then writeln('lam discovered');
 if keypressed then begin
  ch:=readkey;
  error(7);
 end;
 camac(ndataway,0,10,dummy);
 writeln('lam test finished');
end;

procedure testrw(ndataway:integer);
const max=1000;
var
    i:word;
    j,jj:longint;
begin
 writeln('test r/w lines');
 for i:=1 to max do  begin
  if (i mod 100)=0 then write('.');
  j:=random($ffff)+(1 shl 16)*random($ff);
  camac2(ndataway,0,16,j);
  camac2(ndataway,0,0,jj);
  if not xcamac then error(1);
  if not qcamac then error(2);
  if (jj<>j) then begin
     write('error write ');write(hex(j shr 8,4),hex(j and $ff,2));writeln;
     write('      read  ');write(hex(jj shr 8,4),hex(jj and $ff,2));writeln;
     write('      diff  ');write(hex((jj xor j) shr 8,4),hex((jj xor j) and $ff,2));writeln;
   ret;
  end;
 end;
 writeln;
 writeln('end of r/w test');
end;

procedure testf(ndataway:integer);
var status,dummy,a,f:word;
    dummy_slot:integer;
begin
 dummy_slot:=ndataway-1;
 if dummy_slot=0 then dummy_slot:=2;
 writeln('f test');
 camac(ndataway,1,26,dummy);{enable monitor mode}
 for f:=0 to 31 do
  for a:=0 to 15 do begin
   camac(dummy_slot,a,f,dummy);
   camac(ndataway,0,1,status);
   if (status<>((f shl 4) or a) and $1ff) then writeln(^G'problem in f= ',f,' a= ',a);
  end;
  writeln('end of f test');
  zcamac;
  camac(ndataway,0,1,status);
  if (status and $400 )<>0 then
   writeln('z ok')
  else
   writeln(^G'z bad ',status);
  ccamac;
  camac(ndataway,0,1,status);
  if (status and $800 )<>0
   then writeln('c ok')
  else writeln(^G'c bad');
  clearinhibit;
  if inhibit then writeln(^G'ploblem to clear inhibit');
  setinhibit;
  camac(ndataway,0,0,status);
  if not inhibit then writeln(^G'problem to set inhibit');
  clearinhibit;
end;



procedure demande(var ndataway:word);
begin
 testonline;
 repeat
  readbd('give dataway display station ',ndataway,ndataway);
 until ndataway in [1..23];
 writeln('be sure dataway monitor switch is on monitor position');
 write('press return');
 readln;
end;


procedure doit;
var
 ndataway,dummy:word;
begin
 zcamac;
 ndataway:=1;
 demande(ndataway);
 camac(ndataway,1,24,dummy);{disable monitor mode}
 if not xcamac then error(1);
 if not qcamac then error(2);
 testrw(ndataway);
 testf(ndataway);
 testlam(ndataway);
 camac(ndataway,1,26,dummy);{enable monitor mode}
end;



begin
 randomize;
 testonline;
 clrscr;
 doit;
 writeln('end of test, press "return"');
 repeat until keypressed;
end.