	SUBROUTINE PENCLR (ICPEN, NUMCLR )
C
C	NAME: PENCLR
C
C	LANGUAGE:  FORTRAN
C
C	OPERATING SYSTEM:  DEC VAX/VMS
C
C	ORDER NUMBER:  5448-SE
C
C	PART NUMBER:  000-025522-001  OCTOBER 1985
C
C	PRODUCT:  DEC VAX/VMS 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
	INCLUDE 'MSGCOM.CMN'
C
C
	INCLUDE 'DVCOM.CMN'
C
C
	INCLUDE 'PRMCOM.CMN'
C
C
	INCLUDE 'CLRCOM.CMN'
C
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
