program geopol;
(******* geometryczne znajdywanie pierwiastka kwadratowego ********)
      
  unit zbior:class;
  end zbior;
  
  unit punkt:zbior class;
  var x,y:real;
  
    unit rowne:function (a:punkt):boolean;
    begin
      result:=(a.x=x) and (a.y=y);
    end rowne;
 
    unit odleglosc:function (a:punkt):real;
    begin
      if a=/=none then
        result:=sqrt((x-a.x)*(x-a.x)+(y-a.y)*(y-a.y))
      fi
    end odleglosc;
 
  end punkt;  

  unit rozwiaz:function(a,b,c:real):punkt;
  (* Funkcja rozwiazuje rownanie kwadratowe i jesli ma rozwiazanie
     to zwraca je na wspolrzednych punktu*)
    var d:real;
  begin
    if (a=/=0) or (b=/=0) then
      if a=0 then
        result:=new punkt;
        result.x:=-c/b;
        result.y:=-c/b;
      else
        d:=b*b-4*a*c;
        if d>=0 then
          result:=new punkt;
          result.x:=(-b+sqrt(d))/(2*a);
          result.y:=(-b-sqrt(d))/(2*a);
        fi
      fi
    fi;
  end rozwiaz;
   
  unit odcinek:zbior class;
  var a,b:punkt;
  
    unit dlugosc:function:real;
    begin
      result:=a.odleglosc(b);
    end dlugosc;
  
  end odcinek;

  unit okrag:zbior class;
  var o:punkt,
      r:real;
  
    unit przeczokreg:function (a:okrag):prosta;
    var pom1,pom2:real;
    begin
      if a=/=none then
        pom1:= r*r-o.x*o.x-o.y*o.y;
        pom2:= a.r*a.r-a.o.x*a.o.x-a.o.y*a.o.y;
        result := new prosta;
        result.a:=2*(a.o.x-o.x);
        result.b:=2*(a.o.y-o.y);
        result.c:=pom2-pom1;
      fi
    end przeczokreg;
     
    unit przeczprost:function(l:prosta):odcinek;
    var pom:punkt;
    
    begin
      if l.a=/=0 then
        pom:=rozwiaz(1+(l.b/l.a)*(l.b/l.a),2*(l.b*l.c/l.a+o.x*l.b/l.a-o.y),
                     2*o.x*l.c/l.a+(l.c*l.c)/(l.a*l.a)+o.x*o.x+o.y*o.y-r*r);
        result:=new odcinek;
        result.a:=new punkt;
        result.a.x:=-(pom.x*l.b/l.a+l.c/l.a);
        result.a.y:=pom.x;
        result.b:=new punkt;
        result.b.x:=-(pom.y*l.b/l.a+l.c/l.a);
        result.b.y:=pom.y;
      else
        pom:=rozwiaz(1+(l.a/l.b)*(l.a/l.b),2*(l.a*l.c/l.b+o.x*l.a/l.b-o.y),
                     2*o.x*l.c/l.b+(l.c*l.c)/(l.b*l.b)+o.x*o.x+o.y*o.y-r*r);
        result:=new odcinek;
        result.a:=new punkt;
	result.a.y:=-(pom.x*l.a/l.b+l.c/l.b);
	result.a.x:=pom.x;
        result.b:=new punkt;
	result.b.y:=-(pom.y*l.a/l.b+l.c/l.b);
	result.b.x:=pom.y;
      fi;
    end przeczprost;
  end okrag;

  unit prosta:zbior class;
  var a,b,c:real;
   
     unit przeczprost:function (l:prosta):punkt;
     var pom:real;
     begin
       if (l=/=none) and (not rownolega(l)) then
         pom:= 1/(l.a*b-l.b*a);
         result:=new punkt;
	 result.x:=-pom*(b*l.c-c*l.b);
	 result.y:=pom*(a*l.c-c*l.a);
       fi
     end przeczprost;

     unit rownolega:function(l:prosta):boolean;
     begin
       if l=/=none then
         if a*l.b-b*l.a=0 then
           result:=true;
         else
           result:=false;
         fi        
       fi
     end rownolega;
     
   end prosta;

   unit ekran:iiuwgraph class;

   (* Klasa obslugujaca ekran *)
   const skala=10,
         wysekr=348,
	 szerekr=620,
	 poczpoz=szerekr div 2,
	 poczpio=wysekr div 2,
	 p=3,
	 q=4,
	 aspekt=p/q;
   
   unit inchar:function:integer;
   begin
     while result=0 do
       result:=inkey;
     od;
   end inchar;
   
   unit punktnaekr:class;
   var x,y:integer;
   end punktnaekr;
   
   unit naekranie:function(a:punktnaekr):boolean;
   begin
     result:=((a.x>0) and (a.x<szerekr)) and ((a.y>0) and (a.y<wysekr));
   end naekranie;
   
   unit rysodc:procedure(a,b:punkt);
   (* Procedura rysuje odcinek o ile znajduje sie caly w ekranie *)
   var c,d:punktnaekr;
   begin
     c:=new punktnaekr;
     d:=new punktnaekr;
     c.x:=entier(a.x*skala+poczpoz);
     c.y:=entier(a.y*skala*aspekt+poczpio);
     d.x:=entier(b.x*skala+poczpoz);
     d.y:=entier(b.y*skala*aspekt+poczpio);
     if naekranie(c) and naekranie(d) then
       call move(c.x,c.y);
       call draw(d.x,d.y);
     fi;
   end rysodc;
   
   unit rysokr:procedure(o:okrag);
   (* Procedura rysuje okrag wedlug algorytmu podanego przez p.Jankowskiego *)
   
   var x,y,r,pp,pp4,pp8,qq,qq4,qq8,fx,fy,fs:integer;
   
     unit rysczw:procedure(x,y:integer);
     (* Procedura rysuje cztery punkty symetryczne wzgledem *)
     (* osi ukladu wspolrzednych *)
     var a:punktnaekr;
   
     begin
       a:=new punktnaekr;
       a.x:=entier(x+poczpoz+o.o.x*skala);
       a.y:=entier(y+poczpio+o.o.y*skala*aspekt);
       if naekranie(a) then
         call move(a.x,a.y);
         call draw(a.x,a.y);
       fi;
       a.x:=entier(-x+poczpoz+o.o.x*skala);
       if naekranie(a) then
         call move(a.x,a.y);
         call draw(a.x,a.y);
       fi;
       a.y:=entier(-y+poczpio+o.o.y*skala*aspekt);
       if naekranie(a) then
         call move(a.x,a.y);
         call draw(a.x,a.y);
       fi;
       a.x:=entier(x+poczpoz+o.o.x*skala);
       if naekranie(a) then
         call move(a.x,a.y);
         call draw(a.x,a.y);
       fi;
     end rysczw;
   
   begin
     r:=entier(o.r*skala);
     x:=0;
     y:=r;
     pp:=p*p;
     pp4:=4*pp;
     pp8:=8*pp;
     qq:=q*q;
     qq4:=4*qq;
     qq8:=8*qq;
     fx:=0;
     fy:=qq8*r;
     fs:=pp4-qq4*r+qq;
     while fx<fy do
       call rysczw(x,y);
       x:=x+1;
       fx:=fx+qq8;
       if fs<=0 then 
         fs:=fs+fx+pp4;
       else
         y:=y-1;
	 fy:=fy-qq8;
	 fs:=fs+fx+pp4-fy;
       fi;
     od;
     fs:=fs-(fx-fy) div 2+3*(pp-qq);
     while y>=0 do
       call rysczw(x,y);
       y:=y-1;
       fy:=fy-qq8;
       if fs<=0 then
         x:=x+1;
	 fx:=fx+pp8;
	 fs:=fs+fx-fy+qq4;
       else
         fs:=fs-fy+qq4;
       fi;
     od;
   end rysokr;
   
   unit poczatek:procedure;
   begin
     call gron(0);
   end poczatek;
   
   unit koniec:procedure;
   begin
     call groff;
   end koniec;
   
   unit czysc:procedure;
   begin
     call cls;
   end czysc;
   
   end ekran;
   
   var pr,ppr:prosta,
       okg:okrag,
       ppom,po,pk,pp:punkt,
       odp:odcinek,
       okl,okp:okrag,
       i:real,
       j:integer,
       a:char,
       ekr:ekran;
       
   begin
   ekr:=new ekran;
   do
     i:=0;
     while (i<1) or (i>9) do
       writeln("Podaj dlugosc odcinka");
       readln(i);
     od;
     call ekr.poczatek;
     call ekr.czysc;
     pr:=new prosta;
     pr.a:=0;
     pr.b:=1;
     pr.c:=0;
     pp:=new punkt;
     pp.x:=-1;
     pp.y:=0;
     pk:=new punkt;
     pk.x:=i;
     pk.y:=0;
     call ekr.rysodc(pp,pk);
     okg:=new okrag;
     okg.o:=new punkt;
     okg.o.x:=(i-1)/2;
     okg.o.y:=0;
     okg.r:=(i+1)/2;
     call ekr.rysokr(okg);
     okl:=new okrag;
     okl.o:=pp;
     okl.r:=2;
     call ekr.rysokr(okl);
     okp:=new okrag;
     okp.o:=new punkt;
     okp.o.x:=1;
     okp.o.y:=0;
     okp.r:=2;
     call ekr.rysokr(okp);
     ppr:=okl.przeczokreg(okp);
     odp:=okg.przeczprost(ppr);
     call ekr.rysodc(odp.a,odp.b);
     ppom:=pr.przeczprost(ppr);
     j := inchar;
     call ekr.koniec;
     writeln("Punkt przeciecia,x=",ppom.x," y=",ppom.y);
     writeln("punkt gorny,x=",odp.a.x," y=",odp.a.y);
     writeln("Dlugosc d=",ppom.odleglosc(odp.a));
     writeln("   CZY CHCESZ JESZCZE RAZ?(T/N)  ");
     readln(a);
     if (a=/='t') and (a=/='T') then exit fi;
   od;
   end;