      SUBROUTINE DEFCLR ( ICLRX, ICPAT, NPWRD )
C
C     NAME:  DEFCLR
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. C
C            2/21/85        CODE TO CHECK IF THE COLOR HAS ALREADY
C                          BEEN DEFINED HAS BEEN ADDED.  ALSO, THE
C                          COLOR-DEFINED FLAG IS SET BEFORE EXIT.
C
C                          THE CODE TO DEFINE THE COLOR PATTERN HAS
C                          BEEN FIXED SO THAT IT WORKS EVEN IF THE
C                          NUMBER OR ORDER OF THE COLOR PASSES IS
C                          CHANGED.
C
C
C     DEFCLR - THIS ROUTINE CAN BE USED BY THE USER TO DEFINE
C              ADDITIONAL COLORS NOT PROVIDED BY COLOR RANDOM.
C
C     ENTRY:  CALL DEFCLR ( ICLRX, ICPAT, NPWRD )
C
C               ICLRX  - COLOR INDEX NUMBER.
C                 257-512 = COLOR NUMBER (256 DEFAULT DEFINABLE)
C
C                 NOTE:  THE MAXIMUM NUMBER OF DEFINABLE COLORS
C                 MAY BE MODIFIED DURING INSTALLATION.
C
C               ICPAT  - COLOR TONE PATTERN ARRAY.
C                 MAXIMUM OF 64 ELEMENTS DEFINING THE TONE
C                 PATTERNS FOR UP TO 4 TONERS.  THESE PATTERNS,
C                 WHEN COMBINED, CREATE THE COLOR.  EACH PATTERN
C                 CAN CONSIST OF UP TO 16 WORDS.  THE PATTERNS
C                 ARE IN THE ORDER; BLACK, CYAN, MAGENTA, YELLOW.
C
C               NPWRD  - A 4 ELEMENT ARRAY, EACH ELEMENT SPECIFYING
C                 THE NUMBER OF WORDS FOR EACH TONER IN ICPAT.
C
C     EXIT:  RETURN.
C
C     CALLS:  MSGLG1,TONE
C
C     CALLED BY:  USER
C
C     COMMON USED:
C     /DVCOM/
C            I KPAT    - NUMBER OF CURRENTLY ACTIVE TONE PATTERN
C       /CLRCOM/
C            I ICLMAX  - NUMBER OF TONE COLORS DEFINED
C               I ICLRDF()- ARRAY CONTAINING COLOR DEFINITIONS
C            I IVCFLG  - FLAG TO INDICATE COLOR MODE SET
C
C     /PRMCOM/
C            I IDEFLG  - USER DEFINED COLOR FLAG.
C                       =  0 - UNDEFINED
C                       = -1 - DEFINED DURING INSTALLATION
C                       =  1 - DEFINED WITH DEFCLR CALL
C            I IFONT   - DEFAULT FONT PATTERN NUMBER.
C
C     LOCAL VARIABLES:
C
C     I  IA     -  LOOP INDEX
C     I  INDEX  -  POINTER TO TONE PATTERN IN ICPAT ARRAY.
C     I  ISVPAT -  SAVED VALUE OF KPAT
C
      INTEGER
     *  ICPAT(1),
     *  NPWRD(4)
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 /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 /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
C...  REPORT AN ERROR IF COLOR MODE HAS NOT BEEN SET.
      IF ( IVCFLG .NE. 0 )  GOTO 0100
C     MESSAGE - COLOR MODE HAS NOT BEEN SET
      CALL MSGLG1(12)
        GOTO 9999
C
C...  CHECK FOR AN INVALID COLOR NUMBER.
 0100 CONTINUE
      IF ( ICLRX .GE. 257  .AND.  ICLRX .LE. ICLMAX )  GOTO 0105
C     MESSAGE - INVALID COLOR NUMBER
      CALL MSGLG1(13)
        GOTO 9999
C
C...  CHECK IF COLOR ALREADY DEFINED
 0105 CONTINUE
      IF ( IDEFLG(ICLRX-256) .EQ. 0) GO TO 0110
C
C...  MESSAGE - COLOR ALREADY DEFINED
      CALL MSGLG1(125)
      GO TO 9999
C
C...  CHECK FOR AN INVALID PATTERN WORD COUNT.
 0110 CONTINUE
      DO 0120 IA=1,4
        IF ( NPWRD(IA) .GE. 0  .AND.  NPWRD(IA) .LE. 16 )
     *    GOTO 0120
C     MESSAGE - INVALID PATTERN NUMBER IN NPWRD
      CALL MSGLG1(14)
        GOTO 9999
 0120 CONTINUE
C
C...  SAVE THE CURRENTLY ACTIVE TONE PATTERN.
      ISVPAT = KPAT
C
C...  DEFINE THE COLOR PATTERN.
      INDEX = 1
      DO 0130 IA=1,4
        ICLRDF(IA,ICLRX) = 63
        IF ( NPWRD(IA) .EQ. 0 )  GOTO 0130
        CALL TONE ( 0.0, 0.0, ICPAT(INDEX), -NPWRD(IA) )
        ICLRDF(IA,ICLRX) = KPAT
        INDEX = INDEX + NPWRD(IA)
 0130 CONTINUE
C
C...  SET COLOR DEFINED FLAG
      IDEFLG(ICLRX-256) = 1
C
C...  RESTORE THE ACTIVE TONE PATTERN.
      KPAT = ISVPAT
C
C...  ALL DONE, EXIT.
 9999 CONTINUE
      RETURN
      END
