SUBROUTINE DEFPAT (IP,JPAT,NTP)
C
C	NAME: DEFPAT
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   11/23/83	ADD CODE TO RETURN NEXT AVAILABLE
C				PATTERN INDEX IF IP = -1.
C
C	DEFPAT - DEFINE POLYGON FILL PATTERN
C
C	SUBROUTINE DEFPAT IS CALLED TO DEFINE A RECTANGULAR FILL PATTERN
C	TO BE USED TO FILL USER DEFINED POLYGONAL AREAS.
C
C	THE PATTERN WILL ALWAYS BE ALIGNED SO THAT IT REPLICATES
C	STARTING AT THE TOP LEFT CORNER OF THE PLOTTER (NOT THE
C	LEFTMOST OR TOPMOST OCCURRENCE OF THE PATTERN). THE PATTERN
C	MUST BE WORD-ALIGNED BY FILLING ON THE RIGHT WITH ZEROS,
C	AND IS IN ROW-MAJOR ORDER.
C
C	PATTERN INDEX 0 IS RESERVED AND INDICATES SOLID FILL (BLACK).
C
C	NOTE:  FOR 32 BIT COMPUTERS, ONLY THE LOWER 16 BITS OF EACH
C	       FILL PATTERN ELEMENT ARE USED FOR THE FILL PATTERN.
C
C	ENTRY:
C		A) TO DEFINE A PATTERN:  CALL DEFPAT (IP,JPAT,NTP)
C
C			IP    - FILL PATTERN INDEX BEING DEFINED
C			JPAT  - FILL PATTERN ARRAY OF UP TO 16 ELEMENTS
C			NTP   - NUMBER OF ELEMENTS IN 'JPAT'
C
C		B) RETURN NEXT AVAILABLE PATTERN INDEX:
C
C			CALL DEFPAT (IP,JPAT,NTP)
C
C			IP = -1 =  RETURNS NEXT AVAILBLE PATTERN INDEX
C			           IN ARGUMENT IP.
C			           RETURNS IP = 0 IF ALL PATTERNS ARE
C			           ARE DEFINED.
C			JPAT    -  NOT USED
C			NTP     -  NOT USED
C
C
C	EXIT: RETURN
C
C	CALLS: OCHUNK
C
C	CALLED BY: APPLICATION PROGRAM
C
C	COMMON VARIABLES USED:
C	/DVCOM/
C		I IPAT()  - ARRAY OF TONE PATTERNS
C		I KPAT    - NUMBER OF CURRENTLY ACTIVE TONE PATTERN
C		I MAXPAT  - MAXIMUM NUMBER OF FILL PATTERNS DEFINABLE
C		I NPAT()  - NPAT(I) IS THE NUMBER OF WORDS IN TONE
C		            PATTERN #I
C       /CLRCOM/
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	/MSGCOM/
C		I INTARG()- ARRAY FOR PASSING INTEGER OUTPUT ARGUMENTS
C
C
C	LOCAL VARIABLES USED:
C
C		IA,IT - LOOP INDICES
C		ICOM  - COMMAND HEADER WORD
C		ICOM0 - INITIAL COMMAND HEADER WORD
C		INTP  - TEMPORARY ELEMENT COUNT
C		IPLMT - LIMIT COUNT FOR PATTERN ELEMENTS
C		NTNSEQ()- SAVE CURRENT COLOR SEQUENCE
C
C
	DIMENSION JPAT(1)
C
	INCLUDE 'DVCOM.CMN'
C
C
	INCLUDE 'CLRCOM.CMN'
C
C
	INCLUDE 'MSGCOM.CMN'
C
C
	DIMENSION NTNSEQ(4)
C
C...	DEF-FILL-PATTERN COMMAND WORD (X'8704')
	DATA ICOM0/34564/
	DATA IPLMT/16/
C
C
C
C-D  DEBUG MESSAGE
C	INTARG(1)=IP
C	INTARG(2)=JPAT(1)
C	INTARG(3)=NTP
C	CALL MSGLG1(15)
C-D
C
C...	CHECK IF LEGAL FILL PATTERN INDEX
	IF (IP .GT. 0 .AND. IP .LE. MAXPAT)  GO TO 100
C
C...	CHECK IF NEXT PATTERN INDEX CALL
	IF (IP .NE. -1)  GO TO 95
C
C...	FIND NEXT AVAILABLE PATTERN INDEX
	IP = 0
	DO 80 IA = 1,MAXPAT
	  IT = IA
	  IF (NPAT(IA) .EQ. 0)  GO TO 90
   80	CONTINUE
	GO TO 999
C
C...	RETURN INDEX
   90	IP = IT
	GO TO 999
C-E
C...	INDEX OUT OF RANGE, OUTPUT MESSAGE AND RETURN
   95	INTARG(1)=IP
	CALL MSGLG1(16)
	GO TO 999
C-E
C
C...	CHECK IF PATTERN HAS ALREADY BEEN DEFINED
  100	IF (NPAT(IP) .EQ. 0)  GO TO 200
C
C-I	INFORM USER PATTERN ALREADY DEFINED
	INTARG(1)=IP
	CALL MSGLG1(17)
	GO TO 999
C-I
C
C...	CHECK IF LEGAL PATTERN SIZE
  200	INTP = NTP
	IF (NTP .GT. 0)  GO TO 205
C-E
C...	ILLEGAL PATTERN SIZE
	INTARG(1)=NTP
	CALL MSGLG1(18)
	GO TO 999
C-E
C
C...	CHECK IF PATTERN SIZE TOO LARGE
  205	IF (NTP .LE. IPLMT)  GO TO 300
C
C...	TRUNCATE FILL PATTERN TO IPLMT WORDS
	INTP = IPLMT
C-I
C...	INFORM USER
	INTARG(1)=NTP
	CALL MSGLG1(18)
	CALL MSGLG1(20)
C-I
C
C...	INITIALIZE COMMAND HEADER WITH COUNT
  300	ICOM = ICOM0 + INTP
C
C...	SET ALL TONERS ACTIVE
	DO 301 IA = 1,NCPASS
	  NTNSEQ(IA) = ITNSEQ(IA)
	  ITNSEQ(IA) = -IABS(ITNSEQ(IA))
  301	CONTINUE
C
C...	OUTPUT COMMAND HEADER
	CALL OCHUNK (ICOM,0)
C
C...	OUTPUT PARAMETERS
	CALL OCHUNK (IP,0)
	CALL OCHUNK (0,0)
	CALL OCHUNK (16,0)
	CALL OCHUNK (INTP,0)
C
C
C...	COPY FILL PATTERN INTO PATTERN ARRAYS
	NPAT(IP) = INTP
	DO 400 I = 1,INTP
C
C...	MASK OFF UPPER 16 BITS
	  IPAT(I,IP) = IAND (JPAT(I),65535)
C
C...	OUTPUT FILL PATTERN
	  CALL OCHUNK (IPAT(I,IP),0)
  400	CONTINUE
C
C...	RESET ACTIVE TONERS TO ORIGINAL VALUES
	DO 401 IA = 1,NCPASS
	  ITNSEQ(IA) = NTNSEQ(IA)
  401	CONTINUE
C
  999	RETURN
	END