SUBROUTINE DEFPAT (IP,JPAT,NTP) C C NAME: DEFPAT 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 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 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 /MSGCOM/ - MESSAGE OUTPUT VARIABLES C COMMON /MSGCOM/ INTARG(8), RELARG(12) 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) = AND (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