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

[Вася]

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

{$APPTYPE CONSOLE}

uses
SysUtils,
windows;

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}
{обращение к русскому языку}
setconsoleCp(1251);
setconsoleOutputCp(1251);
read_kv (kv);
read_mas_tr (m);
count(kv, m, k);
readln;
end.