Program Cohen_Sutherland;

uses crt,graph;

type

code=array[1..4] of Byte;

var

a1,b1,a2,b2 : Real;

n,i, xmin,ymin,xmax,ymax,gd,gm:integer;

b: code;

(****************************************)

Procedure Special_Line(x1,y1,x2,y2: Real);

Var

tg: Real;

Begin

If (x1=x2) And (x1>xmin) And (x1<xmax)

Then

Begin

If y1>y2

Then

Begin

tg:=y1;

y1:=y2;

y2:=tg;

End;

If (y1<ymax) And (y2>ymin)

Then

Begin

If y1<ymin Then y1:=ymin;

If y2>ymax Then y2:=ymax;

End;

Line(Round(x1),Round(y1),Round(x2),Round(y2));

End;

If (y1=y2) And (y1>ymin) And (y1<ymax) Then

Begin

If x1>x2 Then

Begin

tg:=x1; x1:=x2; x2:=tg;

End;

If (x1<xmax) And (x2>xmin) Then

Begin

If x1<xmin Then x1:=xmin;

If x2>xmax Then x2:=xmax;

End; Line(Round(x1),Round(y1),Round(x2),Round(y2));

End;

End;

(*****************************)

Procedure Kod(x,y:real;var b:code );

Begin

For i:=1 To 4 Do b[i]:=0;

if(x < xmin) then b[1]:=1;

if(x > xmax) then b[2]:=1;

if(y < ymin) then b[3]:=1;

if(y > ymax) then b[4]:=1;

End;

(****************************************)

Procedure Cohen_Sutherland_Clipping(x1,y1,x2,y2:Real);

var

c1,c2: code; chon,tong1,tong2,mu2: Byte;

tgx,tgy : Real;

Begin

Repeat

Kod(x1,y1,c1); Kod(x2,y2,c2);

tong1:=0;

tong2:=0;

mu2:=1;

For i:=1 To 4 Do

Begin

tong1:=tong1+c1[i]*mu2;

tong2:=tong2+c2[i]*mu2;

mu2:=mu2*2;

End;

If tong1+tong2=0 Then

Begin

chon:=1;

line(Round(x1),Round(y1),Round(x2),Round(y2));

End

Else If (tong1 And tong2)<>0 then

Begin

chon:=2;

End

Else

Begin

chon:=3;

If tong1=0 then

Begin

tgx:=x1; x1:=x2; x2:=tgx;

tgy:=y1; y1:=y2; y2:=tgy;

End;

Kod(x1,y1,b);

if b[1]=1 then

Begin

y1:=y1+(xmin-x1)*(y2-y1)/(x2-x1); x1:=xmin

End;

if b[2]=1 then

Begin

y1:=y1+(xmax-x1)*(y2-y1)/(x2-x1); x1:=xmax

End;

if b[3]=1 then

Begin

x1:=x1+(ymin-y1)*(x2-x1)/(y2-y1); y1:=ymin

End;

if b[4]=1 then

Begin

x1:=x1+(ymax-y1)*(x2-x1)/(y2-y1); y1:=ymax

End;

End;

Until (chon=1) Or (chon=2);

End;

(****************************************)

Begin clrscr;

write('nhap toa do cua so xmin,ymin: ');

readln(xmin,ymin);

write('nhap toa do cua so xmax,ymax: ');

readln(xmax,ymax);

write('Nhap (a1,b1): ');

readln(a1,b1);

write('Nhap (a2,b2): ');

readln(a2,b2);

gd:=detect;

initgraph(gd,gm,'c:\tp\bgi');

setbkcolor(Black);

setcolor(red);

rectangle(xmin,ymin,xmax,ymax);

settextjustify(1,1);

outtextxy(320,450,'HIEN THI MOT DOAN THANG TRONG MOT CUA SO CHO TRUOC');

outtextxy(320,470,'THEO THUAT TOAN COHEN-SUTHERLAND');

setcolor(WHITE);

setlinestyle(1,0,0);

line(Round(a1),Round(b1),Round(a2),Round(b2));

setlinestyle(0,0,0);

If (a1<>a2)And(b1<>b2) Then Cohen_Sutherland_Clipping(a1,b1,a2,b2)

Else Special_Line(a1,b1,a2,b2);

readln;

closegraph;

End.