Процедуры и функции, Проверьте задачу Опции

[Вася]

Пусть дано n треугольников. определить количество треугольников, которые
пересекают границы заданого квадрата. используйте функцию для определения,
пересекает ли треугольник границы квадрата.

Код

program s103n62pr;
const
    n = 2;                                   // кол-во треугольников
type
  TPoint = array['x'..'y'] of real;          // координаты точки
  TTriangle = array [1..3] of TPoint;        // один треугольник
  TSquare = array [1..4] of TPoint;          // квадрат
  TTriangles = array [1..N] of TTriangle;    // треугольники
// Процедура ввода точки
procedure read_point (var a: tpoint);
begin
    write ('координаты точки: ');
    readln (a['x'], a['y']);
end;
// процедура ввода  1 треугольника
procedure read_tr (var tr:ttriangle);
var i: integer;
begin
    for i:=1 to 3 do
    begin
        writeln ('введите ', i, ' точку треугольника');
        read_point(tr[i]);
    end;
end;
// процедура ввода квадрата
procedure read_kv (var kv:tsquare);
var i: integer;
begin
    writeln ('введите квадрат');
    for i:=1 to 4 do
    begin
        writeln ('введите ', i, ' точку квадрата');
        read_point(kv[i]);
    end;
end;
//Процедура ввода массива треугольников
procedure read_mas_tr (var mas: ttriangles);
var i: integer;
begin
    for i:=1 to n do
    begin
        writeln('введите ', i, ' треугольник ');
        read_tr(mas[i]);
  end;
end;
//функция нахождения расстояния между двумя точками
function dist (a, b: tpoint): real;
begin
    result:=sqrt(sqr(a['x']-b['x'])+sqr(a['y']-b['y']));
end;
//функция нахождения пересечения двух отрезков
function crossing(a, b, c, d:TPoint):boolean;
var A1,A2,B1,B2,C1,C2: real;
    OK:boolean;
    k:TPoint;
    rast:real;
begin
  A1:=b['y']-a['y'];
  B1:=a['x']-b['x'];
  A2:=d['y']-c['y'];
  B2:=c['x']-d['x'];
  C1:=-A1*a['x']-B1*a['y'];
  C2:=-A1*c['x']-B1*c['y'];
  OK:=not(A1*B2=A2*B1);
  if OK then
  begin
      k['x']:=(B1*C2-C1*B2)/(A1*B2-B1*A2);
      k['y']:=(C1*A2-C2*A1)/(A1*B2-B1*A2);
  end;
  rast:=dist(a,b);
  if (dist(k,a)/rast<1) and (dist(k,b)/rast<1) then Result:=true
  else Result:=false;
end;
// функция нахождения пересечения квадрата и 1 треугольника
function cross (a: Tsquare; b: Ttriangle): boolean;
var i, j: integer;
begin
   result:=false;
   for i:=1 to 3 do
     for j:=1 to 3 do
      if (i<>j) and
           ((crossing (a[1], a[2], b[i], b[j]))
         or (crossing (a[2], a[3], b[i], b[j]))
         or (crossing (a[3], a[4], b[i], b[j]))
         or (crossing (a[4], a[1], b[i], b[j])))
      then result:=true
end;
// процедура нахождения кол-ва треугольников, пересекающих квадрат
procedure count (a: Tsquare; b: Ttriangles; var k: integer);
var i: integer;
begin
    k:=0;
    for i:=1 to n do
     if cross (a, b[i]) then k:=k+1;
    writeln ('кол-во треугольников, пересекающих квадрат = ', k);
end;
var m: ttriangles; // массив треугольников
    kv: TSquare;   // квадрат
    k: integer;    // кол-во треугольников, пересекающих квадрат
begin {main}
  read_kv (kv);
  read_mas_tr (m);
  count(kv, m, k);
  readln;
end.