program azimuth;

uses crt,graph;

const bperror=50;

var i,gd,gm,C:integer;

pw1,pw2:array[1..1023] of word;

str1:string;

function getcap(index:integer):integer;

label a1,a2;

var a,b,b1,b2,k2,k1,k9,k3,k,z:integer;

begin

port[$378]:=255;port[$37a]:=1;

delay(bperror);

z:=port[$379];

if index=1 then begin k1:=5;k9:=13;k3:=7;k2:=15;port[$378]:=0;end

else begin k1:=1;k9:=9;k3:=3;k2:=11;port[$378]:=0;end;

b:=0;B1:=0;B2:=0;C:=0;

repeat

port[$37a]:=k1;

delay(bperror);

IF port[889]<>Z THEN begin c:=768;break;end;

port[$37a]:=k9;

delay(bperror);

IF port[889]<>Z THEN begin c:=512;break;end;

port[$37a]:=k3;

delay(bperror);

IF port[889]<>Z THEN begin c:=256;break;end;

c:=0;

port[890]:=k2;{c:=0;}

until 1=1;

delay(bperror);

b:=128;A:=64;

while a>=1 do begin

port[888]:=b;

delay(bperror);

if port[889]<>z then b:=b+a else b:=b-a;

IF A=1 THEN break;

A:=ROUND(A/2);

end;

getcap:=(b+c);

end;

procedure setcap(index:integer);

var k1,k2:byte;

begin

if index>=768 then begin

k1:=4;k2:=index-768

end;

if (index>=512)AND(INDEX<768) then

begin

k1:=12;

k2:=index-512;

end;

if (index>=256)AND(INDEX<512) then

begin

k1:=6;k2:=index-256;

end;

if index<256 then begin

k1:=14;k2:=index;

end;

port[888]:=k2;

port[890]:=k1;

end;

procedure drawgraph1;

begin

setcolor(lightgray);

i:=15;

outtextxy(40,440,'320');

outtextxy(620,440,'60');

outtextxy(320,440,'180');

setcolor(darkgray);

while i<=192 do

begin

line(10,i,660,i);i:=i+20;

end;

i:=10;

while i<=660 do

begin

line(i,10,i,192);i:=i+20;

end;

i:=235;

while i<=440 do

begin

line(10,i,660,i);i:=i+20;

end;

i:=10;

while i<=660 do

begin

line(i,235,i,440);i:=i+20;

end;

outtextxy(200,205,'Сбор данных о диапазоне...');

for i:=100 to 740 do

if i mod 2 = 0 then begin

setcap(i);

delay(10*bperror);

pw1[i]:=round(getcap(2)/2-150);

SETCOLOR(GREEN);

line(i-99,185-round(pw1[I]/1.5)+10,i-101,185-round(pw1[i-2]/1.5)+10);

end;

setfillSTYLE(1,0);

BAR(200,205,470,215);

end;

procedure drawgraph2(index:word);

var stall:integer;pgc1,pgc2,gc1,gc2,sgc:word;

begin

stall:=getcap(1);

if stall<250 then begin

setcolor(15);outtextxy(200,205,'Необходимо настроить антенну');

repeat until getcap(1)>250;

stall:=250;

end;

setfillstyle(1,0);bar(200,205,470,215);

setcolor(15);outtextxy(200,205,'Запустите двигатель');

repeat delay(bperror) until abs(getcap(1)-stall)>3;

setfillstyle(1,0);bar(200,205,470,215);

setcolor(lightgreen);sgc:=getcap(2);

pgc2:=getcap(2);pgc1:=getcap(1);

repeat

setcap(index);

delay(bperror);

gc1:=getcap(1);gc2:=getcap(2);

if pgc1>gc1 then begin line(765-gc1*3,350+(sgc-gc2),765-pgc1*3,350+(sgc-pgc2));delay(5*bperror);

pgc1:=gc1;pgc2:=gc2;

pw2[gc1]:=gc2;

end;

until gc1<40;

end;

function selectstation:word;

var eq,neq:word;

begin

eq:=0;neq:=0;

for i:=100 to 740 do

if pw1[i]>eq then begin neq:=i;eq:=pw1[i];end;

setcolor(lightred);

line(neq-99,round(eq/1.5),neq-99,round(eq/1.5)+20);

selectstation:=neq;

end;

function select:word;

var eq,neq:word;

begin

eq:=0;neq:=0;

for i:=40 to 240 do

if pw2[i]>eq then begin neq:=i;eq:=pw2[i];end;

setcolor(lightred);

line(765-neq*3,350,765-neq*3,370);

select:=neq;

end;

begin

gd:=detect;

gm:=0;

initgraph(gd,gm,'.');

drawgraph1;

str(selectstation,str1);

setcolor(white);

str1:='Максимум на частоте '+str1;

outtextxy(10,460,str1);

drawgraph2(selectstation);

str(round(select/255*360),str1);

str1:='Азимут '+str1;

setcolor(white);

outtextxy(300,460,str1);

outtextxy(400,460,'Построение закончено.');

readln;

closegraph;

end.