(*$E- *)
DEFINITION MODULE CLIPPING;
PROCEDURE ClipOn(X1,Y1,X2,Y2:INTEGER);
PROCEDURE ClipOff;
PROCEDURE INRANGE(X,Y:INTEGER):BOOLEAN;
(*
PROCEDURE ClipLINETO(X,Y:INTEGER);
PROCEDURE ClipHLINE(XL,Y,XR:INTEGER);
PROCEDURE ClipAREA(x,y,dx,dy:INTEGER);
PROCEDURE ClipPLOT(X,Y:INTEGER);
*)
END CLIPPING.
 
IMPLEMENTATION MODULE CLIPPING;
FROM GRAPH1 IMPORT LINETO,HLINE,AREA,PLOT,DLINETO,DAREA,DPLOT,DHLINE;
VAR XLO,YLO,XHI,YHI:INTEGER;
    XLAST,YLAST:INTEGER;
    X0,Y0,X1,Y1:INTEGER;
    LASTON,PON,VERT:BOOLEAN;
    INTREQ:[0..2];
    DY,DX,TI,PT:INTEGER;
    RDX,RDY,IGRAD,GRAD:REAL2;
    YI,XI:INTEGER;
PROCEDURE ClipLINETO(X,Y:INTEGER);
 
PROCEDURE LINEOFF1;
 
(*PROCEDURE GRADINV;
 
PROCEDURE Recip(X:REAL2):REAL2;
HEX 7C 2F 57 26 B5 7E 2F 5F 13 6B 24 6E 62 C9 END Recip;
 
BEGIN
GRAD:=Recip(GRAD)
END GRADINV;*)
 
PROCEDURE YALC(PXT:INTEGER);
BEGIN
YI:=INT(RL2(PXT-X0)*GRAD)+Y0;
IF (YI<YLO) OR (YI>YHI) THEN RETURN END;
DEC(INTREQ);
IF (INTREQ=0) THEN X1:=PXT;Y1:=YI ELSE X0:=PXT;Y0:=YI END
END YALC;
 
PROCEDURE XALC(PYT:INTEGER);
BEGIN
XI:=INT(RL2(PYT-Y0)*IGRAD)+X0;
IF (XI<XLO) OR (XI>XHI) THEN RETURN END;
DEC(INTREQ);
IF (INTREQ=0) THEN Y1:=PYT;X1:=XI ELSE Y0:=PYT;X0:=XI END
END XALC;
 
PROCEDURE XALCO():BOOLEAN;
BEGIN
IF (Y0<YLO) AND (Y1>YLO) THEN XALC(YLO)
ELSIF (Y0>YHI) AND (Y1<YLO) THEN XALC(YHI) END;
RETURN INTREQ=1
END XALCO;
 
PROCEDURE YALCO():BOOLEAN;
BEGIN
IF (X0<XLO) AND (X1>XLO) THEN YALC(XLO)
ELSIF (X0>XHI) AND (X1<XHI) THEN YALC(XHI) END;
RETURN INTREQ=1
END YALCO;
 
BEGIN
DX:=X1-X0;DY:=Y1-Y0;VERT:=ABS(DY)>ABS(DX);
RDX:=RL2(DX);RDY:=RL2(DY);
IGRAD:=RDX/RDY;GRAD:=RDY/RDX;
INTREQ:=1;
IF PON THEN 
  TI:=X0;X0:=X1;X1:=TI;TI:=Y0;Y0:=Y1;Y1:=TI
 ELSIF NOT LASTON THEN
  INTREQ:=2;
  IF VERT THEN 
    IF NOT(XALCO() OR YALCO()) THEN RETURN END
   ELSE IF NOT(YALCO() OR XALCO()) THEN RETURN END END END;
IF VERT THEN
  IF Y1>Y0 THEN PT:=YHI ELSE PT:=YLO END;
  XALC(PT);
  IF INTREQ=0 THEN RETURN END;
  IF X1>X0 THEN PT:=XHI ELSE PT:=XLO END;
  YALC(PT)
 ELSE
  IF X1>X0 THEN PT:=XHI ELSE PT:=XLO END;
  YALC(PT);
  IF INTREQ=0 THEN RETURN END;
  IF Y1>Y0 THEN PT:=YHI ELSE PT:=YLO END;
  XALC(PT) END
END LINEOFF1;
 
BEGIN
X0:=XLAST;Y0:=YLAST;
X1:=X;Y1:=Y;XLAST:=X1;YLAST:=Y1;
INTREQ:=0;PON:=INRANGE(X1,Y1);
IF NOT(LASTON AND PON) THEN LINEOFF1 END;
IF INTREQ=0 THEN DPLOT(X0,Y0);DLINETO(X1,Y1) END;
LASTON:=PON;
END ClipLINETO;
 
PROCEDURE ClipHLINE(XL,Y,XR:INTEGER);
BEGIN
IF (Y<YLO) OR (Y>YHI) OR (XL>XHI) OR (XR<XLO) THEN RETURN END;
IF (XL<XLO) THEN XL:=XLO END;
IF (XR>XHI) THEN XR:=XHI END;
DHLINE(XL,Y,XR)
END ClipHLINE;
 
VAR x1,y1:INTEGER;
PROCEDURE ClipAREA(x,y,dx,dy:INTEGER);
BEGIN
IF (x>XHI) OR (y>YHI) THEN RETURN END;
x1:=x+dx;y1:=y+dy;
IF (x1<XLO) OR (y1<YLO) THEN RETURN END;
IF (x<XLO) THEN x:=XLO END;
IF (x1>XHI) THEN x1:=XHI END;
IF (y<YLO) THEN y:=YLO END;
IF (y1>YHI) THEN y1:=YHI END;
DAREA(x,y,x1-x,y1-y)
END ClipAREA;
 
PROCEDURE ClipPLOT(X,Y:INTEGER);
BEGIN
XLAST:=X;YLAST:=Y;LASTON:=INRANGE(X,Y);
IF LASTON THEN DPLOT(X,Y) END
END ClipPLOT;
 
PROCEDURE ClipOn(X1,Y1,X2,Y2:INTEGER);
BEGIN
XLO:=X1;YLO:=Y1;XHI:=X2;YHI:=Y2;
LINETO:=ClipLINETO;PLOT:=ClipPLOT;
AREA:=ClipAREA;HLINE:=ClipHLINE;
END ClipOn;
 
PROCEDURE ClipOff;
BEGIN
LINETO:=DLINETO;PLOT:=DPLOT;
AREA:=DAREA;HLINE:=DHLINE;
END ClipOff;
 
PROCEDURE INRANGE(X,Y:INTEGER):BOOLEAN;
BEGIN
RETURN (X>=XLO) AND (X<=XHI) AND (Y>=YLO) AND (Y<=YHI)
END INRANGE;
 
BEGIN
ClipOn(0,0,255,191)
END CLIPPING.
