Закрасить борозды

Program 22 борозды;
uses crt;
const 
MaxN = 100;
MaxV = 2*MaxN;
MaxR = 100;
var  
 x,y, List,kG :array [1..MaxV] of integer; 
 G:array [1..MaxV,1..MaxR] of byte;
 x0,y0,N,i,j,k,v1,v2,EvenV : integer; 
 Q:array [1..MaxV] of byte; 
 Free : array [1..MaxV] of boolean; 
 BegQ, EndQ : integer;
//Получение данных из файла
procedure InputData; 
var i:integer;
var f:text;
begin 
 //прочитаем данные из файла
 assign(f,'input.txt');
 reset(f);
 readln(f,N);
 for i:=1 to N do 
   readln(f,x[2*i-1],y[2*i-1],x[2*i],y[2*i]); 
 close(f);
end; 
//Добавление вершин в Граф
procedure AddNode(i,j:integer); 
begin 
  //Граф будем сохранять в массив Список вершин
 List[i]:=j; 
 kG[i]:=0;
end; 
//Процедура добавления ребра в Граф
procedure AddEdge(i,j:integer); 
begin 
 inc(kG[i]); G[i,kG[i]]:=j;
 inc(kG[j]); G[j,kG[j]]:=i; 
end; 
//Функция анализа Графа на степени
function Found (t:integer; var v:integer):boolean; 
begin 
v:=1;
while (v<=K) and ((x[List[v]]<>x[t]) or (y[List[v]]<>y[t])) do 
  inc(v);
Found :=v<=k; 
end; 
//Инициализация Графов
procedure InitGraph;
var
 i:integer;
begin 
k:=2;
 //Добавим вершину 1 и 2
 AddNode(1,1);
 AddNode(2,2);
 AddEdge(1,2);
//Тепер найдем количество вершин по условию
for i:=2 to N do 
begin 
if not Found(2*i-1,v1) 
then 
  begin 
  inc(k);
  AddNode(k,2*i-1);
  end;
if not Found(2*i,v2) 
then 
  begin 
  inc(k);
  AddNode(k,2*i);
  end;
 AddEdge(v1,v2) 
end; 
end;
//Количество вершин четных и нечетных 
procedure Count(var EvenV,x0,yO:integer); 
var
 i:integer;
begin 
EvenV:=0; 
x0:=x[1];
y0:=y[1]; 
for i:=1 to k do 
if Odd(kG[i]) then 
  begin 
x0:=x[List[i]];
y0:=y[List[i]];
  end 
else 
  inc(EvenV); 
end;
//Добавление в Структур
у данных в очереди
procedure Put(i:integer); 
begin 
inc(EndQ);
Q[EndQ]:=i;
Free[i]:=false;
end;
//Получение элемента из очереди
procedure Get(var i:integer);
begin 
 i:=Q[BegQ]; 
 inc(BegQ);
end;
//Функция проверяюшая граф на связанность
function Connected:boolean;
var
 i,j:integer;
begin 
  for i:=1 to k do Free[i]:=true;
    BegQ:=1;
    EndQ:=0;
    Put(1);
    while (BegQ<=EndQ) do 
       begin 
       Get(i); 
       for j:=1 to kG[i] do 
      if Free[G[i,j]] then Put(G[i,j]); 
      end; 
    Connected:=false; 
    for i:=1 to N do 
    if Free[i] then exit; 
    Connected:=true; 
end; 
var out:text;
begin 
 assign(out,'output.txt');
 rewrite(out);
 InputData;
 InitGraph; 
 Count(EvenV,x0,y0);  
 if Connected or ((EvenV=K) or (EvenV=K-2)) 
   then 
     begin 
      writeln(out,'YES'); 
      writeln(out,x0,' ',y0) 
    end 
else writeln(out,'NO');
close(out); 
readln;
readln;
end.