old/PAS/Lines/lines.pas

uses graph;

var
  X : array [1..5000] of integer;
  Y : array [1..5000] of integer;
  N : integer;

Function Intercept(X11,Y11,X21,Y21,X12,Y12,X22,Y22:integer) : boolean;
var
 k1,k2,b1,b2,xx: real;
begin
  if (X11<>X21) and (X12<>X22) then
   begin
     xx:=Y11-Y21;
     k1:=(X11-X21);
     k1:=xx/k1;
     xx:=(Y12-Y22);
     k2:=(X12-X22);
     k2:=xx/k2;
     b1:=y11-k1*x11;
     b2:=y12-k2*x12;
        if (k1=k2) then
          begin
            if y12<>k1*x12+b1 then
             begin
              Intercept := false;
              exit
             end;
           Intercept := true;
           exit
          end;
     xx:=(b2-b1)/(k1-k2);
     if (xx>=X11)and (XX<=X21) then
      begin
        Intercept := true;
        exit
      end;
   end;
   if (X11=X21) and (X12<>X22) then
    begin
     xx:=(Y12-Y22);
     k2:=(X12-X22);
     k2:=xx/k2;
     b2:=y12-k2*x12;
     xx:=k2*x11+b2;
      if ((X11>X12) and(X11<X22)) and ((xx>Y11) and (xx<Y21)) then
       begin
         Intercept := true;
         exit
       end;
      Intercept:=false;
      exit
    end;

   if (X12=X22) and (X11<>X21) then
    begin
     xx:=Y11-Y21;
     k1:=(X11-X21);
     k1:=xx/k1;
     b1:=y11-k1*x11;
     xx:=k1*x12+b1;

      if ((X12>X11)and(X12<X21)) and ((xx>Y12)and(xx<Y22)) then
       begin
         Intercept := true;
         exit
       end;
      Intercept:=false;
      exit
    end;
    if (((y11>=y12)and(Y11<=y22)) or ((y12>=y12)and(y12<=y22))) and (x11=x22) then
      begin
        Intercept := true;
        exit
      end;
    Intercept:=false;
end;{Intercept}
{----------------------------------------------}
Procedure ReadFn;
var
 X1:integer;
 i:word;
 F:TEXT;
begin
  Assign(F,'input.txt');
  Reset(F);
  Read(F,N);
  for i := 1 to n do
   begin
     REad(F,X1);
     X[2*i-1] := X1;
     REad(F,X1);
     Y[2*i-1] := X1;
     REad(F,X1);
     X[2*i] := X1;
     REad(F,X1);
     Y[2*i] := X1;
   end;
end; {ReadFn}
{--------------------}
Procedure Init;
var
 grDriver: Integer;
 grMode: Integer;
 ErrCode: Integer;
begin
 grDriver := Detect;
 InitGraph(grDriver, grMode,' ');
 ErrCode := GraphResult;
 if ErrCode <> grOk then
  begin
   Writeln('Graphics error:', GraphErrorMsg(ErrCode));
   Halt(3);
  end
end; {Init}
{------------------------}
var
  i,j,k:word;
  m1,m2,max,cur : integer;
begin
  ReadFn;
  max:=0;
  for i := 1 to N*2 do
   begin
     for j:= 1 to N*2 do
      begin
       cur:=0;
       for k:=1 to N do
        begin
          if (i<>j) and (i<>(2*k-1)) and (j<>(2*k-1)) and (i<>(2*k)) and (j<>(2*k)) then
          if (intercept(x[i],y[i],x[j],y[j],x[2*k-1],y[2*k-1],x[2*k],y[2*k]))
           then inc(cur);
        end;
       if (Cur>max) then
        begin
         max:=cur;
         m1:=i;
         m2:=j;
        end;
      end;
   end;
  Init;
  SetColor(BLUE);
  for i:=1 to N do
   begin
     Line(X[i*2-1],Y[i*2-1],X[i*2],Y[i*2]);
     FillEllipse(X[i*2-1],Y[i*2-1],5,5);
     SetColor(I mod 16);
     FillEllipse(X[i*2],Y[i*2],5,5);
   end;
   asm
     mov ah, 08h
     int 21h
   end;
   SetColor(Green);
   Line(X[m1],Y[m1],X[m2],Y[m2]);
   asm
     mov ah, 08h
     int 21h
   end;
end.