SUBROUTINE GRID(X,Y,NX,XD,NY,YD,LMASK) C 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 C REVISION HISTORY C 1/28/85 GRID NOW USES PATTERNS TO PRODUCE C A USER DEFINE GRID C GRID - GENERATES LINEAR GRID PATTERNS (W/ LINE MASKS) C C SUBROUTINE GRID ALLOWS THE PROGRAMMER TO GENERATE A VARIETY OF C GRID PATTERNS OR OVERLAY FORMS. THE USER INDICATES THE SPACING C VALUES BETWEEN HORIZONTAL AND VERTICAL LINES AND THE NUMBER OF C INTERVALS DESIRED IN EACH DIRECTION. THE DESIGN FEATURES C INCORPORATED IN GRID FACILITATE THE GENERATION OF SPECIAL C UNIFORM, SEMI-LOG, LOG-LOG, EXPONENTIAL, OR OTHER USER DEFINED C GRID FORMATS. SEE APPENDIX C FOR EXAMPLES OF TYPICAL LINE MASKS C THAT THE USER MAY DEFINE. C C C ENTRY: CALL GRID(X,Y,NX,XD,NY,YD,LMASK) C C X,Y - THE STARTING COORDINATE (LOWER LEFTHAND CORNER) OF C THE GRID TO BE GENERATED. C NX - AN INDICTION OF THE NUMBER OF INTERVALS IN THE X C DIRECTION. IF 'NX' IS GREATER THAN 1000, THEN ARGUMENT C 'XD' WILL BE TREATED AS AN ARRAY OF INTERVAL VALUES C WITH 'NX-1000' ELEMENTS. '-NX' INDICATES THAT THE C ACTUAL VERTICAL LINE GENERATIONS ARE TO BE SUPPRESSED. C XD - THE DISTANCE BETWEEN UNIFORMLY SPACED VERTICAL LINES C (NX<1000), OR AN ARRAY OF VALUES FOR SPACING VERTICAL C LINES AT VARYING INTERVALS (NX>1000). C NY - AN INDICATION OF THE NUMBER OF INTERVALS IN THE Y C DIRECTION. IF 'NY' IS GREATER THAN 1000, THEN ARGUMENT C 'YD' WILL BE TREATED AS AN ARRAY OF INTERVAL VALUES C WITH 'NY-1000' ELEMENTS. '-NY' INDICATES THAT THE C ACTUAL HORIZONTAL LINE GENERATIONS ARE TO BE C SUPPRESSED. C YD - THE DISTANCE BETWEEN UNIFORMLY SPACED HORIZONTAL LINES C (NY<1000), OR AN ARRAY OF VALUES FOR SPACING C HORIZONTAL LINES AT VARYING INTERVALS (NY>1000). C LMASK - THE LINE MASK BIT PATTERN TO BE USED IN GENERATING THE C GRIDDED FORM. C C NOTE: A MAXIMUM OF 7 DISTINCT LINE MASKS MAY BE DEFINED PER C PLOT. AN END-OF-PLOT CALL (-999,+-23) WILL RESET THE C LINE MASK PATTERNS AND COUNT. C C EXIT: RETURN C C C CALLS: AND,IRAM,OCHUNK,PLOT,RECT C C CALLED BY: USER C C COMMON USED: C /DVCOM/ C I IPAT() - ARRAY OF TONE PATTERNS C I ITFLAG - FLAG TO INDICATE SUBROUTINE AUTHOR CALLED C I JPEN - THE CURRENT PEN NUMBER C I KPAT - NUMBER OF CURRENTLY ACTIVE TONE PATTERN C I MAXPAT - MAXIMUM NUMBER OF FILL PATTERNS DEFINABLE C I MSKALL - WORD MASK USED IN IRAM CALL TO 'AND' BITS C I NLPAT - NUMBER OF LINE MASKS DEFINED C I NPAT() - NPAT(I) IS THE NUMBER OF WORDS IN TONE C PATTERN #I C L ROT90 - IF ROT90 = .TRUE. THEN ROTATE THE PLOT C COUNTERCLOCKWISE 90 DEGREES C C /MSGCOM/ C I INTARG()- ARRAY FOR PASSING INTEGER OUTPUT ARGUMENTS C R RELARG()- ARRAY FOR PASSING REAL OUTPUT ARGUMENTS C C /CLRCOM/ 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 IVCFLG - FLAG TO INDICATE COLOR MODE SET C I NCPASS - NUMBER OF COLOR PASSES C C LOCAL: C I I,J - WORKING VARIABLES USED IN INDEXING AND C COUNTING C I ICOM - COMMAND HEADER C I ICOM0 - INITIAL COMMAND HEADER C I IDASH - TEMPORARY LINE MASK C I IFLAG - FLAG FOR OUTLINING THE RECTANGLE C I IMASK - WORKING COPY OF USERS LINE MASK C I INDEXX - THE X LINE MASKS PATTERN INDEX. C I INDEXY - THE Y LINE MASKS PATTERN INDEX C I IPIND - INDEX INTO LPAT FOR THE GIVEN LINE MASK C I ITEMPX - TEMPORARY X LINE MASK C I ITEMPY - TEMPORARY Y LINE MASK C I ITFLG - TEMPORARY VARIABLE TO STORE ITNFLG C I ITMPY - TNUMBER OF WORDS IN A PATTERN C I IXMSK - X ONLY LINE MASK C I IXPAT - FLAG IF X LINE MASK WAS PREVIOSLY DEFINED C I IYMSK - Y ONLY LINE MASK C I IYPAT - FLAG IF Y LINE MASK WAS PREVIOUSLY DEFINED. C I LPATFL - FLAG FOR IF THE LINE MASK WAS DEFINED C PREVIOUSLY C I LPAT - ARRAY OF PREVIOUSLY DEFINED LINE MASKS C I LPATX - ARRAY OF PREVIOUSLY DEFINED X LINE MASKS C I LPATY - ARRAY OF PREVIOUSLY DEFINED Y LINE MASKS C I KTEMP - TEMPORARY VARIABLE TO STORE ORIGINAL KPAT C I MASKP - MASK USED TO TEST EACH BIT OF THE LINE MASK C I MX - THE EXTRACTED NUMBER OF X INTERVALS C I MY - THE EXTRACTED NUMBER OF Y INTERVALS C I NGPX - NUMBER OF WORDS IN X LINE MASK C I NGPY - NUMBER OF WORDS IN Y LINE MASK C I NTNSEQ - SAVE CURRENT ACTIVE TONER C R XVAL1 - FIRST X COORDINATE OF THE RECTANGLE C R XVAL2 - SECOND X COORDINATE OF THE RECTANGLE C R YVAL1 - FIRST Y COORDINATE OF THE RECTANGLE C R YVAL2 - SECOND Y COORDINATE OF THE RECTANGLE 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 /MSGCOM/ - MESSAGE OUTPUT VARIABLES C COMMON /MSGCOM/ INTARG(8), RELARG(12) C 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 LOCAL VARIABLES C DIMENSION NTNSEQ(4),XD(1),YD(1) DIMENSION IXMSK(16) DIMENSION LPAT(128),LPATY(128),LPATX(128) DATA IMSK16 /65535/, ICOM0 /34564/ DATA IFLAG /0/ C C C-D DEBUG MESSAGE C RELARG(1) = X C RELARG(2) = Y C INTARG(1) = NX C RELARG(3) = XD(1) C INTARG(2) = NY C RELARG(4) = YD(1) C INTARG(3) = LMASK C CALL MSGLG1(27) C-D C C----------------------------------------------------------------- C C SAVE THE CURRENT TONERS AND SET ALL TONERS ACTIVE. C C----------------------------------------------------------------- C DO 10 IA = 1,NCPASS NTNSEQ(IA) = ITNSEQ(IA) ITNSEQ(IA) = -IABS(ITNSEQ(IA)) 10 CONTINUE C C SAVE CURRENT ACTIVE TONE PATTERN AND TONE FLAG. C SET ITNFLG TO ZERO SO THAT KPAT WILL BE USED. C KTEMP = KPAT ITFLG = ITNFLG ITNFLG = 0 C C GET WORKING COPY OF THE LINE MASK C IMASK = AND(LMASK,IMSK16) C C SPECIAL CASES - LINE MASK = '0000' AND LINE MASK = 'FFFF' C IF (IMASK .NE. 0) GO TO 20 KPATX = 63 KPATY = 63 GO TO 200 20 IF (IMASK .NE. IMSK16) GO TO 30 KPATX = 0 KPATY = 0 GO TO 200 30 CONTINUE C C CHECK IF THE LINE MASK WAS PREVIOUSLY DEFINED. C IIPAT = 1 40 IF (IIPAT .GT. NLPAT) GO TO 50 IF (IMASK .EQ. LPAT(IIPAT)) GO TO 60 IIPAT = IIPAT + 1 GO TO 40 C C THIS IS A NEW LINE MASK. C C SAVE THE MASK. C 50 NLPAT = NLPAT + 1 LPAT(IIPAT) = IMASK LPATX(IIPAT) = 0 LPATY(IIPAT) = 0 C C CHECK IF THE X-ONLY MASK NEEDS TO BE DEFINED C 60 IF ( LPATX(IIPAT) .NE. 0 ) GO TO 130 IF ( (.NOT. ROT90) .AND. (NY .LE. 0) ) GO TO 130 IF ( ROT90 .AND. (NX .LE. 0) ) GO TO 130 C C DETERMINE THE PATTERN FOR THE X-ONLY LINE MASK. (A 16 BY 16 PATTERN) C DO 70 I = 1,16,1 IDASH = AND(IMASK,1) IXMSK(17-I) = 0 IF (IDASH .NE. 0) IXMSK(17-I) = IMSK16 IMASK = IRAM(IMASK,1,MSKALL) 70 CONTINUE C C CHECK IF THE X-ONLY LINE MASK WAS DEFINED AS A PATTERN. C DO 90 I = 1,MAXPAT C C CHECK THE NUMBER OF ELEMENTS C IF (NPAT(I) .NE. 16) GO TO 90 C C COMPARE THE PATTERN TO THE LINE MASK PATTERN. C DO 80 J = 1,16 IF (IXMSK(J) .NE. IPAT(J,I)) GO TO 90 80 CONTINUE C C THE PATTERNS MATCH. SAVE THE PATTERN INDEX C LPATX(IIPAT) = I GO TO 130 C 90 CONTINUE C C THE PATTERN WAS NOT PREVIOUSLY DEFINED. C GET A PATTERN INDEX. C DO 100 IA = 1,MAXPAT,1 INDEX = MAXPAT+1-IA IF (NPAT(INDEX) .EQ. 0) GO TO 110 100 CONTINUE C C NO PATTERNS AVAILABLE. PRINT A MESSAGE STATING NOT ENOUGH PATTERNS C CALL MSGLG1(111) GO TO 999 C C SAVE THE PATTERN INDEX. C 110 LPATX(IIPAT) = INDEX C C INITIALIZE COMMAND HEADER WITH COUNT C ICOM = ICOM0 + 16 C C OUTPUT HEADER FOR X MASK C CALL OCHUNK (ICOM,0) C C OUTPUT PARAMETERS C CALL OCHUNK (INDEX,0) CALL OCHUNK (0,0) CALL OCHUNK (16,0) CALL OCHUNK (16,0) C C OUTPUT THE PATTERN AND COPY IT INTO THE PATTERN ARRAY C NPAT(INDEX) = 16 DO 120 I = 1,16 CALL OCHUNK (IXMSK(I),0) IPAT(I,INDEX) = IXMSK(I) 120 CONTINUE C C CHECK IF THE Y-ONLY MASK NEEDS TO BE DEFINED C 130 IF ( LPATY(IIPAT) .NE. 0 ) GO TO 170 IF ( (.NOT. ROT90) .AND. (NX .LE. 0) ) GO TO 170 IF ( ROT90 .AND. (NY .LE. 0) ) GO TO 170 C C DETERMINE THE PATTERN FOR THE Y-ONLY LINE MASK. (A 1 BY 16 PATTERN) C IYMSK = AND(LMASK,IMSK16) C C CHECK IF THE Y-ONLY LINE MASK WAS DEFINED AS A PATTERN. C DO 140 I = 1,MAXPAT C C CHECK THE NUMBER OF ELEMENTS. C COMPARE THE PATTERN TO THE LINE MASK PATTERN. C IF (NPAT(I) .NE. 1 .OR. IPAT(1,I) .NE. IYMSK) GO TO 140 C C THE PATTERNS MATCH. SAVE THE PATTERN INDEX C LPATY(IIPAT) = I GO TO 170 C 140 CONTINUE C C THE PATTERN WAS NOT PREVIOUSLY DEFINED. C GET A PATTERN INDEX. C DO 150 IA = 1,MAXPAT,1 INDEX = MAXPAT+1-IA IF (NPAT(INDEX) .EQ. 0) GO TO 160 150 CONTINUE C C NO PATTERNS AVAILABLE. PRINT A MESSAGE STATING NOT ENOUGH PATTERNS C CALL MSGLG1(111) GO TO 999 C C SAVE THE PATTERN INDEX. C 160 LPATY(IIPAT) = INDEX C C INITIALIZE COMMAND HEADER WITH COUNT C ICOM = ICOM0 + 1 C C OUTPUT HEADER FOR Y MASK C CALL OCHUNK (ICOM,0) C C OUTPUT PARAMETERS C CALL OCHUNK (INDEX,0) CALL OCHUNK (0,0) CALL OCHUNK (16,0) CALL OCHUNK (1,0) C C OUTPUT THE PATTERN AND COPY IT INTO THE PATTERN ARRAY C CALL OCHUNK (IYMSK,0) NPAT(INDEX) = 1 IPAT(1,INDEX) = IYMSK C C INITIALIZE THE X AND Y PATTERNS C 170 IF (ROT90) GO TO 180 KPATX = LPATX(IIPAT) KPATY = LPATY(IIPAT) GO TO 190 180 KPATX = LPATY(IIPAT) KPATY = LPATX(IIPAT) 190 CONTINUE C C RESET THE TONER SEQUENCE TO THE PEN COLOR C 200 CONTINUE DO 210 IA = 1,NCPASS 210 ITNSEQ(IA) = NTNSEQ(IA) C C EXTRACT SINGLE/ARRAY INDICATORS AND THE INTERVAL COUNT. C JX AND JY INDICATE WHETHER XD AND YD ARE SINGLE VALUES OR C ARRAYS. C JX = 0, XD IS A SINGLE VALUE; JX = 1, XD IS AN ARRAY C JY = 0, YD IS A SINGLE VALUE; JY = 1, YD IS AN ARRAY C MX AND MY ARE EQUAL TO THE NUMBER OF INTERVALS TO BE DRAWN. C MX = IABS(NX) MY = IABS(NY) JX = MX/1000 JY = MY/1000 MX = MX - JX*1000 MY = MY - JY*1000 C C SET THE XVAL1 VALUE FOR THE LEFT END OF THE HORIZONTAL LINE. C COMPUTE THE RIGHT MOST X ORDINATE (XVAL2) ASSUMING XD IS A C CONSTANT SPACING VALUE C XVAL1 = X XVAL2 = X + XD(1)*FLOAT(MX) C C CHECK IF XD IS A SINGLE VALUE OR AN ARRAY. IF ITS AN ARRAY C RECALCULATE THE RIGHT-MOST X ORDINATE AS THE SUMMATION OF ALL C THE INTERVAL VALUES. C IF (JX .EQ. 0) GO TO 230 XVAL2 = X DO 220 I = 1,MX XVAL2 = XVAL2 + XD(I) 220 CONTINUE C C GENERATE THE X MASK LINES C 230 CONTINUE C C SET THE X MASK PATTERN ACTIVE C KPAT = KPATX C C SET THE X ORDINATES FOR THE X MASK LINE AND SET THE Y VALUE. C YVAL1 = Y YVAL2 = Y IF (NY .LE. 0) GO TO 240 CALL RECT (XVAL1,XVAL2,YVAL1,YVAL2,IFLAG) C C J IS AN INDEX FOR EXTRACTING THE INTERVAL VALUES FROM YD C 240 J = 1 C C DRAW THE HORIZONTAL LINES OVER THE NUMBER OF INTERVALS SPECIFIED. C UPDATE THE Y ORDINATE FOR THE NEXT INTERVAL C DO 250 L = 1, MY YVAL1 = YVAL1 + YD(J) YVAL2 = YVAL2 + YD(J) IF (NY .LE. 0) GO TO 250 CALL RECT (XVAL1,XVAL2,YVAL1,YVAL2,IFLAG) J = J + JY 250 CONTINUE C C GENERATE THE Y MASK LINES C C CHECK IF Y-ONLY LINE MASKS SUPPRESSED C IF (NX .LE. 0) GO TO 999 C C SET THE Y MASK PATTERN ACTIVE C KPAT = KPATY C C THE Y ORDINATE IS AT THE UPPER MOST POSITION FROM THE C PREVIOUS DRAW. C C SET YVAL TO LOWER POSITION AND XVAL(2) TO ORIGINAL X. DRAW C THE INITIAL LINE C YVAL1 = Y XVAL2 = X CALL RECT (XVAL1,XVAL2,YVAL1,YVAL2,IFLAG) C C INITIALIZE J AS ABOVE BUT FOR XD VALUES AND DRAW THE VERTICAL C LINES UPDATING THE X ORDINATE C J = 1 DO 260 I = 1,MX XVAL1 = XVAL1 + XD(J) XVAL2 = XVAL2 + XD(J) CALL RECT (XVAL1,XVAL2,YVAL1,YVAL2,IFLAG) J = J + JX 260 CONTINUE C C FINISHED, RESET KPAT AND ITNFLG BEFORE RETURNING C 999 CONTINUE KPAT = KTEMP ITNFLG = ITFLG RETURN END