SUBROUTINE PENCLR (ICPEN, NUMCLR ) C C NAME: PENCLR 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. B 6/19/84 USE CURPEN() TO DETERMINE IF SET-PEN C COMMAND NEEDS TO BE OUTPUT. THIS C ELIMINATES EXCESSIVE SET-PEN CMNDS. C C REV C 2/21/85 CODE UPDATED TO REFLECT THE FACT THAT C CURPEN NOW REFERS TO THE WIDTH OF THE C PEN, INSTEAD OF THE PEN NUMBER. THE C SET-PEN COMMAND NOW OUTPUTS THE PEN C WIDTH INSTEAD OF THE PEN NUMBER. C C USE CURPEN AND ITNSEQ TO OUTPUT C SET-PEN COMMANDS ONLY TO THOSE TONERS C THAT NEED IT. C C PENCLR - SET COLOR FOR A PEN C C SUBROUTINE PENCLR IS USED TO ASSOCIATE A COLOR C FOR A PARTICULAR PEN. C C CALL SUBROUTINE NEWPEN TO SET THE PEN COLOR ACTIVE. C C THE CALL IS IGNORED IF THE PEN NUMBER IS OUTIDE THE C ALLOWABLE RANGE, AND A WARNING MESSAGE IS ISSUED. THE C COLOR IN EFFECT PRIOR TO THE UNACCEPTED CALL IS STILL C IN EFFECT AFTER THE WARNING. C C ENTRY: CALL PENCLR ( ICPEN, NUMCLR ) C C ICPEN - SELECTED PEN# (0-7) C 0-7= ALLOWABLE VALUES C C NUMCLR - COLOR INDEX NUMBER C 1-8 = ALLOWABLE VALUES C C EXIT: RETURN C C CALLS: NONE C C CALLED BY: USER C C COMMON USED: C C /MSGCOM/ C I INTARG()- ARRAY FOR PASSING INTEGER OUTPUT ARGUMENTS C C /DVCOM/ C I JPEN - THE CURRENT PEN NUMBER C L PMOVE - STATUS OF LAST PLOT CALL (.TRUE.=MOVE) C I PWIDTH()- ARRAY WITH WIDTH OF EACH PEN C C /PRMCOM/ C I IFONT - DEFAULT FONT PATTERN NUMBER. C I MXPEN - MAXIMUM PEN NUMBER TO BE ACTIVATED BY USER C /CLRCOM/ C I CURPEN()- ARRAY CONTAINING CURRENT PEN NUMBER C FOR EACH TONER C I ICLRDF()- ARRAY CONTAINING COLOR DEFINITIONS C I ITNSEQ()- TONING SEQUENCE FOR OUTPUT C I IVCFLG - FLAG TO INDICATE COLOR MODE SET C I NCPASS - NUMBER OF COLOR PASSES C I PCOLOR()- ARRAY WITH COLOR OF EACH PEN C L PENCHG - FLAG TO INDICATE PEN COLOR CHANGED C C LOCAL VARIABLES: C I IFLAG - FLAG TO INDICATE SET-PEN COMMAND REQD. C I NTNSEQ()- SAVED VALUE OF THE NEW TONING SEQUENCE. C C... COMMON /MSGCOM/ - MESSAGE OUTPUT VARIABLES C COMMON /MSGCOM/ INTARG(8), RELARG(12) 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 /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 INTEGER PWDTH DIMENSION NTNSEQ(4) C C... SET-PEN COMMAND WORD (X'8301') DATA ICMD/33537/ C C... CHECK IF COLOR PLOT IF (IVCFLG .NE. 0) GO TO 100 C C... TELL CALLER COLOR MODE NOT SET, IGNORE CALL CALL MSGLG1(33) GO TO 9999 C C... CHECK IF VALID PEN INDEX 100 IF (ICPEN .LT. 0 .OR. ICPEN .GT. MXPEN) GO TO 900 C C... CHECK IF VALID COLOR INDEX IF (NUMCLR .LT. 1 .OR. NUMCLR .GT. 8) GO TO 900 C C... INITIALIZE ICPEN+1 FOR INDEXING INTO ARRAYS ICPEN1 = ICPEN + 1 C C... CHECK FOR REDEFINITION OF THE COLOR OF THE CURRENT PEN IF (ICPEN .NE. JPEN ) GOTO 300 IF (PCOLOR(JPEN+1) .EQ. NUMCLR) GOTO 9999 C C... THE COLOR OF THE CURRENT PEN IS BEING REDEFINED PMOVE = .TRUE. PENCHG = .TRUE. PWDTH = PWIDTH(ICPEN1) DO 200 I=1,NCPASS C C... SET UP NEW TONING SEQUENCE - STORE IT IN NTNSEQ ITNSEQ(I) = IABS(ITNSEQ(I)) NTNSEQ(I) = ITNSEQ(I) IF (ICLRDF(ITNSEQ(I),NUMCLR) .EQ. 0) NTNSEQ(I) = -NTNSEQ(I) C C... TURN ON TONER IF PEN WIDTH IS CHANGED FOR THIS TONER IF (NTNSEQ(I) .GE. 0 .OR. * CURPEN(ITNSEQ(I)) .EQ. PWDTH) GO TO 200 CURPEN(ITNSEQ(I)) = PWDTH ITNSEQ(I) = -ITNSEQ(I) C 200 CONTINUE C C... UPDATE THE PEN WIDTH FOR THE TONERS WHERE THE WIDTH CHANGED CALL OCHUNK(ICMD,0) CALL OCHUNK(PWDTH,0) C C... SET ITNSEQ TO THE TONING SEQUENCE FOR THE NEW PEN COLOR DO 250 I = 1,NCPASS ITNSEQ(I) = NTNSEQ(I) 250 CONTINUE C C... SET COLOR INDEX FOR ICPEN 300 PCOLOR(ICPEN1) = NUMCLR C GO TO 9999 C C... OUTPUT WARNING MESSAGE 900 INTARG(1)=ICPEN INTARG(2)=NUMCLR CALL MSGLG1(34) C C 9999 RETURN C END