SUBROUTINE XCIRCL ( XC, YC, RADIUS, IWIDTH ) C C NAME: XCIRCL C C LANGUAGE: FORTRAN C C OPERATING SYSTEM: DEC VAX/VMS C C ORDER NUMBER: 5448 C C PART NUMBER: 000-025522-001 JULY 1985 C C PRODUCT: DEC VAX/VMS COLOR VERSAPLOT 9.2 C C VERSATEC, INC., SANTA CLARA, CALIFORNIA 95051 C A XEROX COMPANY C C Copyright (C) 1984 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 THIS SUBROUTINE WAS CREATED TO DO THE C STROKING OUT OF CIRCLES THAT CROSS C STRIPPING BOUNDARIES THAT WAS PREVIOSLY C DONE IN SUBROUTINE CIRCLE. THIS C ROUTINE CALCULATES POINTS USING THE C ALGORITHM FROM VERSAPLOT 9 COLOR INSTEAD C OF THE PARAMETRIC EQUATIONS USED BEFORE. C THIS ROUTINE CALLS PLOT TO STROKE OUT C THE OUTLINE AND CALLS CONVEX TO OUTPUT C THE FILL AREA. C C XCIRCL OUTLINES AND/OR TONES A CIRCLE WITH CENTER C AND WITH A RADIUS OF ABS(RADIUS). C AN OUTLINE IS DRAWN IF IWIDTH IS GREATER THAN ZERO. C THE PEN WIDTH FOR THE OUTLINE WILL BE IWIDTH. C THE CIRCLE IS TONED IF RADIUS IS GREATER THAN ZERO. C C XCIRCL FIRST GENERATES POINTS FOR A QUARTER CIRCLE OF RADIUS C RADIUS THAT IS CENTERED AT THE ORIGIN. THESE POINTS ARE C THEN MIRRORED ABOUT THE X AND Y AXES TO GET THE REST OF THE C POINTS FOR THE CIRCLE. C THE POINTS FOR THE QUARTER CIRCLE ARE GENERATED IN THREE PARTS. C THE CRITICAL PARTS OF THE CIRCLE ( IN TERMS OF VISUAL PERCEPTION ) C ARE THE TOP, BOTTOM, LEFT, AND RIGHT. THEREFORE, THE POINTS FOR C THE TOP AND RIGHT OF THE QUARTER CIRCLE ARE EACH GENERATED C SEPARATELY AND CHECKS ARE MADE TO INSURE THAT THE POINTS ARE C SEPARATED BY AT LEAST ONE NIB IN BOTH THE X AND Y DIRECTIONS. C THEN, MORE POINTS ARE GENERATED FOR THE REST OF THE QUARTER C CIRCLE BY THE USE OF PARAMETRIC EQUATIONS. C C ENTRY: CALL XCIRCL(XC,YC,RADIUS,IWIDTH) C XC,YC - COORDINATES OF THE CENTER OF THE CIRCLE C RADIUS - ABS(RADIUS) = RADIUS OF THE CIRCLE C IF RADIUS = 0 THEN THE CIRCLE IS NOT DRAWN C > 0 THEN THE CIRCLE IS TONED C < 0 THEN THE CIRCLE IS NOT TONED C IWIDTH - PEN WIDTH OF THE CIRCLE OUTLINE C 1-7 - VALID PEN WIDTHS FOR THE OUTLINE C IF IWIDTH <= 0 THEN NO OUTLINE IS DRAWN C IF IWIDTH > 7 THEN AN OUTLINE OF WIDTH 7 C IS DRAWN C C EXIT: THE CURRENT POSITION IS SET TO THE CENTER OF THE CIRCLE C C COMMON USED: C C /DVCOM/ C L DASHPN - .TRUE. IFF THE CURRENT PEN IS DEFINED AS C AN ON-OFF-ON-OFF PATTERN C I ILWP - (LINE WIDTH - 1)/2 C I ILWM - LINE WIDTH/2 C I KPAT - NUMBER OF CURRENTLY ACTIVE TONE PATTERN C I KWIDTH - WIDTH OF CURRENT PEN 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 WTV() - WINDOW TRANSFORMATION VARIABLES. USED TO C TRANSFORM COORDINATES FROM THE VIEW WINDOW C SYSTEM TO THE VIEWPORT SYSTEM C /CLRCOM/ C I ITNFLG - USE PEN OR TONE COLOR FOR AREAS C C LOCAL USED: C R ANGINC - ANGULAR INCREMENT - USED IN DETERMINING THE POINTS C FOR THE MIDDLE OF THE QUARTER CIRCLE C R COSINC - COSINE OF THE ANGULAR INCREMENT C R DIFFX,DIFFX1,DIFFX2 - DELTA X VALUES C DIFFY,DIFFY1,DIFFY2 - DELTA Y VALUES C L FULL1, - INDICATES WHETHER MORE POINTS COULD BE GENERATED C FULL2 FOR THE FIRST OR SECOND END OF THE QUARTER CIRCLE C I I1,I2 - NUMBER OF POINTS GENERATED FOR EACH END OF C THE QUARTER CIRCLE C I ICMD - SET-PEN COMMAND WORD C I IILWM - SAVED VALUE OF ILWM C I IILWP - SAVED VALUE OF ILWP C I ISIZE - MAXIMUM NUMBER OF POINTS TO BE GENERATED AT EACH C END OF THE QUARTER CIRCLE C I ISIZE3 - MAXIMUM NUMBER OF POINTS TO BE GENERATED IN THE C MIDDLE OF THE QUARTER CIRCLE C I ITOTPT - COUNT OF THE NUMBER OF POINTS GENERATED C I JPDEF - SAVED VALUE OF THE CURRENT PEN DEFINED FLAG C I JWIDTH - SAVED VALUE OF THE CURRENT PEN WIDTH C I K1,K2,K3- INDICES USED IN GENERATING THE FULL CIRCLE FROM C THE QUARTER CIRCLE C I NPTS - NUMBER OF POINTS GENERATED IN THE MIDDLE OF THE C QUARTER CIRCLE C I NTNSEQ()- SAVED VALUES OF ITNSEQ() C R RAD - RADIUS OF THE CIRCLE C R RADSQ - THE RADIUS SQUARED C L SAVDSH - SAVED VALUE OF DASHPN C I SAVEW - SAVED VALUE OF KWIDTH C R SININC - THE SINE OF THE ANGULAR INCREMENT C R X(),Y() - COORDINATES OF THE POINTS GENERATED FOR THE CIRCLE C R X1(), - COORDINATES OF THE POINTS GENERATED FOR THE END OF C Y1() THE QUARTER CIRCLE WHERE XY C R X3(), - COORDINATES OF THE POINTS GENERATED FOR THE MIDDLE C Y3() OF THE QUARTER CIRCLE C R XCNEW, - ADJUSTED COORDINATES OF THE CENTER OF THE CIRCLE C YCNEW C R XCURR, - COORDINATES OF THE CURRENT POINT - USED WITH THE C YCURR PARAMETRIC EQUATIONS IN DETERMINING THE MIDDLE C POINTS OF THE QUARTER CIRCLE C R XNEW, - COORDINATES OF THE NEXT POINT GENERATED - USED IN C YNEW DETERMINING THE POINTS FOR THE ENDS OF THE C QUARTER CIRCLE C R XRAD, - RADIUS OF THE CIRCLE ADJUSTED TO BE A MULTIPLE C YRAD OF THE NUMBER OF DOTS IN THE X OR Y DIRECTION C R XSTEP - STEP VALUE FOR THE X-DIRECTION C R YSTEP - STEP VALUE FOR THE Y-DIRECTION C C CALLS: ATAN,COS,SIN,SQRT,PLOT,TCLIP,MSGLG1 C C C INCLUDE 'DVCOM.CMN' C C INCLUDE 'CLRCOM.CMN' C C C... SET-PEN COMMAND WORD (X'8301') DATA ICMD/33537/ DATA ISIZE/2/ DATA ISIZE3/10/ DATA SQRT05/.707106/ DIMENSION X1(2),Y1(2),X2(2),Y2(2),X3(10),Y3(10) DIMENSION X(56),Y(56) DIMENSION NTNSEQ(4) LOGICAL FULL1, FULL2, SAVDSH INTEGER SAVEW C C... CHECK FOR A RADIUS OF 0 IF ( RADIUS .EQ. 0.0 ) GO TO 9999 RAD = ABS( RADIUS ) C C... ADJUST THE CENTER OF THE CIRCLE TO LIE EXACTLY BETWEEN DOTS C IN BOTH THE X AND Y DIRECTIONS IF ( ROT90 ) GO TO 10 C I = ( XC + RORG(1) ) * ABS( WTV(1) ) + WTV(2) XCNEW = ( I - WTV(2) + 0.5 ) / ABS( WTV(1) ) - RORG(1) I = ( YC + RORG(2) ) * ABS( WTV(3) ) + WTV(4) YCNEW = ( I - WTV(4) + 0.5 ) / ABS( WTV(3) ) - RORG(2) GO TO 20 C 10 I = ( XC + RORG(1) ) * ABS( WTV(3) ) + WTV(4) XCNEW = ( I - WTV(4) + 0.5 ) / ABS( WTV(3) ) - RORG(1) I = ( YC + RORG(2) ) * ABS( WTV(1) ) + WTV(2) YCNEW = ( I - WTV(2) + 0.5 ) / ABS( WTV(1) ) - RORG(2) C 20 CONTINUE C C... GET THE STEP VALUES C WE WANT TO INSURE THAT A STEP IS AT LEAST C 1 NIB IN EITHER DIRECTION XSTEP = 1.00001 / ABS( WTV(1) ) YSTEP = 1.00001 / ABS( WTV(3) ) C C... GENERATE POINTS FOR A CIRCLE OF RADIUS RAD THAT C IS CENTERED AT THE ORIGIN. C C... GET SOME POINTS FOR Y > X. C AT MOST ISIZE POINTS ARE GENERATED. C THE FIRST POINT IS NEAR <0,RAD>. C THE REST OF THE POINTS ARE ON THE CIRCLE AND C ARE GENERATED IN ORDER OF DECREASING Y ( AND C INCREASING X ) TOWARD THE 45 DEGREE LINE X = Y. C THE POINTS ARE SEPARATED BY AT LEAST YSTEP IN THE Y-DIRECTION C AND AT LEAST XSTEP IN THE X-DIRECTION AND NO POINTS ARE C GENERATED THAT CROSS THE 45 DEGREE LINE ( X > Y ). C C... ADJUST THE RADIUS SO THAT IT IS A MULTIPLE OF THE C NUMBER OF DOTS IN THE Y-DIRECTION I = RAD * ABS( WTV(3) ) + .5 YRAD = I / ABS( WTV(3) ) RADSQ = YRAD*YRAD C C... THE FIRST POINT IS OFFSET SLIGHTLY FROM <0,YRAD> C ( BECAUSE THE CIRCLE SEEMS TO LOOK BETTER ) I1 = 1 Y1(1) = YRAD IF (YSTEP .LT. YRAD) GOTO 130 X1(1) = 0.0 FULL1 = .TRUE. GO TO 200 130 X1(1) = .33*SQRT( YSTEP*(YRAD-YSTEP/4) ) C C... DETERMINE THE REST OF THE POINTS YNEW = YRAD 140 CONTINUE C C... DETERMINE THE POINT THAT IS ONE STEP IN THE Y-DIRECTION YNEW = YNEW - YSTEP XNEW = SQRT( RADSQ - YNEW*YNEW ) C C... CHECK WHETHER THIS POINT FILLS UP THIS EIGHTH C OF THE CIRCLE FULL1 = ( XNEW .GE. YNEW ) C C... IF THE POINT CROSSES THE 45-DEGREE LINE, DON'T USE IT C AND TERMINATE PROCESSING FOR THIS LOOP IF ( XNEW .GT. YNEW ) GOTO 200 C C... DON'T USE THE POINT IF IT ISN'T SEPARATED FROM THE C PREVIOUS ONE BY AT LEAST 1 STEP IN THE X-DIRECTION IF ( XNEW .LT. X1(I1)+XSTEP ) GO TO 140 C C... USE THE POINT I1 = I1 + 1 X1(I1) = XNEW Y1(I1) = YNEW C C... CHECK WHETHER ANY MORE POINTS CAN BE GENERATED IF ( .NOT. FULL1 .AND. I1 .LT. ISIZE ) GO TO 140 C C C... GET SOME POINTS FOR X > Y. C C... CHECK WHETHER THE NUMBER OF DOTS IS THE SAME C IN THE X AND Y DIRECTIONS. IF IT IS, WE CAN USE THE C POINTS WE JUST GENERATED ( WE JUST MIRROR THE POINTS. ) 200 IF ( ABS( 1 - ABS(WTV(1)/WTV(3)) ) .GT. .0001 ) GO TO 220 DO 210 I=1,I1 X2(I) = Y1(I) 210 Y2(I) = X1(I) I2 = I1 FULL2 = FULL1 GO TO 300 C C... GET SOME NEW POINTS FOR X > Y. C AT MOST ISIZE POINTS ARE GENERATED. C THE FIRST POINT IS NEAR . C THE REST OF THE POINTS ARE ON THE CIRCLE AND C ARE GENERATED IN ORDER OF DECREASING X ( AND C INCREASING Y ) TOWARD THE 45 DEGREE LINE X = Y. C THE POINTS ARE SEPARATED BY AT LEAST XSTEP IN THE X-DIRECTION C AND AT LEAST YSTEP IN THE Y-DIRECTION AND NO POINTS ARE C GENERATED THAT CROSS THE 45 DEGREE LINE ( X < Y ). C C... ADJUST THE RADIUS SO THAT IT IS A MULTIPLE OF THE C NUMBER OF DOTS IN THE X-DIRECTION 220 I = RAD * ABS( WTV(1) ) + .5 XRAD = I / ABS( WTV(1) ) RADSQ = XRAD*XRAD C C... THE FIRST POINT IS OFFSET SLIGHTLY FROM C ( BECAUSE THE CIRCLE SEEMS TO LOOK BETTER ) I2 = 1 X2(1) = XRAD IF (XSTEP .LT. XRAD) GOTO 230 Y2(1) = 0.0 FULL2 = .TRUE. GO TO 300 230 Y2(1) = .33*SQRT( XSTEP*(XRAD-XSTEP/4) ) C C... GENERATE THE REST OF THESE POINTS XNEW = XRAD 240 CONTINUE C C... DETERMINE THE POINT THAT IS ONE STEP IN THE X-DIRECTION XNEW = XNEW - XSTEP YNEW = SQRT( RADSQ - XNEW*XNEW ) C C... CHECK WHETHER THIS POINT FILLS UP THIS EIGHTH C OF THE CIRCLE FULL2 = ( XNEW .LE. YNEW ) C C... IF THE POINT CROSSES THE 45-DEGREE LINE, DON'T USE IT C AND TERMINATE PROCESSING FOR THIS LOOP IF ( XNEW .LT. YNEW ) GOTO 300 C C... DON'T USE THE POINT IF IT ISN'T SEPARATED FROM THE C PREVIOUS ONE BY AT LEAST 1 STEP IN THE Y-DIRECTION IF ( YNEW .LT. Y2(I2)+YSTEP ) GO TO 240 C C... USE THE POINT I2 = I2 + 1 X2(I2) = XNEW Y2(I2) = YNEW C C... CHECK WHETHER ANY MORE POINTS CAN BE GENERATED IF ( .NOT. FULL2 .AND. I2 .LT. ISIZE ) GO TO 240 C 300 CONTINUE C C... SO FAR WE HAVE GENERATED TWO SETS OF POINTS FOR THE C QUARTER CIRCLE. ONE SET NEAR <0,RAD> AND THE C OTHER SET NEAR . FOR SMALL CIRCLES, THESE C TWO SETS ARE SUFFICIENT. HOWEVER, FOR LARGER CIRCLES, C WE NEED A THIRD SET OF POINTS BETWEEN THE OTHER TWO. C C... INITIALIZE THE NUMBER OF POINTS FOR THE THIRD SET OF POINTS NPTS = 0 C C... LET A BE THE POINT C B BE THE POINT C THESE ARE THE LAST POINTS FOR THE TWO SETS OF POINTS C ALREADY GENERATED C C... COMPUTE ABSOLUTE DELTA X AND DELTA Y BETWEEN A AND B DIFFX = X2(I2) - X1(I1) DIFFY = Y1(I1) - Y2(I2) C C... CHECK WHETHER A AND B ARE LESS THAN 1 STEP APART C IN EITHER DIRECTION IF ( DIFFX .GE. XSTEP .AND. DIFFY .GE. YSTEP ) GOTO 310 C C... A AND B ARE TOO CLOSE TOGETHER. C COMPUTE THE MIDPOINT OF THE QUARTER CIRCLE AND C USE IT INSTEAD OF THE TWO POINTS X1(I1) = SQRT05 * RAD Y1(I1) = X1(I1) I2 = I2 - 1 GO TO 400 C 310 CONTINUE C C... IF EITHER EIGHTH OF THE CIRCLE WAS FULL, C DO NOT GENERATE ANY MORE POINTS IF ( FULL1 .OR. FULL2 ) GO TO 400 C C... COMPUTE THE ABSOLUTE DELTA X AND DELTA Y VALUES FOR THE LAST C STEPS TAKEN IN THE TWO SETS OF POINTS ALREADY GENERATED C DIFFX1 = X1(I1) - X1(I1-1) DIFFY1 = Y1(I1-1) - Y1(I1) DIFFX2 = X2(I2-1) - X2(I2) DIFFY2 = Y2(I2) - Y2(I2-1) C C... USE THE DIFFERENCES TO COMPUTE A ROUGH ESTIMATE OF THE NUMBER C OF AREAS INTO WHICH THE REMAINING PART OF THE QUARTER CIRCLE C CAN BE BROKEN UP. NPTSX = DIFFX / AMAX1( DIFFX1, DIFFX2 ) NPTSY = DIFFY / AMAX1( DIFFY1, DIFFY2 ) NPTS = AMIN0( NPTSX, NPTSY ) C C... SUBTRACT 1 TO GET THE NUMBER OF POINTS, C MAKE SURE WE GET AN EVEN NUMBER OF POINTS, C AND LIMIT THE NUMBER OF POINTS TO ISIZE3. C NOTE: WE WANT AN EVEN NUMBER TO AVOID GETTING A POINT C THAT IS EXACTLY ON THE 45-DEGREE LINE C ( THE CIRCLE LOOKS BETTER THIS WAY ) NPTS = ( ( NPTS - 1 ) / 2 ) * 2 IF ( NPTS .GT. ISIZE3 ) NPTS = ISIZE3 C C... GENERATE NPTS MORE POINTS IF ( NPTS .LT. 1 ) GOTO 400 C C... THE REMAINING POINTS WILL BE EVENLY SPACED BETWEEN A AND B. C C... CALCULATE THE ANGULAR INCREMENT FOR THE POINTS RADIAN = ATAN( Y1(I1) / X1(I1) ) - ATAN( Y2(I2) / X2(I2) ) ANGINC = RADIAN / ( NPTS + 1.0 ) C C... CALCULATE THE SINE AND COSINE OF THE ANGULAR INCREMENT SININC = SIN( ANGINC ) COSINC = COS( ANGINC ) C C... STARTING AT POINT B, GENERATE NEW POINTS BETWEEN A AND B XCURR = X2(I2) YCURR = Y2(I2) DO 350 I=1,NPTS C C... CALCULATE THE NEXT POINT X3(I) = XCURR * COSINC - YCURR * SININC Y3(I) = XCURR * SININC + YCURR * COSINC C C... REPLACE THE CURRENT X AND Y XCURR = X3(I) YCURR = Y3(I) 350 CONTINUE C 400 CONTINUE C C... TAKE THE THREE SETS OF POINTS GENERATED AND CONCATENATE C THEM TOGETHER TO GET ALL THE POINTS FOR THE QUARTER CIRCLE DO 410 J = 1,I1 X(J) = X1(J) 410 Y(J) = Y1(J) ITOTPT = I1 IF ( NPTS .EQ. 0 ) GO TO 430 DO 420 J = 1,NPTS X(J+ITOTPT) = X3(NPTS+1-J) 420 Y(J+ITOTPT) = Y3(NPTS+1-J) ITOTPT = ITOTPT + NPTS 430 DO 440 J = 1,I2 X(J+ITOTPT) = X2(I2+1-J) 440 Y(J+ITOTPT) = Y2(I2+1-J) ITOTPT = ITOTPT + I2 C C... CHECK FOR PLOT ROTATION IF ( .NOT. ROT90 ) GO TO 460 DO 450 J = 1,ITOTPT TMP = Y(J) Y(J) = X(ITOTPT+1-J) 450 X(ITOTPT+1-J) = TMP C 460 CONTINUE C C... TAKE THE POINTS FOR THE QUARTER CIRCLE AND USE THEM C TO GET THE POINTS FOR THE REST OF THE CIRCLE K1 = ITOTPT * 2 K2 = K1 + 1 K3 = K1 * 2 DO 470 J = 1,ITOTPT X(K1) = X(J) Y(K1) = -Y(J) X(K2) = -X(J) Y(K2) = -Y(J) X(K3) = -X(J) Y(K3) = Y(J) K1 = K1 - 1 K2 = K2 + 1 K3 = K3 - 1 470 CONTINUE ITOTPT = ITOTPT * 4 C C... WE'VE GENERATED POINTS FOR A CIRCLE CENTERED AT THE ORIGIN. C ADD THE CIRCLE CENTER TO GET THE ACTUAL POINTS DO 480 J = 1,ITOTPT X(J) = X(J) + XCNEW 480 Y(J) = Y(J) + YCNEW C C... CHECK IF THE CIRCLE IS TO BE OUTLINED IF ( IWIDTH .LE. 0 ) GO TO 600 C C... SAVE THE CURRENT PEN AND SET TO THE NEW PEN IF NECESSARY SAVEW = KWIDTH IF (IWIDTH .EQ. KWIDTH) GO TO 510 CALL OCHUNK (ICMD,0) CALL OCHUNK (IWIDTH,0) IILWP = ILWP IILWM = ILWM KWIDTH = IWIDTH ILWM = IWIDTH/2 ILWP = (IWIDTH-1)/2 510 SAVDSH = DASHPN DASHPN = .FALSE. C C... OUTLINE THE CIRCLE CALL PLOT(X(ITOTPT),Y(ITOTPT),3) DO 520 J = 1,ITOTPT 520 CALL PLOT(X(J),Y(J),2) C C... RESET THE USER'S PEN DASHPN = SAVDSH IF (SAVEW .EQ. IWIDTH) GO TO 600 CALL OCHUNK (ICMD,0) CALL OCHUNK (SAVEW,0) ILWP = IILWP ILWM = IILWM KWIDTH = SAVEW C C... FILL THE CIRCLE IF REQUESTED 600 IF (RADIUS .GT. 0.0) CALL CONVEX(X,Y,ITOTPT) C 9999 RETURN END