SUBROUTINE XSTRIP C C NAME: XSTRIP 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 SUBROUTINE WAS WRITTEN FOR THIS C REVISION. THE PREVIOUS SUBROUTINE C XSTRIP HAS BEEN DISCARDED. C XSTRIP - VECTOR STRIPPING ALGORITHM. THE VECTOR IS SPLIT C AT EACH 13.65' BOUNDARY. C C ENTRY: CALL XSTRIP C C NOTE: THE VECTOR DOT COORDINATES IX1,IY1,IX2,IY2 ARE OBTAINED C FROM COMMON C C CALLS: OCHUNK,OUTVEC C C CALLED BY: PLOT, DRWPEN, VSTRIP 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 L XMAJOR - INDICATES IF XMAJOR MOVE VECTOR 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 I KSIZE - VARIABLE DEFINING 13.65' IN SCANS, USED TO C DETERMINE IF ELEMENT CROSSES A 13.65' PAGE C BOUNDARY. C C LOCAL: C R BOUND - STRIPPING BOUNDARY C R FKSIZE - REAL-VALUED COPY OF KSIZE C I IBOUND - STRIPPING BOUNDARY C I ICMD - SET-PEN COMMAND WORD C I IILWM, - SAVED VALUES OF ILWM AND ILWP C IILWP C I INDX - LOOP INDEX C I IPAGE1, - PAGE NUMBERS FOR THE ENDPOINTS OF THE VECTOR C IPAGE2 C I IX2SAV, - SAVED VALUE OF THE ENDPOINT OF THE VECTOR C IY2SAV C I IYONE - ADJUSTMENT VALUE IF THE ENDPOINT OF THE VECTOR C NEEDS TO BE ADJUSTED C I JRTN - RETURN VALUE FOR INLINE SUBROUTINE C I KX1,KY1, - SAVED VALUES OF THE VECTOR C KX2,KY2 C I NDLTX, - DELTA X AND Y VALUES C NDLTY C I SAVEW - SAVED VALUE OF KWIDTH C L SWAPPD - TRUE IFF THE ENDPOINTS OF THE VECTOR HAVE C BEEN SWAPPED C R X1,Y1, - REAL VALUED COPY OF THE CURRENT VECTOR C X2,Y2 C C C INCLUDE 'DVCOM.CMN' C C INCLUDE 'PRMCOM.CMN' C C INCLUDE 'VRFCOM.CMN' C C INCLUDE 'KLCOM.CMN' C C INTEGER SAVEW LOGICAL SWAPPD 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 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 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 YINT(AX,AY,BX,BY,C) = (C-AX) * (BY-AY) / (BX-AX) + AY C C ************************* C * BEGIN EXECUTABLE CODE * C ************************* C C C... ORDER VECTOR MOVE BY 'X' 30 SWAPPD = .FALSE. IF (IX1.LE.IX2) 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 IYONE = 1 IF (IY1 .GT. IY2) IYONE = -1 C C... CHECK IF MULTIWIDTH Y-MAJOR VECTOR AND NOT A PRISM JRTN = 0 IF ( XMAJOR .OR. KWIDTH .LE. 1 .OR. KREP .EQ. 4) GO TO 100 C C... Y-MAJOR MULTIWIDTH VECTOR C VECTOR MUST BE STROKED OUT USING ONE NIB WIDE VECTORS C AN Y-MAJOR VECTOR IS PLOTTED BY THE CONTROLLER WITH A C VERTICAL TOP AND BOTTOM (I.E. AS A GROUP OF ONE NIB WIDE C VECTORS THAT ARE OFFSET BY ONE NIB IN THE X-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 Y-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 IX1 = IX1 - IILWM IX2 = IX2 - 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 WHETHER IX1 IS NEGATIVE 50 IF (IX1 .GE. 0) GO TO 60 C C... CLIP THE VECTOR AT X=0 IY1 = IYINT(IX1,IY1,IX2,IY2,0) IX1 = 0 C C... OUTPUT THE VECTOR 60 GO TO 100 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 KX1 = KX1 + 1 KX2 = KX2 + 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 X-MAJOR VECTORS C AS WELL AS ONE NIB WIDE Y-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... DETERMINE PAGES IPAGE1 = (IX1+8)/KSIZE IPAGE2 = (IX2+8)/KSIZE C C... INITIALIZE STRIPPING BOUNDARY FKSIZE = KSIZE IBOUND = IPAGE1*KSIZE + KSIZE - 8 BOUND = FLOAT(IBOUND) - 0.5 C C... CHECK IF REMAINING VECTOR NEEDS TO BE STRIPPED 120 IF (IPAGE1 .EQ. IPAGE2) GO TO 121 C C... DETERMINE INTERSECTION POINT WITH NEXT STRIPPING BOUNDARY Y1 = YINT(X1,Y1,X2,Y2,BOUND) X1 = BOUND IX2 = IBOUND - 1 IY2 = Y1 + 0.5 GO TO 122 C C... USE ENDPOINT OF VECTOR 121 IX2 = IX2SAV IY2 = IY2SAV C C... CHECK FOR AN X-MAJOR THICK VECTOR THAT TURNED C INTO A Y-MAJOR VECTOR 122 IF (.NOT. XMAJOR) GO TO 150 IF (KWIDTH .LE. 1) GO TO 150 NDLTX = IABS(IX2-IX1) NDLTY = IABS(IY2-IY1) IF (NDLTX .GE. NDLTY) GO TO 150 C C... THE VECTOR HAS CHANGED TO Y-MAJOR, ADJUST IY1 C TO MAKE IT X-MAJOR PMOVE = .TRUE. IY1 = IY1 + IYONE C C... OUTPUT THE VECTOR 150 CALL OUTVEC C C... CHECK IF DONE 160 IF (IPAGE1 .EQ. IPAGE2) GO TO 170 C C... UPDATE FOR MORE STRIPPING C IX1 = IBOUND IY1 = IY2 IBOUND = IBOUND + KSIZE BOUND = BOUND + FKSIZE PMOVE = .TRUE. IPAGE1 = IPAGE1 + 1 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 (SWAPPD) PMOVE = .TRUE. RETURN END