unit cohen;

interface
uses Graph;

function code(const x,y,xmin,ymin,xmax,ymax:integer):integer;
procedure clip(x1,y1,x2,y2,xmin,ymin,xmax,ymax:integer);

implementation

function code(const x,y,xmin,ymin,xmax,ymax:integer):integer;
var tmp:integer;
begin
tmp:=0;
if (x<xmin) then tmp:=tmp+8;
if (x>xmax) then tmp:=tmp+4;
if (y<ymin) then tmp:=tmp+2;
if (y>ymax) then tmp:=tmp+1;
code:=tmp
end;

procedure clip(x1,y1,x2,y2,xmin,ymin,xmax,ymax:integer);
var
c1,c2:integer;
dx,dy:integer;
begin
c1:=code(x1,y1,xmin,ymin,xmax,ymax);
c2:=code(x2,y2,xmin,ymin,xmax,ymax);
while ((c1 or c2)<>0) do
begin
if ((c1 and c2)<>0) then exit;
dx:=x2-x1;
dy:=y2-y1;
if (c1<>0) then
begin
if (x1<xmin) then
begin
y1:=y1+trunc(dy*(xmin-x1)/dx);
x1:=xmin;
end
else if (x1>xmax) then
begin
y1:=y1+trunc(dy*(xmax-x1)/dx);
x1:=xmax
end
else if (y1<ymin) then
begin
x1:=x1+trunc(dx*(ymin-y1)/dy);
y1:=ymin;
end else if (y1>ymax) then
begin
x1:=x1+trunc(dx*(ymax-y1)/dy);
y1:=ymax;
end;
c1:=code(x1,y1,xmin,ymin,xmax,ymax)
end
else
begin
if (x2<xmin) then
begin
y2:=y2+trunc(dy*(xmin-x2)/dx);
x2:=xmin;
end
else if (x2>xmax) then
begin
y2:=y2+trunc(dy*(xmax-x2)/dx);
x2:=xmax
end
else if (y2<ymin) then
begin
x2:=x2+trunc(dx*(ymin-y2)/dy);
y2:=ymin;
end else if (y2>ymax) then
begin
x2:=x2+trunc(dx*(ymax-y2)/dy);
y2:=ymax;
end;

c2:=code(x2,y2,xmin,ymin,xmax,ymax);
end;
end;
Line(x1,y1,x2,y2);
end;

begin end.
Соседние файлы в папке Архив указанных лаб