SUBROUTINE DRWPEN C C NAME: DRWPEN C C LANGUAGE: FORTRAN C C OPERATING SYSTEM: UNIVERSAL C C ORDER NUMBER: 5428-SE C C PART NUMBER: 000-026366 NOVEMBER 1985 C C PRODUCT: UNIVERSAL 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. IT IS USED TO STROKE OUT C EACH DASH OF A LINE DEFINED WITH A C NIBS ON, NIBS OFF, NIBS ON, NIBS OFF C PATTERN. C C DRWPEN - PROCESS VECTORS DRAWN WITH PENS DEFINED WITH C NIBS ON/OFF/ON/OFF PATTERNS. THE ENDPOINTS OF C THE VECTOR TO BE DRAWN ARE TAKEN FROM THE VARIABLES C IX1,IY1,IX2,IY2 IN COMMON. C C ENTRY: CALL DRWPEN C C EXIT: DASHED VECTOR DRAWN C C CALLS: OUTVEC, VSTRIP, XSTRIP C C CALLED BY: PLOT 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 JPEN - THE CURRENT PEN NUMBER C I KWIDTH - WIDTH OF CURRENT PEN C I PENPAT()- ARRAY TO STORE PEN DEFINITIONS C L PMOVE - STATUS OF LAST PLOT CALL (.TRUE.=MOVE) C L VSFLAG - .TRUE. IFF STRIPPING IN THE Y-DIRECTION C IS NECESSARY C I YNIPS - NIBS PER SCAN 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 LOCAL: C L ADJUST - .TRUE. IFF THE LAST DASH HAD ITS ENDPOINTS ADJUSTED C R DLT() - LENGTH OF EACH ON OR OFF SEGMENT C R DLTX(), - X OR Y OFFSET FOR EACH ON OR OFF SEGMENT C DLTY() C R DX,DY - DELTA X AND Y VALUES OF THE VECTOR C I IPAGE1, - PAGE NUMBERS FOR THE TOP AND BOTTOM OF EACH DASH, C IPAGE2 USED FOR X-STRIPPING C I IX2SAV, - SAVED VALUES OF IX2 AND IY2 C IY2SAV C I IXONE, - ADJUSTMENT VALUES: +1 IF DELTA X (Y) IS POSITIVE C IYONE -1 IF DELTA X (Y) IS NEGATIVE C I JRTN - RETURN FLAG FOR INLINE SUBROUTINE C I NDLTX, - DELTA X AND Y VALUES C NDLTY C R VL - VECTOR LENGTH C R X2,Y2 - ENDPOINT OF THE CURRENT DASH C R XF,YF - X AND Y FACTORS RELATIVE TO THE VECTOR LENGTH C (USED TO COMPUTE DLTX() AND DLTY().) C C C LOGICAL ROT90,PMOVE,IPDEF,DASHPN,XMAJOR,VSFLAG INTEGER PWIDTH,XNIPS,YNIPS,PENPAT,VSMAX,PFONT C... COMMON /DVCOM/ PHASE I COMMON VARIABLES C COMMON /DVCOM/ * ANC, DASHPN, FACT, HTC, ICUT, ICWTV, ICXPTS, * IEOJ, ILWM, ILWP, IOPEN, ISORT, ITFLAG, IX1, * IX2, IY1, IY2, JFONT, JPEN, KPAT, KWIDTH, * LASTX, LASTY, MAXPAT, MSB, MSKALL, NCH, NCLIP, * NIBSX, NLPAT, NPLOT, PFONT, PMOVE, PXMIN, PXMAX, * PYMIN, PYMAX, RADN, ROT90, SXC, SYC, TSINA, * TCOSA, XDEN, XFAC, XNIPS, XOFF, YDEN, YFAC, * YOFF, YNIPS, VSFLAG, VSMAX, XMAJOR, * IPAT(16,256), IEOP(4), IHBUF(2), IPDEF(64), * NPAT(255), PENPAT(4,64), PWIDTH(64), * RORG(2), VCP(2), VP(4), WIN(4), WTV(4), WX(4), WY(4), * IAUTXT(15) C C C C... COMMON /PRMCOM/ - DEFAULT PLOTTING PARAMETERS C INTEGER PENTBL,BMODEL,BBYTES,CMODEL,CBYTES LOGICAL VSTRP COMMON /PRMCOM/ * IBYTES, IDISK, IFFAP, LASTFF, * IJPEN, INHNCE, INITFF, INVERS, * IRDT, ISPACE, ISPEED, ISFLAG, * IUSER, JBYTES(75), KREP, IFONT, * MIRROR, MODEL, MODL(75), MXPEN, * NCOPY, NMODL, PENTBL(64,2), RDEN, * RDENS(75), SCALE, UNITS, XFACT, * YFACT, XSTART, YSTART, * VXMIN, VXMAX, VYMIN, VYMAX, * WXMIN, WXMAX, WYMIN, WYMAX, * BMODEL, BDEN, BBYTES, * CMODEL, CDEN, CBYTES, * IDEFLG(256), IUCLR, MODE1, IPRISM(61), * MUXOUT, PMSIZE, MAXPEN, KTWO, * LTNFLG, LTNCLR, MTAPE, VSTRP, * JSORT, JCPCMD, JCUT, KDISK C C... COMMON /KLCOM/ - X STRIPPING VARIABLES C LOGICAL KFLAG COMMON /KLCOM/ KFLAG, KSIZE C C DIMENSION DLT(4), DLTX(4), DLTY(4) LOGICAL ADJUST C C C... COMPUTE LENGTH OF VECTOR DX = IX2 - IX1 DY = IY2 - IY1 VL = SQRT (DX*DX + DY*DY) C C... COMPUTE X FACTOR AND Y FACTOR XF = DX/VL YF = DY/VL C C... COMPUTE LENGTH OF DASH SEGMENTS DLT(1) = PENPAT(1,JPEN+1) DLT(2) = PENPAT(2,JPEN+1) DLT(3) = PENPAT(3,JPEN+1) DLT(4) = PENPAT(4,JPEN+1) C C... ADJUST THE ON AND OFF SEGMENTS (IF POSSIBLE) C SO THAT THE CORRECT NUMBER OF DOTS ARE TURNED ON AND OFF IF (DLT(1) .EQ. 0 .OR. DLT(3) .EQ. 0) GO TO 50 DLT(1) = DLT(1) - 1. DLT(2) = DLT(2) + 1. DLT(3) = DLT(3) - 1. DLT(4) = DLT(4) + 1. 50 CONTINUE C DO 100 IA = 1,4 DLTX(IA) = DLT(IA) * XF DLTY(IA) = DLT(IA) * YF 100 CONTINUE C C... SAVE THE ENDPOINTS IX2SAV = IX2 IY2SAV = IY2 C C... INITIALIZE CURRENT POSITION X2 = IX1 + 0.5 Y2 = IY1 + 0.5 C C... INITIALIZE UNIT OFFSETS IXONE = 1 IF (IX1 .GT. IX2) IXONE = -1 IYONE = 1 IF (IY1 .GT. IY2) IYONE = -1 C C C ******************************** C * PROCESS NIBS ON/OFF SEGMENTS * C ******************************** C J = 1 C C... CHECK IF ROOM FOR NEXT ON SEGMENT 120 VL = VL - DLT(J) IF (VL .GT. 0.0 ) GO TO 125 C IX2 = IX2SAV IY2 = IY2SAV JRTN = 0 GO TO 500 C C... COMPUTE END POINT OF NEXT ON SEGMENT 125 X2 = X2 + DLTX(J) Y2 = Y2 + DLTY(J) IX2 = X2 IY2 = Y2 C C... OUTPUT THE SEGMENT JRTN = 1 GO TO 500 C C... PROCESS OFF SEGMENT 200 J = J+1 C C... INDICATE MOVE COMMAND PMOVE = .TRUE. C C... CHECK IF ROOM FOR NEXT OFF SEGMENT VL = VL - DLT(J) IF (VL .LE. 0.0) GO TO 9999 C C... COMPUTE START OF NEXT ON SEGMENT X2 = X2 + DLTX(J) Y2 = Y2 + DLTY(J) IX1 = X2 IY1 = Y2 C C... PROCESS NEXT ON SEGMENT J = J+1 IF (J .EQ. 5) J = 1 GO TO 120 C C ***************** C * OUTPUT VECTOR * C ***************** C 500 CONTINUE C C... THIS IS RIDICULOUS, BUT . . . C C... WE WANT X-MAJOR VECTORS TO REMAIN X-MAJOR, AND C Y-MAJOR VECTORS TO REMAIN Y-MAJOR. C IF WE EVER DO THICK LINES DIFFERENTLY, WE WILL WANT TO C REVIEW THIS CODE TO SEE IF IT IS STILL NECESSARY. C C... THIS CODE ADJUSTS THE ENDPOINTS OF THE LINE SEGMENT BY AT MOST C ONE NIB IN EITHER DIRECTION TO INSURE THAT THE SEGMENT REMAINS C EITHER X-MAJOR OR Y-MAJOR. C ADJUST = .FALSE. IF (KWIDTH .EQ. 1) GO TO 600 IF (XMAJOR) GO TO 550 C C... Y-MAJOR VECTORS C C... CHECK TO SEE IF IT IS STILL Y-MAJOR C NDLTX = IABS(IX2-IX1) NDLTY = IABS(IY2-IY1) IF (NDLTY .GT. NDLTX) GO TO 600 ADJUST = .TRUE. IF (NDLTX .GT. NDLTY) GO TO 530 C C... THE VECTOR IS EXACTLY 45 DEGREES. C CHECK IF LENGTH IS ZERO. C IF (NDLTX .EQ. 0) GO TO 520 C C... WE ADJUST IX2 TO MAKE IT Y-MAJOR. C IX2 = IX2 - IXONE GO TO 600 C C... WE ADJUST IY2 TO MAKE IT Y-MAJOR. C 520 IY2 = IY2 + IYONE GO TO 540 C C... THE VECTOR IS LESS THAN 45 DEGREES. C IT MUST BE THE CASE THAT NDLTX = NDLTY+1 (WE KNOW THAT C DLTY(J) > DLTX(J) SO EVEN WITH INTEGER TRUNCATION, THE C WORST CASE IS NDLTX <= NDLTY+1.) C WE ADJUST IX2 AND IY2 TO MAKE IT Y-MAJOR. C 530 IX2 = IX2 - IXONE IY2 = IY2 + IYONE C C... MAKE SURE IY2 WASN'T ADJUSTED TO A NEGATIVE VALUE C 540 IF (IY2 .LT. 0) IY2 = 0 GO TO 600 C C... X-MAJOR VECTORS C C... CHECK TO SEE IF IT IS STILL X-MAJOR C 550 NDLTX = IABS(IX2-IX1) NDLTY = IABS(IY2-IY1) IF (NDLTX .GE. NDLTY) GO TO 600 C C... THE VECTOR IS GREATER THAN 45 DEGREES. C IT MUST BE THE CASE THAT NDLTY = NDLTX+1 (WE KNOW THAT C DLTX(J) > DLTY(J) SO EVEN WITH INTEGER TRUNCATION, THE C WORST CASE IS NDLTY <= NDLTX+1.) C WE ADJUST IY2 TO MAKE IT X-MAJOR. C ADJUST = .TRUE. IY2 = IY2 - IYONE C C... CHECK IF THE VECTOR NEEDS TO BE STRIPPED IN THE Y-DIRECTION 600 IF (.NOT. VSFLAG) GO TO 700 IF (XMAJOR) GO TO 650 IF (IY1 .LT. YNIPS .AND. IY2 .LT. YNIPS) GO TO 700 GO TO 675 650 IF ((IY1+ILWP).LT.YNIPS .AND. (IY2+ILWP).LT.YNIPS) GO TO 700 C 675 CALL VSTRIP GO TO 1000 C 700 CONTINUE C C... CHECK IF THE VECTOR NEEDS TO BE STRIPPED IN THE X-DIRECTION IF (.NOT. KFLAG) GO TO 800 C C... CHECK IF THE VECTOR IS LONGER THAN KSIZE NDLTX = IABS(IX2-IX1) IF (NDLTX .GE. KSIZE) GO TO 780 C C... IF PRISM, STRIPPING IS NOT NECESSARY IF (KREP .EQ. 4) GO TO 800 C C... CHECK IF THE VECTOR CROSSES A PAGE BOUNDARY IF (.NOT. XMAJOR) GO TO 725 IPAGE1 = (IX1+8) / KSIZE IPAGE2 = (IX2+8) / KSIZE GO TO 775 725 IF (IX1 .GT. IX2) GO TO 750 IPAGE1 = (IX1+8-ILWM) / KSIZE IPAGE2 = (IX2+8+ILWP) / KSIZE GO TO 775 750 IPAGE1 = (IX2+8-ILWM) / KSIZE IPAGE2 = (IX1+8+ILWP) / KSIZE 775 IF (IPAGE1 .EQ. IPAGE2) GO TO 800 C 780 CALL XSTRIP GO TO 1000 C 800 CONTINUE CALL OUTVEC C C... CHECK IF MORE ON-OFF SEGMENTS 1000 IF (JRTN .EQ. 1) GO TO 200 C IF (ADJUST) PMOVE = .TRUE. 9999 RETURN END