Алгоритъм на Коен - Съдърленд за изрязване на отсечки

{ Процедура за изрязване на отсечка със зададени координати на крайните й точки P1=(X1,Y1) и P2=(X2,Y2) от прозорец с координати на горния ляв ъгъл (Xmin,Ymin) и на долния десен (Xmax,Ymax) }

procedure Clipper(X1,Y1, X2,Y2, Xmin,Ymin, Xmax,Ymax: real);

type OutCode : array[1..4] of boolean; { true е вън от прозореца }

var Accept, Reject, Done : boolean;

{ Флагове за тривиално приемане, отхвърляне на отсечка и за край }

OutCode1, OutCode2 : OutCode;{ Кодове за точките P1 и P2 }

procedure Swap;

{ Разменя стойностите на P1 и P2 }

function AcceptTest(OutCode1, OutCode2 : OutCode) : boolean;

{ Проверка за тривиално приемане на отсечка }

function RejectTest(OutCode1, OutCode2 : OutCode) : boolean;

{ Проверка за тривиално отхвърляне на отсечка }

procedure OutCodes(X,Y : real; var OutCodeXY : OutCode);

{ Определя кода на точка с координати (X,Y) }

begin { Clipper }

Accept := false; Reject := false; Done := false;

repeat

OutCodes(X1, Y1, OutCode1);

OutCodes(X2, Y2, OutCode2);

Reject := RejectTest(OutCode1, OutCode2);

if Reject then Done := true

else { Възможно е тривиално приемане }

begin

Accept := AcceptTest(OutCode1, Outcode2);

if Accept then Done := true

else { Отсечката се дели }

begin

{ Ако P1 е вътре в прозореца, размяна на P1 и P2 }

if not (OutCode1[1] or OutCode1[2] or

OutCode1[3] or OutCode1[4])

then Swap;

{ P1 се премества в точката на пресичане. }

{ Използват се формули: }

{ y = y1 + m*(x-x1) и x = x1 + (1/m)*(y-y1) }

if OutCode1[1] then

begin { Изрязване по y=Ymax }

X1 := X1 + (X2-X1) * (Ymax-Y1)/(Y2-Y1);

Y1 := Ymax; end

else if OutCode1[2] then

begin { Изрязване по y=Ymin }

X1 := X1 + (X2-X1) * (Ymin-Y1)/(Y2-Y1);

Y1 := Ymin end

else if OutCode1[3] then

begin { Изрязване по x=Xmax }

Y1 := Y1 + (Y2-Y1) * (Xmax-X1)/(X2-X1);

X1 := Xmax end

else if OutCode1[4] then

begin { Изрязване по x=Xmin }