SUBROUTINE CIRCLE(XC,YC,RADIUS,IWIDTH) C NAME: CIRCLE 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 C REV. C C 2/19/85 THE CODE TO STROKE OUT CIRCLES IS NOW C IN A SEPARATE SUBROUTINE - XCIRCL. FOR C CHANGES IN THIS CODE SEE SUBROUTINE C XCIRCL. C C CODE TO STRIP CIRCLES IN THE Y-DIRECTION C HAS BEEN ADDED. CIRCLES THAT CROSS THE C STRIPPING BOUNDARY ARE NOW STROKED OUT. C C IF THE OUTPUT IS GOING TO A PRISM C (KREP=4), ONLY CIRCLES WITH A RADIUS C GREATER THAN KSIZE ARE STROKED OUT. C C THE LINE WIDTH IS NOW USED IN THE C CALCULATION OF IBXMAX EVEN IF STRIPPING C IS NOT BEING DONE. C C A BYTE COUNT IS NOW KEPT. C C THE UNPLOTTABLE CIRCLE MESSAGE IS NO C LONGER OUTPUT. (IT IS COMMENTED OUT) C C C CIRCLE - OUTPUT CIRCLE COMMAND TO VRF FILE C C CIRCLE PLOTS A CIRCLE WITH CENTER AT (XC,YC) AND OF RADIUS C RADIUS. IF IWIDTH IS GREATER THAN ZERO, THEN THE CIRCLE OUTLINE C IS DRAWN. IF THE RADIUS IS POSITIVE OR THE TONING FLAG IS C NON-ZERO, THEN THE CIRCLE IS FILLED. IF THE RADIUS IS ZERO, C NOTHING WILL BE PLOTTED. C C IF THE CIRCLE CROSSES A STRIPPING BOUNDARY, XCIRCL IS CALLED. C XCIRCL WILL GENERATE A SET OF POINTS AND CALL CONVEX AND PLOT C TO PLOT THE CIRCLE. CONVEX AND PLOT WILL DO ALL THE NECESSARY C CLIPPING AND STRIPPING AND OUTPUT MOVE/DRAW AND POLYGON C COMMANDS TO THE VRF FILE. C C C ENTRY: CALL CIRCLE(XC,YC,RADIUS,IWIDTH) C XC,YC - COORDINATES OF CIRCLE CENTER C RADIUS - RADIUS OF CIRCLE C IF RADIUS=0 THEN RETURN C >0 THEN TONE THE CIRCLE C <0 THEN DO NOT TONE THE CIRCLE C UNLESS ITNFLG <> 0 C IWIDTH - PEN NUMBER FOR WIDTH OF CIRCLE C <=0 NO OUTLINE, TONE ONLY C 1-7 ARE VALID PEN WIDTHS TO BE USED C C NOTE: SUBROUTINE CIRCLE USES FILL PATTERN INDEX #63 C TO DEFINE A 'NULL' FILL PATTERN FOR OUTLINED C CIRCLES ONLY. C C EXIT: THE CURRENT POSITION IS AT THE CENTER OF THE CIRCLE C C CALLS: MSGLG1,OCHUNK,OCODE,XCIRCL C C CALLED BY: USER C C COMMON USED: C /DVCOM/ C I KPAT - NUMBER OF CURRENTLY ACTIVE TONE PATTERN C I NCLIP - NUMBER OF CLIPPED VECTORS C L PMOVE - STATUS OF LAST PLOT CALL (.TRUE.=MOVE) C R RORG() - AN X,Y PAIR WHICH DEFINES THE CURRENT C SOFTWARE ORIGIN. SET BY REORIGIN CALL C TO *PLOT* C L ROT90 - IF ROT90 = .TRUE. THEN ROTATE THE PLOT C COUNTERCLOCKWISE 90 DEGREES C R VCP() - CURRENT POINT IN COMPUTATIONAL COORDINATES C R WTV() - WINDOW TRANSFORMATION VARIABLES. USED TO C TRANSFORM COORDINATES FROM THE VIEW WINDOW C SYSTEM TO THE VIEWPORT SYSTEM C I XNIPS - NUMBER OF NIBS PER PAGE IN THE X-DIRECTION 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 L VSTRP - .TRUE. IFF Y-STRIPPING ENABLED C /VRFCOM/ C R BYTKNT()- BYTE COUNT FOR EACH COLOR C I IBXMAX - MAXIMUM X VALUE (USED FOR BANDING) C R VRFKNT()- COUNTER FOR RANDOM ELEMENTS C I ICOMD() - INTEGER ARRAY TO HOLD 16/32 BIT VRF C COMMANDS, INITIALIZED IN PLOTS C R OBJKNT()- NUMBER OF EACH TYPE OF OBJECT OUTPUT C OBJKNT(1) - VECTORS C OBJKNT(2) - POLYGONS C OBJKNT(3) - CIRCLES C OBJKNT(4) - CHARACTERS C /CLRCOM/ C I ICLRDF()- ARRAY CONTAINING COLOR DEFINITIONS C I ITNCLR - CURRENT TONE COLOR INDEX C I ITNFLG - USE PEN OR TONE COLOR FOR AREAS C I ITNSEQ()- TONING SEQUENCE FOR OUTPUT C I NCPASS - NUMBER OF COLOR PASSES C C /MSGCOM/ C I INTARG()- ARRAY FOR PASSING INTEGER OUTPUT ARGUMENTS C R RELARG()- ARRAY FOR PASSING REAL OUTPUT ARGUMENTS C 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 VARIABLES: C I IBND - POINTER TO CURRENT TONER BAND C I ICPAT - FILL PATTERN INDEX C I INULL - NULL FILL PATTERN INDEX C I IPAGE1, - MINIMUM AND MAXIMUM PAGE INDICES C IPAGE2 C I IX,IY - INTEGER COORDINATE OF THE CENTER OF THE CIRCLE C I IXRAD - RADIUS IN INTEGER COORDINATES C I KODE - FLAG INDICATING IF THE CENTER OF THE CIRCLE IS C INSIDE THE WINDOW C I LLASTX, - SAVED INTEGER VALUE OF THE CENTER OF THE CIRCLE C LLASTY C L LPAT - FLAG INDICATING IF FILL PATTERN DEFINED C I LWIDTH - LINE WIDTH TO BE OUTPUT C I NTNSEQ - NTNSEQ(,1) - SAVED VALUE OF ITNSEQ() C NTNSEQ(,2) - TURNED ON IFF OUTLINE TO BE DONE WITH C THIS TONER C NTNSEQ(,3) - TURNED ON IFF FILL TO BE DONE WITH C THIS TONER C R X,Y - WORKING X,Y ORDINATES C LOGICAL LPAT 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 /VRFCOM/ - VRF COMMON VARIABLES C INTEGER PRECIS INTEGER OBUF COMMON /VRFCOM/ * DRWELM, DRWMAX, DRWMIN, DRWKNT, ICOPY, * ICNSTX, IBXMAX, IHDCNT, MIN, * NBYTS, NCHUNK, NHEAD, NREC, PRECIS, * RMXELM, VRFMAX, * BYTKNT(4), IBEGIN(4), ICOMD(2), IOCODE(2), IREC(4), * MAX(4), NEXTO(4), OBJKNT(4), VRFKNT(4), OBUF(640) C C... COMMON /CLRCOM/ - COLOR VARIABLES C INTEGER PCOLOR, CURPEN LOGICAL PENCHG COMMON /CLRCOM/ * ICLMAX, ITNCLR, ITNFLG, IVCFLG, NCPASS, PENCHG, * CURPEN(4), ICLRDF(4,512), IDASRT(4), ITNSEQ(4), * PCOLOR(64) C C... COMMON /MSGCOM/ - MESSAGE OUTPUT VARIABLES C COMMON /MSGCOM/ INTARG(8), RELARG(12) C C C... COMMON /KLCOM/ - X STRIPPING VARIABLES C LOGICAL KFLAG COMMON /KLCOM/ KFLAG, KSIZE C... ARRAY TO HOLD TEMP ITNSEQ DIMENSION NTNSEQ(4,3) C C... DEFPAT NULL PAT. INDEX DATA INULL/63/ C C C-D DEBUG MESSAGE C RELARG(1)=XC C RELARG(2)=YC C RELARG(3)=RADIUS C INTARG(1)=IWIDTH C CALL MSGLG1(4) C-D C C... CHECK IF VALID RADIUS IF (RADIUS .EQ. 0.0) GO TO 9999 C C... ADJUST FOR RE-ORIGIN X = XC + RORG(1) Y = YC + RORG(2) C C... CHECK IF ROTATION SPECIFIED IF (.NOT. ROT90) GO TO 100 TMP = X X = -Y Y = TMP C C... CHECK IF IN WINDOW 100 CALL OCODE (X,Y,KODE) IF (KODE .EQ. 0) GO TO 200 C-E C... OUTSIDE WINDOW, IGNORE CALL NCLIP = NCLIP + 1 PMOVE = .TRUE. C-D C... DEBUG MESSAGE - UNPLOTTABLE CIRCLE C RELARG(1)=XC C RELARG(2)=YC C CALL MSGLG1(5) C-D GO TO 999 C-E C C... CHECK LINE WIDTH 200 LWIDTH = IWIDTH IF (LWIDTH .GT. 7) LWIDTH = 7 IF (LWIDTH .LT. 0) LWIDTH = 0 C C... CHECK IF FILL PATTERN DEFINED LPAT = .FALSE. IF (KPAT .NE. -1 .OR. ITNFLG .NE. 0 .OR. RADIUS .LT. 0) * GO TO 205 CALL MSGLG1 (122) LPAT = .TRUE. KPAT = 63 C C... CHECK FOR A NULL CIRCLE (0-WIDTH OUTLINE AND NULL FILL) 205 IF (LWIDTH .GT. 0 .OR. (RADIUS .GT. 0 * .AND. (ITNFLG .NE. 0 .OR. KPAT .NE. 63))) GO TO 210 C C... NULL CIRCLE PMOVE = .TRUE. GO TO 999 C C... COMPUTE X-RADIUS AND Y-RADIUS IN VRF SPACE 210 IXRAD = ABS(RADIUS * WTV(1)) + 0.5 C C... COMPUTE NIB COORDINATES IX = X * WTV(1) + WTV(2) IY = Y * WTV(3) + WTV(4) LLASTX = IX LLASTY = IY C C... CHECK IF THE CIRCLE NEEDS TO BE STRIPPED IN THE Y-DIRECTION. C (USE THE X-RADIUS AS THAT IS WHAT IS ACTUALLY OUTPUT.) IF (.NOT. VSTRP) GO TO 230 IPAGE1 = (IY-IXRAD-LWIDTH/2)/YNIPS IF (IPAGE1 .LT. 0) IPAGE1 = 0 IPAGE2 = (IY+IXRAD+LWIDTH/2)/YNIPS C C... CHECK IF THE CIRCLE CROSSES A STRIPPING BOUNDARY IF (IPAGE1 .EQ. IPAGE2) GO TO 220 CALL XCIRCL(XC,YC,RADIUS,LWIDTH) PMOVE = .TRUE. GO TO 999 C C... CHECK IF THE CIRCLE IS NOT IN THE FIRST STRIP 220 IF (IPAGE1 .EQ. 0) GO TO 230 C C... UPDATE THE CENTER OF THE CIRCLE TO THE PROPER STRIP IX = IX + IPAGE1*XNIPS IY = IY - IPAGE1*YNIPS C 230 CONTINUE C C... CHECK IF X STRIPPING CHECK REQUIRED IF (.NOT. KFLAG) GO TO 240 IF (KREP .EQ. 4 .AND. IXRAD .LT. KSIZE) GO TO 240 C C... CHECK IF PAGE BOUNDARY CROSSED IPAGE1 = (IX-IXRAD+8-LWIDTH/2)/KSIZE IPAGE2 = (IX+IXRAD+8+LWIDTH/2)/KSIZE IF (IPAGE1 .EQ. IPAGE2) GO TO 240 CALL XCIRCL(XC,YC,RADIUS,LWIDTH) PMOVE = .TRUE. GO TO 999 C 240 CONTINUE C 300 IF (ITNFLG .EQ. 0 .OR. RADIUS .LT. 0) GO TO 400 C C... ** TONE COLOR ** C C... NEED TO SET UP SO DATA GOES TO RIGHT COLORS DO 310 IBND=1,NCPASS,1 C C... SAVE CURRENT VALUE NTNSEQ(IBND,1) = ITNSEQ(IBND) C C... CHECK IF OUTLINED IF (LWIDTH .EQ. 0) ITNSEQ(IBND) = IABS(ITNSEQ(IBND)) NTNSEQ(IBND,2) = ITNSEQ(IBND) C C... CHECK IF FILLED WITH THIS TONER NTNSEQ(IBND,3) = IABS(ITNSEQ(IBND)) IF (ICLRDF(NTNSEQ(IBND,3),ITNCLR) .EQ. INULL) GO TO 310 ITNSEQ(IBND) = - NTNSEQ(IBND,3) NTNSEQ(IBND,3) = - NTNSEQ(IBND,3) 310 CONTINUE C C... MOVE TO CENTER OF CIRCLE CALL OCHUNK (IX,-1) CALL OCHUNK (IY,-1) C C... OUTPUT CIRCLE CONSTRUCT CALL OCHUNK (ICOMD(1),0) C C... TURN OFF ALL THE TONERS DO 320 IBND=1,NCPASS,1 ITNSEQ(IBND) = IABS(ITNSEQ(IBND)) 320 CONTINUE C C... OUTPUT THE CIRCLE WITH THE APPROPRIATE PATTERN FOR EACH TONER DO 330 IBND=1,NCPASS,1 C C... CHECK IF THE TONER IS USED FOR EITHER THE FILL OR OUTLINE IF (NTNSEQ(IBND,2).GE.0 .AND. NTNSEQ(IBND,3).GE.0) GO TO 330 C C... TURN ON THE TONER ITNSEQ(IBND) = - ITNSEQ(IBND) C C... OUTPUT THE CIRCLE ITMP = LWIDTH IF (NTNSEQ(IBND,2) .GE. 0) ITMP = 0 CALL OCHUNK(ICLRDF(-ITNSEQ(IBND),ITNCLR),0) CALL OCHUNK(ITMP,0) CALL OCHUNK(IXRAD,-1) C C... COUNT ELEMENTS AND BYTES VRFKNT(IBND) = VRFKNT(IBND) + 2.0 BYTKNT(IBND) = BYTKNT(IBND) + 12.0 IF (ITMP .NE. 0) BYTKNT(IBND) = BYTKNT(IBND) + 12.0 C C... TURN OFF THE TONER ITNSEQ(IBND) = - ITNSEQ(IBND) 330 CONTINUE C C... RESET ITNSEQ TO ORIGINAL SETTING DO 350 IBND=1,NCPASS ITNSEQ(IBND) = NTNSEQ(IBND,1) 350 CONTINUE GO TO 900 C C... ** HATCH PATTERN AND TONE COLOR ** C C... MOVE TO CENTER OF CIRCLE 400 CALL OCHUNK (IX,-1) CALL OCHUNK (IY,-1) C C... GET FILL PATTERN ICPAT = KPAT IF (RADIUS .LT. 0.0) ICPAT = INULL C C... OUTPUT THE CIRCLE CALL OCHUNK (ICOMD(1),0) CALL OCHUNK (ICPAT,0) CALL OCHUNK (LWIDTH,0) CALL OCHUNK (IXRAD,-1) C C... COUNT ELEMENTS AND BYTES DO 450 IBND=1,NCPASS,1 IF (ITNSEQ(IBND) .GT. 0) GO TO 450 VRFKNT(IBND) = VRFKNT(IBND) + 2.0 BYTKNT(IBND) = BYTKNT(IBND) + 12.0 IF (LWIDTH .NE. 0) BYTKNT(IBND) = BYTKNT(IBND) + 12.0 450 CONTINUE C C... UPDATE IBXMAX 900 I = IX + IXRAD + LWIDTH/2 IF (I .GT. IBXMAX) IBXMAX = I C C... COUNT THE CIRCLE OBJKNT(3) = OBJKNT(3) + 1.0 C C... SET VARIABLE TO SHOW WE ARE AT THE CURRENT POINT PMOVE = .FALSE. C C... SAVE CURRENT INTEGER COORDINATES LASTX = LLASTX LASTY = LLASTY C C... UPDATE CURRENT POSITION 999 VCP(1) = X VCP(2) = Y C C... RESET KPAT IF NECESSARY IF (LPAT) KPAT = -1 C 9999 RETURN END