1C*GRCLPL -- clip line against clipping rectangle 2C+ 3 SUBROUTINE GRCLPL (X0,Y0,X1,Y1,VIS) 4C 5C GRPCKG (internal routine): Change the end-points of the line (X0,Y0) 6C (X1,Y1) to clip the line at the window boundary. The algorithm is 7C that of Cohen and Sutherland (ref: Newman & Sproull). 8C 9C Arguments: 10C 11C X0, Y0 (input/output, real): device coordinates of starting point 12C of line. 13C X1, Y1 (input/output, real): device coordinates of end point of line. 14C VIS (output, logical): .TRUE. if line lies wholly or partially 15C within the clipping rectangle; .FALSE. if it lies entirely 16C outside the rectangle. 17C-- 18C 13-Jul-1984 - [TJP]. 19C 20-Jun-1985 - [TJP] - revise clipping algorithm. 20C 28-Jun-1991 - [TJP] - use IAND(). 21C 12-Jun-1992 - [TJP] - clip exactly on the boundary. 22C 23C Caution: IAND is a non-standard intrinsic function to do bitwise AND 24C of two integers. If it is not supported by your Fortran compiler, you 25C will need to modify this routine or supply an IAND function. 26C----------------------------------------------------------------------- 27 INCLUDE 'grpckg1.inc' 28 LOGICAL VIS 29 INTEGER C0,C1,C 30 REAL XMIN,XMAX,YMIN,YMAX 31 REAL X,Y, X0,Y0, X1,Y1 32 INTEGER IAND 33C 34 XMIN = GRXMIN(GRCIDE) 35 YMIN = GRYMIN(GRCIDE) 36 XMAX = GRXMAX(GRCIDE) 37 YMAX = GRYMAX(GRCIDE) 38 CALL GRCLIP(X0,Y0,XMIN,XMAX,YMIN,YMAX,C0) 39 CALL GRCLIP(X1,Y1,XMIN,XMAX,YMIN,YMAX,C1) 40 10 IF (C0.NE.0 .OR. C1.NE.0) THEN 41 IF (IAND(C0,C1).NE.0) THEN 42C ! line is invisible 43 VIS = .FALSE. 44 RETURN 45 END IF 46 C = C0 47 IF (C.EQ.0) C = C1 48 IF (IAND(C,1).NE.0) THEN 49C ! crosses XMIN 50 Y = Y0 + (Y1-Y0)*(XMIN-X0)/(X1-X0) 51 X = XMIN 52 ELSE IF (IAND(C,2).NE.0) THEN 53C ! crosses XMAX 54 Y = Y0 + (Y1-Y0)*(XMAX-X0)/(X1-X0) 55 X = XMAX 56 ELSE IF (IAND(C,4).NE.0) THEN 57C ! crosses YMIN 58 X = X0 + (X1-X0)*(YMIN-Y0)/(Y1-Y0) 59 Y = YMIN 60 ELSE IF (IAND(C,8).NE.0) THEN 61C ! crosses YMAX 62 X = X0 + (X1-X0)*(YMAX-Y0)/(Y1-Y0) 63 Y = YMAX 64 END IF 65 IF (C.EQ.C0) THEN 66 X0 = X 67 Y0 = Y 68 CALL GRCLIP(X,Y,XMIN,XMAX,YMIN,YMAX,C0) 69 ELSE 70 X1 = X 71 Y1 = Y 72 CALL GRCLIP(X,Y,XMIN,XMAX,YMIN,YMAX,C1) 73 END IF 74 GOTO 10 75 END IF 76 VIS = .TRUE. 77 END 78