Równanie okręgu wpisanego - sposób konstrukcyjny

program untitled;

uses crt,math;
type TPoint = record
        x,y:Real;
     end;
     TArray=array[1..3]of Real;
procedure quadratic(a,b,c:Real;var x1,x2:Real);
var delta:Real;
begin
  delta := sqr(b) - 4 * a * c;
  if delta >= 0 then
  begin
    x1 := (-b - sqrt(delta))/(2*a);
    x2 := (-b + sqrt(delta))/(2*a);
  end;
end;

procedure bisectoreq(pa,pb,pc:TPoint;var b1,b2:TArray);
var l1,l2:TArray;
    r,t1,t2,temp:Real;
    a,b,c,d:TPoint;
    i:byte;
    acute:boolean;
begin
  //Rownanie prostej zawierajacej pierwsze ramie kata
  l1[1] := -(pb.y - pa.y);
  l1[2] := pb.x - pa.x;
  l1[3] := -pb.x * l1[1] - pb.y * l1[2];
  //Rownanie prostej zawierajacej drugie ramie kata
  l2[1] := -(pc.y - pb.y);
  l2[2] := pc.x - pb.x;
  l2[3] := -pc.x * l2[1] - pc.y * l2[2];
  {
  a.x := -(l1[3] * l2[2] - l2[3] * l1[2])/(l1[1]*l2[2]-l2[1]*l1[2]);
  a.y := -(l1[1] * l2[3] - l2[1] * l1[3])/(l1[1]*l2[2]-l2[1]*l1[2]);
  }
  //Wierzcholek kata
  a.x := pb.x;
  a.y := pb.y;
  //Losowy wybor punktu na jednym z ramion kata
  if l1[2] <> 0 then
  begin
    b.x := a.x + 1 + random(10);
    b.y := -1/l1[2] *(l1[3] + l1[1] * b.x);
  end
  else
  begin
    b.y := a.y + 1 + random(10);
    b.x := -1/l1[1]*(l1[3] + l1[2] * b.y);
  end;
  r := hypot(b.x - a.x,b.y - a.y);
  (*Wyznaczanie punktu przeciecia okregu o środku w wierzchołku kąta
   i promieniu rownym odległości wylosowanego punktu od wierzchołka kąta
   z prostą zawierającą drugie ramię kąta
   Obliczenia rozbito na dwa przypadki ze względu na możliwość dzielenia przez zero
  *)
  if l2[2] <> 0 then
  begin
      quadratic(1+sqr(l2[1]/l2[2]),2*(l2[3]/l2[2] + a.y) * (l2[1]/l2[2]) - 2*a.x,sqr(a.x) + sqr(l2[3]/l2[2] + a.y) - sqr(r),t1,t2);
      c.x := t1;
      c.y := -1/l2[2] * (l2[3] + l2[1] * c.x);
      d.x := t2;
      d.y := -1/l2[2] * (l2[3] + l2[1] * d.x);
  end
  else
  begin
      quadratic(1+sqr(l2[2]/l2[1]),2*(l2[3]/l2[1] + a.x) * (l2[2]/l2[1]) - 2*a.y,sqr(a.y) + sqr(l2[3]/l2[1] + a.x) - sqr(r),t1,t2);
      c.y := t1;
      c.x := -1/l2[1] * (l2[3] + l2[2] * c.y);
      d.y := t2;
      d.x := -1/l2[1] * (l2[3] + l2[2] * d.y);
  end;
  //Prosta prostopadla do prostej BC przechodząca przez wierzchołek kąta
  b1[1] := c.x - b.x;
  b1[2] := c.y - b.y;
  b1[3] := -a.x * b1[1] - a.y * b1[2];
  //Prosta prostopadla do prostej BD przechodząca przez wierzchołek kąta
  b2[1] := d.x - b.x;
  b2[2] := d.y - b.y;
  b2[3] := -a.x * b2[1] - a.y * b2[2];
  acute := ((l1[1] * b1[1] + l1[2] * b1[2]) <> 0) and (abs((l1[1] * b1[2] - l1[2] * b1[1])/(l1[1] * b1[1] + l1[2] * b1[2])) < 1);
  if not acute then
     for i := 1 to 3 do
     begin
       temp := b1[i];
       b1[i] := b2[i];
       b2[i] := temp;
     end;
end;

procedure inscribedCircleEq(a,b,c:TPoint;var s:TPoint;var r:Real);
var d:TPoint;
    b1,b2,b3:TArray;
begin
  bisectoreq(a,b,c,b1,b2);
  bisectoreq(b,a,c,b2,b3);
  //Wspolrzende srodka jako przeciecie dwusiecznych katow wewnetrznych
  s.x := -(b1[3] * b2[2] - b2[3] * b1[2])/(b1[1] * b2[2] - b2[1] * b1[2]);
  s.y := -(b1[1] * b2[3] - b2[1] * b1[3])/(b1[1] * b2[2] - b2[1] * b1[2]);
  //Rownanie prostej zawierajacej bok trojkata
  b3[1] := -(b.y - a.y);
  b3[2] := b.x - a.x;
  b3[3] := -b.x * b3[1] - b.y * b3[2];
  //Rownanie prostej prostopadlej do prostej zawierajacej bok trojkata przechodzacej przez srodek okregu wpisanego
  b2[1] := (b.x - a.x);
  b2[2] := (b.y - a.y);
  b2[3] := -s.x * b2[1] - s.y * b2[2];
  // Przeciecie prostej zawierajacej bok trojkata i do niej prostopadlej
  d.x := -(b3[3] * b2[2] - b2[3] * b3[2])/(b3[1] * b2[2] - b2[1] * b3[2]);
  d.y := -(b3[1] * b2[3] - b2[1] * b3[3])/(b3[1] * b2[2] - b2[1] * b3[2]);
  r := hypot(d.x - s.x,d.y - s.y);
end;

var a,b,c,s:TPoint;
    r:Real;
    esc:char;
    f:text;

BEGIN
assign(f,'inscribed.txt');
{$I-}
  reset(f);
{$I+}
if ioresult = 0 then
   append(f)
else
   rewrite(f);
repeat
   repeat
       writeln('Podaj wspolrzedne punktu A');
       readln(a.x,a.y);
       writeln('Podaj wspolrzedne punktu B');
       readln(b.x,b.y);
       writeln('Podaj wspolrzedne punktu C');
       readln(c.x,c.y);
   until ((b.x - a.x) * (c.y - a.y) <> (b.y - a.y) * (c.x - a.x));
   writeln(f,' Wspolrzedne punktu A to : (',a.x:1:10,',',a.y:1:10,')' );
   writeln(f,' Wspolrzedne punktu B to : (',b.x:1:10,',',b.y:1:10,')' );
   writeln(f,' Wspolrzedne punktu C to : (',c.x:1:10,',',c.y:1:10,')' );
   inscribedCircleEq(a,b,c,s,r);
   writeln('Rownanie okregu wpisanego w trojkat o danych wierzcholkach ');
   writeln(f,'Rownanie okregu wpisanego w trojkat o danych wierzcholkach ');
   writeln ('(x -',s.x:1:10,')^2 + (y - ',s.y:1:10,')^2 = ',sqr(r):1:10);
   writeln (f,'(x -',s.x:1:10,')^2 + (y - ',s.y:1:10,')^2 = ',sqr(r):1:10);
   esc := readkey;
until esc = #27;
close(f);
END.