SUBROUTINE VSTRIP C C NAME: VSTRIP C C LANGUAGE: FORTRAN C C OPERATING SYSTEM: DEC VAX/VMS C C ORDER NUMBER: 5448-SE C C PART NUMBER: 000-025522-001 OCTOBER 1985 C C PRODUCT: DEC VAX/VMS VERSAPLOT COLOR RANDOM 2.0 C C VERSATEC, INC., SANTA CLARA, CALIFORNIA 95051 C A XEROX COMPANY C C Copyright (C) 1985 by Xerox Corporation. All rights reserved. C C "NOTICE. THIS PROGRAM IS THE EXCLUSIVE PROPERTY OF VERSATEC, C INC. AND IS ISSUED IN STRICT CONFIDENCE UNDER A PREARRANGED C LICENSE AGREEMENT AND IS NOT TO BE DISCLOSED IN ANY MANNER TO C PERSONS OUTSIDE THE LICENSED ORGANIZATION AND SHALL NOT BE C REPRODUCED OR DISSEMINATED, IN WHOLE OR PART, TO ANYONE OUTSIDE C THE LICENSED ORGANIZATION WITHOUT THE PRIOR WRITTEN APPROVAL OF C VERSATEC, INC. UNLESS OTHERWISE PROVIDED FOR BY SUCH LICENSE C AGREEMENT. THIS WORK IS PROTECTED AS AN UNPUBLISHED WORK UNDER C THE COPYRIGHT ACT OF 1976." C C REVISION HISTORY C REV. C C 2/20/85 THIS IS A NEW SUBROUTINE FOR THIS C REVISION. IT DOES STRIPPING OF VECTORS C IN THE Y-DIRECTION. C C VSTRIP - VECTOR STRIPPING ALGORITHM C C SUBROUTINE VSTRIP IS CALLED BY PLOT AND DRWPEN FOR EACH VECTOR C THAT EXTENDS BEYOND THE PHYSICAL PLOTTING PAPER WIDTH. THE C VECTOR WILL BE STRIPPED ACCORDING TO THE DEFAULT STRIP WIDTH AS C SPECIFIED IN SUBROUTINE PLOTS. C C ENTRY: CALL VSTRIP C C NOTE: THE VECTOR DOT COORDINATES IX1,IY1,IX2,IY2 ARE OBTAINED C FROM COMMON C C EXIT: RETURN C C CALLS: OCHUNK, OUTVEC, XSTRIP C C CALLED BY: PLOT, DRWPEN C C COMMON USED: C /DVCOM/ C I ILWP - (LINE WIDTH - 1)/2 C I ILWM - LINE WIDTH/2 C I IX1,IX2 C IY1,IY2 - WORKING STORAGE FOR CURRENT VECTOR C I KWIDTH - WIDTH OF CURRENT PEN C L PMOVE - STATUS OF LAST PLOT CALL (.TRUE.=MOVE) C I VSMAX - MAXIMUM Y-VALUE FOR A STRIPPED VECTOR C L XMAJOR - INDICATES IF XMAJOR MOVE VECTOR C I XNIPS - NUMBER OF NIBS PER PAGE IN THE X-DIRECTION C I YNIPS - NIBS PER SCAN C /VRFCOM/ C R DRWKNT - BYTE COUNT FOR A DRAW COMMAND C R DRWMAX - BYTE COUNT FOR A DRAW COMMAND WITH A PEN C OF WIDTH GREATER THAN 1 C R DRWMIN - BYTE COUNT FOR A DRAW COMMAND WITH A PEN C OF WIDTH AT MOST 1 C C /PRMCOM/ C I IFONT - DEFAULT FONT PATTERN NUMBER. C I KREP - TARGET OUTPUT CONTROLLER C = 0 - UNKNOWN C = 1 - REP CONTROLLER C = 4 - RPM CONTROLLER C /KLCOM/ C L KFLAG - FLAG INDICATING REP OUTPUT AND .GT. 13.65' C PLOTTING REQUIRED. C I KSIZE - VARIABLE DEFINING 13.65' IN SCANS, USED TO C DETERMINE IF ELEMENT CROSSES A 13.65' PAGE C BOUNDARY. C C C LOCAL: C L ADJUST - TRUE IFF AN ENDPOINT OF THE VECTOR WAS ADJUSTED C R BOUND - CURRENT STRIPPING BOUNDARY C R FYNIPS - REAL-VALUED COPY OF YNIPS C I ICMD - SET-PEN COMMAND WORD C I IILWM, - SAVED VALUES OF ILWM,ILWP C IILWP C I INDX - LOOP INDEX C I IPAGE1, - PAGE NUMBERS FOR THE ENDPOINTS OF THE VECTOR C IPAGE2 (USED FOR X-STRIPPING) C I IRTN - RETURN VALUE FOR INLINE SUBROUTINE C I IX2SAV, - SAVED VALUES OF IX2,IY2 C IY2SAV C I IXOFF, - OFFSETS USED TO ADJUST THE STRIPPED VECTOR TO C IYOFF THE PROPER STRIP C I IXONE - ADJUSTMENT VALUE TO BE USED IF THE ENDPOINT OF C THE VECTOR NEEDS TO BE ADJUSTED C I KX1,KY1, - SAVED VALUES OF IX1,IX2,IY1,IY2 C KX2,KY2 C I MAXVAL, - MAXIMUM AND MINIMUM Y-VALUES OF THE VECTOR C MINVAL C I NDLTX, - DELTA X AND DELTA Y VALUES C NDLTY C I SAVEW - SAVED VALUE OF KWIDTH C L SWAPPD - TRUE IFF THE ENDPOINTS OF THE VECTOR HAVE BEEN C SWAPPED C I VSMAX2 - LOCAL COPY OF VSMAX C R X1,Y1, - CURRENT VECTOR IN REAL COORDINATES C X2,Y2 C C C INCLUDE 'DVCOM.CMN' C C INCLUDE 'VRFCOM.CMN' C C INCLUDE 'PRMCOM.CMN' C C INCLUDE 'KLCOM.CMN' C C INTEGER VSMAX2 LOGICAL SWAPPD, ADJUST C C... SET-PEN COMMAND WORD (X'8301') DATA ICMD/33537/ C C ********************************* C * DEFINE INTERSECTION FUNCTIONS * C ********************************* C C... IXINT -- RETURN X ORDINATE OF THE POINT LYING ON THE SEGMENT C (IAX,IAY),(IBX,IBY) WHOSE Y ORDINATE IS IC. C XINT -- A REAL VERSION OF IXINT C THIS FUNCTION IS DERIVED BY TAKING THE TWO POINT FORMULA FOR A C LINE AND SOLVING FOR X. C IXINT(IAX,IAY,IBX,IBY,IC) = (IC-IAY) * (IBX-IAX) / (IBY-IAY) + IAX XINT(AX,AY,BX,BY,C) = (C-AY) * (BX-AX) / (BY-AY) + AX C C C... IYINT -- RETURN Y ORDINATE OF THE POINT LYING ON THE SEGMENT C (IAX,IAY),(IBX,IBY) WHOSE X ORDINATE IS IC. C THIS FUNCTION IS DERIVED BY TAKING THE TWO POINT FORMULA FOR A C LINE AND SOLVING FOR Y. C IYINT(IAX,IAY,IBX,IBY,IC) = (IC-IAX) * (IBY-IAY) / (IBX-IAX) + IAY C C ************************* C * BEGIN EXECUTABLE CODE * C ************************* C C C... GET LOCAL COPY OF VSMAX VSMAX2 = VSMAX C C... FIND THE FIRST STRIPPING BOUNDARY MINVAL = IY1 IF (IY1 .GT. IY2) MINVAL = IY2 IF (XMAJOR) MINVAL = MINVAL - ILWM 10 IF ( MINVAL .LT. YNIPS ) GO TO 20 MINVAL = MINVAL - YNIPS VSMAX2 = VSMAX2 - YNIPS IX1 = IX1 + XNIPS IX2 = IX2 + XNIPS IY1 = IY1 - YNIPS IY2 = IY2 - YNIPS GO TO 10 C C... CHECK WHETHER THE VECTOR CROSSES A STRIPPING BOUNDARY 20 MAXVAL = IY2 IF (IY1 .GT. IY2) MAXVAL = IY1 IF (XMAJOR) MAXVAL = MAXVAL + ILWP IF (MAXVAL .GE. YNIPS) GO TO 30 C C... VECTOR DOESN'T NEED STRIPPING - OUTPUT IT IRTN = 0 GO TO 200 C C... ORDER VECTOR MOVE BY 'Y' 30 SWAPPD = .FALSE. IF (IY1.LE.IY2) GO TO 40 ITMP = IX1 IX1 = IX2 IX2 = ITMP ITMP = IY1 IY1 = IY2 IY2 = ITMP PMOVE = .TRUE. SWAPPD = .TRUE. 40 CONTINUE C C... INITIALIZE THE ONE NIB OFFSET IXONE = 1 IF (IX1 .GT. IX2) IXONE = -1 C C... CHECK IF MULTIWIDTH X-MAJOR VECTOR JRTN = 0 IF ( (.NOT. XMAJOR) .OR. KWIDTH .LE. 1 ) GO TO 100 C C... X-MAJOR MULTIWIDTH VECTOR C VECTOR MUST BE STROKED OUT USING ONE NIB WIDE VECTORS C AN X-MAJOR VECTOR IS PLOTTED BY THE CONTROLLER WITH A C FLAT TOP AND BOTTOM (I.E. AS A GROUP OF ONE NIB WIDE C VECTORS THAT ARE OFFSET BY ONE NIB IN THE Y-DIRECTION.) C WHEN WE SPLIT THE VECTOR AT THE STRIPPING BOUNDARY, WE C WANT THE VECTOR TO LINE UP WITH THE BOUNDARY. IF WE SEND C OUT THICK X-MAJOR VECTORS, THIS WON'T HAPPEN. WE MUST C OUTPUT ONE NIB WIDE VECTORS AND STRIP EACH VECTOR C INDIVIDUALLY. C C... SET PEN WIDTH TO 1 SAVEW = KWIDTH CALL OCHUNK (ICMD,0) CALL OCHUNK (1,0) KWIDTH = 1 IILWP = ILWP IILWM = ILWM ILWP = 0 ILWM = 0 PMOVE = .TRUE. DRWKNT = DRWMIN C C... OFFSET THE VECTOR BY HALF ITS WIDTH TO GET C THE FIRST VECTOR TO BE OUTPUT IY1 = IY1 - IILWM IY2 = IY2 - IILWM C C... SAVE THE VECTOR KX1 = IX1 KX2 = IX2 KY1 = IY1 KY2 = IY2 C C... INITIALIZE INDEX FOR LOOP INDX = SAVEW JRTN = 1 C C... CHECK IF THE VECTOR STARTS IN THE NEXT STRIP 50 IF (IY1 .LT. YNIPS) GO TO 52 C C... ADJUST TO NEXT STRIP KX1 = KX1 + XNIPS KX2 = KX2 + XNIPS KY1 = KY1 - YNIPS KY2 = KY2 - YNIPS VSMAX2 = VSMAX2 - YNIPS IX1 = KX1 IX2 = KX2 IY1 = KY1 IY2 = KY2 GO TO 55 C C... CHECK WHETHER IY1 IS NEGATIVE 52 IF (IY1 .GE. 0) GO TO 55 C C... CLIP THE VECTOR AT Y=0 IX1 = IXINT(IX1,IY1,IX2,IY2,0) IY1 = 0 C C... CHECK WHETHER IY2 IS TOO LARGE C C IF THE VIEWPORT IS CLOSE TO THE STRIPPING BOUNDARY, WE C MAY HAVE THICK VECTORS THAT CROSS THE VIEWPORT AND C STRIPPING BOUNDARIES. WE WANT TO CUT THESE OFF AT THE C STRIPPING BOUNDARY. VSMAX2 IS THE CUTOFF BOUNDARY. C 55 IF (IY2 .LE. VSMAX2) GO TO 60 C C... CLIP THE VECTOR AT Y=VSMAX2 IX2 = IXINT(IX1,IY1,IX2,IY2,VSMAX2) IY2 = VSMAX2 C C... ONLY SOME OF THE ONE NIB WIDE VECTORS MAY NEED STRIPPING. C CHECK WHETHER THIS ONE NEEDS TO BE STRIPPED. 60 IF (IY2 .GE. YNIPS) GO TO 100 C C... THE VECTOR DOESN'T NEED STRIPPING IRTN = 1 GO TO 200 C C... CHECK IF MORE WIDTH TO PROCESS 70 INDX = INDX - 1 IF (INDX .EQ. 0) GO TO 80 C C... MOVE THE VECTOR OVER ONE NIB KY1 = KY1 + 1 KY2 = KY2 + 1 C C... INITIALIZE THE NEXT VECTOR TO BE OUTPUT IX1 = KX1 IX2 = KX2 IY1 = KY1 IY2 = KY2 PMOVE = .TRUE. GO TO 50 C C... DONE - RESET WIDTH 80 KWIDTH = SAVEW ILWM = IILWM ILWP = IILWP CALL OCHUNK(ICMD,0) CALL OCHUNK(KWIDTH,0) PMOVE = .TRUE. DRWKNT = DRWMAX RETURN C C... THIS BIT OF CODE (100-170) HANDLES Y-MAJOR VECTORS C AS WELL AS ONE NIB WIDE X-MAJOR VECTORS C C... SAVE THE ENDPOINT OF THE VECTOR 100 IX2SAV = IX2 IY2SAV = IY2 C C... INITIALIZE THE CURRENT VECTOR - TO X1 = IX1 X2 = IX2 Y1 = IY1 Y2 = IY2 C C... INITIALIZE THE CURRENT BOUNDARY FYNIPS = FLOAT(YNIPS) BOUND = FYNIPS - 0.5 C C... INITIALIZE THE CURRENT OFFSETS IXOFF = 0 IYOFF = 0 C C... GET THE NEXT INTERSECTION POINT 120 IF (Y2 .LT. BOUND) GO TO 125 X1 = XINT(X1,Y1,X2,Y2,BOUND) Y1 = BOUND IX2 = IFIX(X1 + 0.5) + IXOFF IY2 = YNIPS - 1 GO TO 130 125 IX2 = IX2SAV + IXOFF IY2 = IY2SAV - IYOFF 130 CONTINUE C C... CHECK FOR A Y-MAJOR THICK VECTOR THAT TURNED C INTO AN X-MAJOR VECTOR ADJUST = .FALSE. IF (XMAJOR) GO TO 150 IF (KWIDTH .LE. 1) GO TO 150 NDLTX = IABS(IX2-IX1) NDLTY = IABS(IY2-IY1) IF (NDLTX .LT. NDLTY) GO TO 150 IF (NDLTY .EQ. 0) GO TO 150 ADJUST = .TRUE. IF (NDLTX .GT. NDLTY) GO TO 140 C C... WE HAVE A 45 DEGREE VECTOR - ADJUST IX2 IX2 = IX2 - IXONE GO TO 150 C C... MORE THAN 45 DEGREES - ADJUST IX1 AND IX2 140 IX1 = IX1 + IXONE IX2 = IX2 - IXONE C C... OUTPUT THE VECTOR 150 IRTN = 2 GO TO 200 C C... CHECK IF DONE 160 IF (Y2 .LT. BOUND) GO TO 170 C C... UPDATE FOR MORE STRIPPING C BOUND = BOUND + FYNIPS IXOFF = IXOFF + XNIPS IYOFF = IYOFF + YNIPS IX1 = IFIX(X1+0.5) + IXOFF IY1 = 0 PMOVE = .TRUE. GO TO 120 C C... SEE IF ANY MORE X-MAJOR MULTI-WIDTH PROCESSING 170 IF (JRTN .NE. 0) GO TO 70 C C... DONE IF (ADJUST) PMOVE = .TRUE. IF (SWAPPD) PMOVE = .TRUE. RETURN C C C... ********************* C * OUTPUT THE VECTOR * C ********************* C 200 CONTINUE C C... CHECK IF THE VECTOR NEEDS TO BE STRIPPED IN THE X-DIRECTION IF (.NOT. KFLAG) GO TO 210 C C... CHECK IF THE VECTOR IS LONGER THAN KSIZE NDLTX = IABS(IX2-IX1) IF (NDLTX .GE. KSIZE) GO TO 209 C C... IF PRISM, STRIPPING NOT NECESSARY IF (KREP .EQ. 4) GO TO 210 C C... CHECK IF THE VECTOR CROSSES A PAGE BOUNDARY IF (.NOT. XMAJOR) GO TO 203 IPAGE1 = (IX1+8) / KSIZE IPAGE2 = (IX2+8) / KSIZE GO TO 208 203 IF (IX1 .GT. IX2) GO TO 205 IPAGE1 = (IX1+8-ILWM) / KSIZE IPAGE2 = (IX2+8+ILWP) / KSIZE GO TO 208 205 IPAGE1 = (IX2+8-ILWM) / KSIZE IPAGE2 = (IX1+8+ILWP) / KSIZE 208 IF (IPAGE1 .EQ. IPAGE2) GO TO 210 C 209 CALL XSTRIP GO TO 220 C 210 CONTINUE CALL OUTVEC C C... RETURN FROM INLINE SUBROUTINE UNLESS IRTN = 0 220 GO TO (70,160),IRTN C RETURN END