Kopia Multimetr.txt

procedure parametry_trans(adr:word);

var x,y:word; fclk, f :real;N:integer;

begin

adr:=$3f8;
fclk:=1843200;
f:=1200;
N:=trunc(fclk/(f*16));
x:=N mod 256;
port[adr+3]:=$80;
y:=N div 256;
port[adr+0]:=x;
port[adr+1]:=y;

port[adr+3]:=$06;

port[adr+1]:=$0;

end;

procedure czysc_bufory(adr:word);
var a:byte;
begin
a:=port[adr+0];
a:=port[adr+5];

end;

procedure wyslij_znak(adr:word);

var temp: word;

begin 
	repeat
		temp:=port[adr+5];
		temp:=temp and $20;
	until(temp=$20);
	
	port[adr+4]:=2;
	port[adr+0]:=ord('A');
	port[adr+0]:=0;

end;

function spr(adr: word):byte;
var  i,imax: longint;
     b,a:byte;

begin
     i:=1;
     imax:=100000;
     b:=0;
     repeat

          a:=port[adr+5];
          a:=a and 1;
          i:=i+1;

     until (i=imax) or (a=1);

      if a=1 then
         begin
             b:=1;
             spr:=b;
         end;
end;


procedure odczyt(adr:word);

var i,j:integer;
	odb:array[1..14] of char;

begin
	
	i:=1;
	port[adr+$4]:=1;
	while(spr(adr)=1) AND (i<15)
	
	begin
		odb[i]:=port[adr];
		i:=i+1;
	end;

	if (i>1) then 
		begin
			for j:=1 to i
			begin
				write(odb[j]);
			end;
			clrscr;
		end;
	else
	write('Blad odczytu');
end;



var adr:word;
	i:integer;
	adr:=$3F8;
	


Begin

	parametry_trans(adr);
	
	for i:= 1 to 10 do
	begin
		czysc_bufory(adr);
		wyslij_znak(adr);
		odczyt(adr);

		delay(5000);

		
	end;



End.