SUBROUTINE VPINIT C C NAME: VPINIT 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 C REVISION HISTORY: C REV. B 6/18/84 CHANGE OF DEFAULT PEN NOT HANDLED C CORRECTLY. C C ADD CODE TO INITIALIZE CURPEN(), USED C BY PENCLR AND NEWPEN. C C 3/ 5/84 INITIALIZE KPEN TO (MXPEN + 2) C C 10/12/84 SUPPORT DATA STANDARDS COPY COUNT C C REV. C 2/21/85 CURRENT PEN INITIALIZED IN VPINIT C INSTEAD OF CALLING NEWPEN. C C COLOR DEFINED FLAGS (IDEFLG) RESET C C NUMBER OF LINE MASK PATTERNS (NLPAT) C INITIALIZED TO 0. C VPINIT - RE-INITIALIZE THE PLOTTING SOFTWARE C C VPINIT RE-INITIALIZES THE PLOTTING SOFTWARE BY SETTING DEFAULT C VALUES FOR THE PLOTTER MODEL IN USE AND THE GLOBAL PLOTTING C VARIABLES. C C ENTRY: CALL VPINIT C C EXIT: PLOTTING VARIABLES RESET TO DEFAULT VALUES, THE VRF C FILE IS READY FOR DATA. C C CALLS: NEWPEN,VPORT,WINDOW,AUTHOR,OCHUNK,SETFNT,DEFPAT C C CALLED BY: PLOTS,PLOT C C COMMON USED: C /DVCOM/ C I ANC - HOLD PREVIOUS SYMBOL CALL ANGLE VALUE C R FACT - CURRENT SCALING FACTOR. USED BY *FACTOR* C I HTC - HOLD PREVIOUS SYMBOL CALL HEIGHT VALUE C I IAUTXT()- ARRAY TO HOLD AUTHOR TEXT STRING C I ICUT - PAPER CUT FLAG FOR CURRENT PLOT C = -1 - CUT IMMEDIATE C = 0 - NO PAPER CUT C = 1 - SET PAGE MODE C I IHBUF() - VERSATEC DATA STANDARD HEADER WORDS C I ILWP - (LINE WIDTH - 1)/2 C I ILWM - LINE WIDTH/2 C L IPDEF() - .TRUE. IF PEN HAS BEEN DEFINED C I ITFLAG - FLAG TO INDICATE SUBROUTINE AUTHOR CALLED C I JFONT - CURRENT FONT INDEX C I JPEN - THE CURRENT PEN NUMBER C I KPAT - NUMBER OF CURRENTLY ACTIVE TONE PATTERN C I KWIDTH - WIDTH OF CURRENT PEN C I MAXPAT - MAXIMUM NUMBER OF FILL PATTERNS DEFINABLE C I NCH - NUMBER OF CHARACTERS IN AUTHOR TEXT STRING C I NCLIP - NUMBER OF CLIPPED VECTORS C I NIBSX - NUMBER OF SCAN LINES IN THE PLOTTING AREA C I NLPAT - NUMBER OF LINE MASKS DEFINED C I NPAT() - NPAT(I) IS THE NUMBER OF WORDS IN TONE C PATTERN #I C I PENPAT()- ARRAY TO STORE PEN DEFINITIONS C I PFONT - INDEX FOR RPM STROKE COUNT FOR CURRENT FONT C L PMOVE - STATUS OF LAST PLOT CALL (.TRUE.=MOVE) C I PWIDTH()- ARRAY WITH WIDTH OF EACH PEN C R SXC - PREVIOUS SYMBOL CALL X COORDINATE C R SYC - PREVIOUS SYMBOL CALL Y COORDINATE C R TCOSA - PREVIOUS SYMBOL CALL COSINE OF ANGLE C R TSINA - PREVIOUS SYMBOL CALL SINE OF ANGLE C R VCP() - CURRENT POINT IN COMPUTATIONAL COORDINATES C R XFAC - SCALING FACTOR SET BY *OFFSET* AND USED BY C *PLOT* FOR SCALED/OFFSET MOVES C R XOFF - USED BY *OFFSET* AND *PLOT* IN DEFINING C SCALED/OFFSET MOVES C R YFAC - SCALING FACTOR SET BY *OFFSET* AND USED BY C *PLOT* FOR SCALED/OFFSET MOVES C R YOFF - USED BY *OFFSET* AND *PLOT* IN DEFINING C SCALED/OFFSET MOVES. C C /PRMCOM/ C I IBYTES - DEFAULT PLOTTER BYTES/SCAN (8-BIT BYTES). C I IFONT - DEFAULT FONT PATTERN NUMBER. C I IJPEN - DEFAULT CURRENT PEN NUMBER. C I INITFF - INITIAL FORM FEED FLAG. C = 0 - NO INITIAL FORM FEED [DEFAULT] C # 0 - OUTPUT INITIAL FORM FEED C I ISFLAG - PLOTTER SPEED CHANGE FLAG. C = 0 - NO SPEED CONTROL OUTPUT [DEFAULT] C # 0 - OUTPUT SPEED CONTROL COMMAND C I ISPEED - PLOTTER OUTPUT SPEED. NOT SUPPORTED ON C ALL PLOTTERS. C = -1 - FULL SPEED [DEFAULT] C = 0 - .125 IPS C = 1 - .250 IPS C = 2 - .500 IPS C = 3 - .750 IPS C = 4 - 1.00 IPS C I JCUT - PAPER CUT FLAG C = -1 - CUT IMMEDIATE C = 0 - NO PAPER CUT COMMAND C = 1 - SET PAGE MODE C I NCOPY - PLOT COPY COUNT. C I PENTBL()- ARRAY WITH COLOR AND WIDTH OF EACH PEN C R RDEN - DEFAULT PLOTTER NIBS/INCH VALUE. C R XFACT - DEFAULT X SCALING FACTOR. C R YFACT - DEFAULT Y SCALING FACTOR. C R XSTART - DEFAULT STARTING X COORDINATE. C R YSTART - DEFAULT STARTING Y COORDINATE. C R VXMIN - DEFAULT MINIMUM X VIEWPORT COORDINATE. C R VXMAX - DEFAULT MAXIMUM X VIEWPORT COORDINATE. C R VYMIN - DEFAULT MINIMUM Y VIEWPORT COORDINATE. C R VYMAX - DEFAULT MAXIMUM Y VIEWPORT COORDINATE. C R WXMIN - DEFAULT MINIMUM X WINDOW COORDINATE. C R WXMAX - DEFAULT MAXIMUM X WINDOW COORDINATE. C R WYMIN - DEFAULT MINIMUM Y WINDOW COORDINATE. C R WYMAX - DEFAULT MAXIMUM Y WINDOW COORDINATE. C /VRFCOM/ C R BYTKNT()- BYTE COUNT FOR EACH COLOR C R DRWKNT - BYTE COUNT FOR A DRAW COMMAND C R DRWMAX - BYTE COUNT FOR A DRAW COMMAND WITH A PEN C OF WIDTH GREATER THAN 1 C R DRWMIN - BYTE COUNT FOR A DRAW COMMAND WITH A PEN C OF WIDTH AT MOST 1 C I IBXMAX - MAXIMUM X VALUE (USED FOR BANDING) C I ICOPY - PHASE II PLOT COPY COUNT C I NREC - NEXT RECORD POINTER C R VRFKNT()- COUNTER FOR RANDOM ELEMENTS C I IBEGIN()- THE INDEX POINTER INTO THE OBUF ARRAY C OF THE START OF THE CURRENT VRF OUTPUT C BUFFER C I MAX() - THE END OF BUFFER POINTER OF THE C CURRENT VRF OUTPUT BUFFER C I MIN - THE INDEX POINTER INTO THE OBUF ARRAY C OF THE START OF THE SECOND VRF OUTPUT C BUFFER C I NBYTS - NUMBER OF BYTES IN A 'OBUF' WORD C I NEXTO() - CURRENT OUTPUT POINTER FOR THE VRF C OUTPUT BUFFER C R OBJKNT()- NUMBER OF EACH TYPE OF OBJECT OUTPUT C OBJKNT(1) - VECTORS C OBJKNT(2) - POLYGONS C OBJKNT(3) - CIRCLES C OBJKNT(4) - CHARACTERS C I OBUF() - ARRAY FOR VRF OUTPUT BUFFERS (LREC*5) C /IOCOM/ C I LREC - LENGTH OF DATA FILE RECORD IN WORDS C /CLRCOM/ C I CURPEN()- ARRAY CONTAINING CURRENT PEN NUMBER C FOR EACH TONER C I IDASRT()- POINTER TO FIRST DATA RECORD IN A BAND 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 /KLCOM/ C L KFLAG - FLAG INDICATING REP OUTPUT AND .GT. 13.65' C PLOTTING REQUIRED. C C LOCAL: C I I,J,K - TEMPORARY VARIABLE. C I IA - LOOP COUNTER. C I ICPCB - COLOR PLOTTER CONTROL BYTE. C I ICPTRN - COLOR TONE PATTERNS. C I IRECP - EQUATE TO IRECT() ARRAY C I ITEMP - TEMPORARY AUTHOR STRING CHARACTER STORAGE. C I JCMD - AUTHOR COMMAND. C I KNT - NUMBER OF WORDS IN AUTHOR FIELD. C INTEGER ICPTRN(8,25), JTNSEQ(4) C INTEGER SETPEN 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 /VRFCOM/ - VRF COMMON VARIABLES C INTEGER PRECIS INTEGER OBUF COMMON /VRFCOM/ * DRWELM, DRWMAX, DRWMIN, DRWKNT, ICOPY, * ICNSTX, IBXMAX, IHDCNT, MIN, * NBYTS, NCHUNK, NHEAD, NREC, PRECIS, * RMXELM, VRFMAX, * BYTKNT(4), IBEGIN(4), ICOMD(2), IOCODE(2), IREC(4), * MAX(4), NEXTO(4), OBJKNT(4), VRFKNT(4), OBUF(640) C C... COMMON /IOCOM/ - INPUT/OUTPUT VARIABLES C COMMON /IOCOM/ * IUNIT, LUNIT, LREC, IOTYPE 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 /KLCOM/ - X STRIPPING VARIABLES C LOGICAL KFLAG COMMON /KLCOM/ KFLAG, KSIZE C C... DEFINE THE COLOR TONING PATTERNS. C 'AAAA'X,'AAAA'X,'AAAA'X,'AAAA'X,'AAAA'X,'AAAA'X,'AAAA'X,'AAAA'X, C 'FFFF'X,'0000'X,'FFFF'X,'0000'X,'FFFF'X,'0000'X,'FFFF'X,'0000'X, C '5555'X,'AAAA'X,'5555'X,'AAAA'X,'5555'X,'AAAA'X,'5555'X,'AAAA'X, C '8080'X,'0000'X,'0000'X,'0000'X,'0808'X,'0000'X,'0000'X,'0000'X, C 'AAAA'X,'5555'X,'AAAA'X,'5555'X,'AAAA'X,'5555'X,'AAAA'X,'5555'X, C '0000'X,'AAAA'X,'0000'X,'AAAA'X,'0000'X,'AAAA'X,'0000'X,'AAAA'X, C '0000'X,'5555'X,'0000'X,'5555'X,'0000'X,'5555'X,'0000'X,'5555'X, C '8888'X,'0000'X,'0000'X,'0000'X,'8888'X,'0000'X,'0000'X,'0000'X, C '8888'X,'0000'X,'2020'X,'0000'X,'8888'X,'0000'X,'0202'X,'0000'X, C '8888'X,'0000'X,'2020'X,'0000'X,'8888'X,'0000'X,'2222'X,'0000'X, C '8888'X,'0000'X,'2222'X,'0000'X,'8888'X,'0000'X,'2222'X,'0000'X, C '1111'X,'0000'X,'4444'X,'0000'X,'1111'X,'0000'X,'4444'X,'0000'X, C 'A8A8'X,'0000'X,'2222'X,'0000'X,'8A8A'X,'0000'X,'2222'X,'0000'X, C 'AAAA'X,'0000'X,'2222'X,'0000'X,'AAAA'X,'0000'X,'2222'X,'0000'X, C 'AAAA'X,'0000'X,'A2A2'X,'0000'X,'AAAA'X,'0000'X,'2A2A'X,'0000'X, C 'AAAA'X,'0000'X,'AAAA'X,'0000'X,'AAAA'X,'0000'X,'AAAA'X,'0000'X, C '5555'X,'0000'X,'5555'X,'0000'X,'5555'X,'0000'X,'5555'X,'0000'X, C 'AAAA'X,'4040'X,'AAAA'X,'0000'X,'AAAA'X,'0404'X,'AAAA'X,'0000'X, C 'AAAA'X,'4444'X,'AAAA'X,'0000'X,'AAAA'X,'4444'X,'AAAA'X,'0000'X, C '5555'X,'2222'X,'5555'X,'0000'X,'5555'X,'2222'X,'5555'X,'0000'X, C '0000'X,'AAAA'X,'4444'X,'AAAA'X,'0000'X,'AAAA'X,'4444'X,'AAAA'X, C 'AAAA'X,'4444'X,'AAAA'X,'1111'X,'AAAA'X,'4444'X,'AAAA'X,'1111'X, C 'AAAA'X,'4444'X,'AAAA'X,'5151'X,'AAAA'X,'4444'X,'AAAA'X,'1515'X, C 'AAAA'X,'4444'X,'AAAA'X,'5555'X,'AAAA'X,'4444'X,'AAAA'X,'5555'X, C 'AAAA'X,'5454'X,'AAAA'X,'5555'X,'AAAA'X,'4545'X,'AAAA'X,'5555'X, C DATA ICPTRN(1,01), ICPTRN(2,01) / 43690, 43690/ DATA ICPTRN(3,01), ICPTRN(4,01) / 43690, 43690/ DATA ICPTRN(5,01), ICPTRN(6,01) / 43690, 43690/ DATA ICPTRN(7,01), ICPTRN(8,01) / 43690, 43690/ DATA ICPTRN(1,02), ICPTRN(2,02) / 65535, 0/ DATA ICPTRN(3,02), ICPTRN(4,02) / 65535, 0/ DATA ICPTRN(5,02), ICPTRN(6,02) / 65535, 0/ DATA ICPTRN(7,02), ICPTRN(8,02) / 65535, 0/ DATA ICPTRN(1,03), ICPTRN(2,03) / 21845, 43690/ DATA ICPTRN(3,03), ICPTRN(4,03) / 21845, 43690/ DATA ICPTRN(5,03), ICPTRN(6,03) / 21845, 43690/ DATA ICPTRN(7,03), ICPTRN(8,03) / 21845, 43690/ DATA ICPTRN(1,04), ICPTRN(2,04) / 32896, 0/ DATA ICPTRN(3,04), ICPTRN(4,04) / 0, 0/ DATA ICPTRN(5,04), ICPTRN(6,04) / 2056, 0/ DATA ICPTRN(7,04), ICPTRN(8,04) / 0, 0/ DATA ICPTRN(1,05), ICPTRN(2,05) / 43690, 21845/ DATA ICPTRN(3,05), ICPTRN(4,05) / 43690, 21845/ DATA ICPTRN(5,05), ICPTRN(6,05) / 43690, 21845/ DATA ICPTRN(7,05), ICPTRN(8,05) / 43690, 21845/ DATA ICPTRN(1,06), ICPTRN(2,06) / 0, 43690/ DATA ICPTRN(3,06), ICPTRN(4,06) / 0, 43690/ DATA ICPTRN(5,06), ICPTRN(6,06) / 0, 43690/ DATA ICPTRN(7,06), ICPTRN(8,06) / 0, 43690/ DATA ICPTRN(1,07), ICPTRN(2,07) / 0, 21845/ DATA ICPTRN(3,07), ICPTRN(4,07) / 0, 21845/ DATA ICPTRN(5,07), ICPTRN(6,07) / 0, 21845/ DATA ICPTRN(7,07), ICPTRN(8,07) / 0, 21845/ DATA ICPTRN(1,08), ICPTRN(2,08) / 34952, 0/ DATA ICPTRN(3,08), ICPTRN(4,08) / 0, 0/ DATA ICPTRN(5,08), ICPTRN(6,08) / 34952, 0/ DATA ICPTRN(7,08), ICPTRN(8,08) / 0, 0/ DATA ICPTRN(1,09), ICPTRN(2,09) / 34952, 0/ DATA ICPTRN(3,09), ICPTRN(4,09) / 8224, 0/ DATA ICPTRN(5,09), ICPTRN(6,09) / 34952, 0/ DATA ICPTRN(7,09), ICPTRN(8,09) / 514, 0/ DATA ICPTRN(1,10), ICPTRN(2,10) / 34952, 0/ DATA ICPTRN(3,10), ICPTRN(4,10) / 8224, 0/ DATA ICPTRN(5,10), ICPTRN(6,10) / 34952, 0/ DATA ICPTRN(7,10), ICPTRN(8,10) / 8738, 0/ DATA ICPTRN(1,11), ICPTRN(2,11) / 34952, 0/ DATA ICPTRN(3,11), ICPTRN(4,11) / 8738, 0/ DATA ICPTRN(5,11), ICPTRN(6,11) / 34952, 0/ DATA ICPTRN(7,11), ICPTRN(8,11) / 8738, 0/ DATA ICPTRN(1,12), ICPTRN(2,12) / 4369, 0/ DATA ICPTRN(3,12), ICPTRN(4,12) / 17476, 0/ DATA ICPTRN(5,12), ICPTRN(6,12) / 4369, 0/ DATA ICPTRN(7,12), ICPTRN(8,12) / 17476, 0/ DATA ICPTRN(1,13), ICPTRN(2,13) / 43176, 0/ DATA ICPTRN(3,13), ICPTRN(4,13) / 8738, 0/ DATA ICPTRN(5,13), ICPTRN(6,13) / 35466, 0/ DATA ICPTRN(7,13), ICPTRN(8,13) / 8738, 0/ DATA ICPTRN(1,14), ICPTRN(2,14) / 43690, 0/ DATA ICPTRN(3,14), ICPTRN(4,14) / 8738, 0/ DATA ICPTRN(5,14), ICPTRN(6,14) / 43690, 0/ DATA ICPTRN(7,14), ICPTRN(8,14) / 8738, 0/ DATA ICPTRN(1,15), ICPTRN(2,15) / 43690, 0/ DATA ICPTRN(3,15), ICPTRN(4,15) / 41634, 0/ DATA ICPTRN(5,15), ICPTRN(6,15) / 43690, 0/ DATA ICPTRN(7,15), ICPTRN(8,15) / 10794, 0/ DATA ICPTRN(1,16), ICPTRN(2,16) / 43690, 0/ DATA ICPTRN(3,16), ICPTRN(4,16) / 43690, 0/ DATA ICPTRN(5,16), ICPTRN(6,16) / 43690, 0/ DATA ICPTRN(7,16), ICPTRN(8,16) / 43690, 0/ DATA ICPTRN(1,17), ICPTRN(2,17) / 21845, 0/ DATA ICPTRN(3,17), ICPTRN(4,17) / 21845, 0/ DATA ICPTRN(5,17), ICPTRN(6,17) / 21845, 0/ DATA ICPTRN(7,17), ICPTRN(8,17) / 21845, 0/ DATA ICPTRN(1,18), ICPTRN(2,18) / 43690, 16448/ DATA ICPTRN(3,18), ICPTRN(4,18) / 43690, 0/ DATA ICPTRN(5,18), ICPTRN(6,18) / 43690, 1028/ DATA ICPTRN(7,18), ICPTRN(8,18) / 43690, 0/ DATA ICPTRN(1,19), ICPTRN(2,19) / 43690, 17476/ DATA ICPTRN(3,19), ICPTRN(4,19) / 43690, 0/ DATA ICPTRN(5,19), ICPTRN(6,19) / 43690, 17476/ DATA ICPTRN(7,19), ICPTRN(8,19) / 43690, 0/ DATA ICPTRN(1,20), ICPTRN(2,20) / 21845, 8738/ DATA ICPTRN(3,20), ICPTRN(4,20) / 21845, 0/ DATA ICPTRN(5,20), ICPTRN(6,20) / 21845, 8738/ DATA ICPTRN(7,20), ICPTRN(8,20) / 21845, 0/ DATA ICPTRN(1,21), ICPTRN(2,21) / 0, 43690/ DATA ICPTRN(3,21), ICPTRN(4,21) / 17476, 43690/ DATA ICPTRN(5,21), ICPTRN(6,21) / 0, 43690/ DATA ICPTRN(7,21), ICPTRN(8,21) / 17476, 43690/ DATA ICPTRN(1,22), ICPTRN(2,22) / 43690, 17476/ DATA ICPTRN(3,22), ICPTRN(4,22) / 43690, 4369/ DATA ICPTRN(5,22), ICPTRN(6,22) / 43690, 17476/ DATA ICPTRN(7,22), ICPTRN(8,22) / 43690, 4369/ DATA ICPTRN(1,23), ICPTRN(2,23) / 43690, 17476/ DATA ICPTRN(3,23), ICPTRN(4,23) / 43690, 20817/ DATA ICPTRN(5,23), ICPTRN(6,23) / 43690, 17476/ DATA ICPTRN(7,23), ICPTRN(8,23) / 43690, 5397/ DATA ICPTRN(1,24), ICPTRN(2,24) / 43690, 17476/ DATA ICPTRN(3,24), ICPTRN(4,24) / 43690, 21845/ DATA ICPTRN(5,24), ICPTRN(6,24) / 43690, 17476/ DATA ICPTRN(7,24), ICPTRN(8,24) / 43690, 21845/ DATA ICPTRN(1,25), ICPTRN(2,25) / 43690, 21588/ DATA ICPTRN(3,25), ICPTRN(4,25) / 43690, 21845/ DATA ICPTRN(5,25), ICPTRN(6,25) / 43690, 17733/ DATA ICPTRN(7,25), ICPTRN(8,25) / 43690, 21845/ C C C... SET-PEN COMMAND WORD DATA SETPEN/33537/ C C C ************************ C... * RESET PLOT VARIABLES * C ************************ C SXC = 0.0 SYC = 0.0 TSINA = 0.0 TCOSA = 0.0 ANC = 0. HTC = 0. XOFF = 0. YOFF = 0.0 XFAC = XFACT YFAC = YFACT NCLIP = 0 KPAT = -1 NLPAT = 0 DO 105 IA=1,NCPASS VRFKNT(IA) = 0.0 BYTKNT(IA) = 0.0 105 CONTINUE OBJKNT(1) = 0.0 OBJKNT(2) = 0.0 OBJKNT(3) = 0.0 OBJKNT(4) = 0.0 FACT = 1.0 ICOPY = NCOPY ICUT = JCUT IBXMAX = 0 PMOVE = .TRUE. JFONT = 0 PFONT = 1 C C... SET ACTIVE FILL PATTERNS DO 115 I = 1,MAXPAT NPAT(I) = 0 115 CONTINUE C C... INITIALIZE DEFAULT PENS K = MXPEN + 1 DO 130 I = 1,K IPDEF(I) = .FALSE. PCOLOR(I) = PENTBL(I,1) PWIDTH(I) = PENTBL(I,2) IF (PWIDTH(I) .GT. MAXPEN) PWIDTH(I) = MAXPEN DO 125 J = 1,4 PENPAT(J,I) = 0 125 CONTINUE 130 CONTINUE C C... INITIALIZE THE CURRENT PEN JPEN = IJPEN KWIDTH = PWIDTH(JPEN+1) ILWM = KWIDTH/2 ILWP = (KWIDTH-1)/2 DASHPN = .FALSE. PENCHG = .FALSE. C C... SET UP THE TONING SEQUENCE FOR THE CURRENT PEN IF (IVCFLG .EQ. 0) GO TO 136 ITMP = PCOLOR(JPEN+1) DO 135 I = 1,NCPASS ITNSEQ(I) = IABS(ITNSEQ(I)) IF (ICLRDF(ITNSEQ(I),ITMP) .EQ. 0) ITNSEQ(I) = -ITNSEQ(I) 135 CONTINUE GO TO 138 C 136 ITNSEQ(1) = -1 ITNSEQ(2) = 0 ITNSEQ(3) = 0 ITNSEQ(4) = 0 C 138 CONTINUE C C... AT THE BEGINNING OF EACH PLOT, THE CONTROLLER USES A PEN C OF WIDTH 1. SET CURPEN TO REFLECT THIS FACT. C (IF KWIDTH IS NOT 1, WE WILL CHANGE THIS LATER) DO 140 I=1,4 140 CURPEN(I) = 1 C C... SET UP BYTES-PER-DRAW DRWKNT = DRWMIN IF (KWIDTH .EQ. 0) DRWKNT = 0.0 IF (KWIDTH .GT. 1) DRWKNT = DRWMAX C C... RESET COLOR DEFINED FLAGS IF DEFCLR CALLED DO 170 I = 1,IUCLR IF ( IDEFLG(I) .EQ. 1) IDEFLG(I) = 0 170 CONTINUE C C... SET DEFAULT TONING FLAG AND TONE COLOR ITNFLG = LTNFLG IF (IVCFLG .EQ. 0) ITNFLG = 0 ITNCLR = LTNCLR IF (ITNCLR .LE. 256) GO TO 171 IF (IDEFLG(ITNCLR-256) .EQ. 0) ITNCLR = 1 171 CONTINUE C C... SET DEFAULT VIEWPORT AND CLIPPING WINDOW CALL VPORT ( VXMIN, VXMAX, VYMIN, VYMAX ) CALL WINDOW ( WXMIN, WXMAX, WYMIN, WYMAX ) C C... RESET CURRENT POSITION IF (ROT90) GO TO 172 VCP(1) = XSTART VCP(2) = YSTART GO TO 173 172 VCP(1) = -YSTART VCP(2) = XSTART 173 CONTINUE C C ************************************************************** C * INITIALIZE BUFFER POINTERS AND OUTPUT BUFFER HEADERS * C * TO THE OUTPUT FILE, INITIALIZE GLOBAL PLOTTING VARIABLES * C ************************************************************** C C... SET UP POINTERS FOR TWO BUFFERS IBEGIN(1) = 1 IBEGIN(2) = 1 + LREC IBEGIN(3) = 1 + 2 * LREC IBEGIN(4) = 1 + 3 * LREC MIN = IBEGIN(4) + LREC NEXTO(1) = NCHUNK + 1 NEXTO(2) = NEXTO(1) NEXTO(3) = NEXTO(1) NEXTO(4) = NEXTO(1) MAX(1) = LREC*NCHUNK MAX(2) = MAX(1) MAX(3) = MAX(1) MAX(4) = MAX(1) C C... INITIALIZE THE FIRST DATA RECORD POINTER ARRAY. DO 165 IA=1,NCPASS IDASRT(IA) = NREC IREC(IA) = NREC NREC = NREC + 1 165 CONTINUE C C... SAVE TONING SEQUENCE AND SET ALL TONING SEQUENCE NUMBERS C... NEGATIVE SO ALL SUBSEQUENT OCHUNK OUTPUTS WILL GO TO ALL C... THE TONER BANDS. DO 175 IA=1,NCPASS JTNSEQ(IA) = ITNSEQ(IA) ITNSEQ(IA) = - IABS( ITNSEQ(IA) ) 175 CONTINUE C C... OUTPUT DATA STD. HEADERS, BYTE COUNT CALL OCHUNK (ICNSTX, 0) CALL OCHUNK (IHDCNT, 0) C C... OUTPUT INIT-VRF COMMAND/DATA WORDS CALL OCHUNK (IHBUF(1), 0) ITEMP = INT (RDEN) CALL OCHUNK (ITEMP, -1) CALL OCHUNK (IBYTES, -1) C C... OUTPUT BEGIN-BAND COMMAND CALL OCHUNK (IHBUF(2), 0) C C... OUTPUT BEGIN-BAND DATA WORD CALL OCHUNK (NIBSX, -1) C C... DEFINE PATTERNS FOR COLOR TONING. IF ( IVCFLG .EQ. 0 ) GOTO 293 DO 290 IA=1,25 IB = IA + 37 CALL DEFPAT ( IB, ICPTRN(1,IA), 8 ) 290 CONTINUE C C... SEND THE NULL TONE PATTERN. 293 CONTINUE CALL DEFPAT (63, 0, 1) C C... CHECK IF DIFFERENT FONT SELECTED IF (IFONT .NE. 0) CALL SETFNT (IFONT) C C... SET THE DEFAULT LINE COLOR TO THE PEN COLOR BY SETTING ALL C... BUT THE PEN COLOR TONERS TO POSITIVE SO ONLY THE C... PEN COLOR TONER BANDS WILL RECEIVE THE CONSTRUCTS UNTIL C... CHANGED BY A NEWPEN CALL. DO 275 IA=1,NCPASS ITNSEQ(IA) = JTNSEQ(IA) 275 CONTINUE C C... CHECK IF A SET PEN COMMAND MUST BE OUTPUT IF (KWIDTH .EQ. 1) GO TO 278 C C... OUTPUT A SETPEN COMMAND FOR THE APPROPRIATE WIDTH CALL OCHUNK(SETPEN,0) CALL OCHUNK(KWIDTH,0) C C... UPDATE THE CURRENT PEN WIDTH FOR THE ACTIVE TONERS DO 277 I = 1,NCPASS IF (ITNSEQ(I) .LT. 0) CURPEN(-ITNSEQ(I)) = KWIDTH 277 CONTINUE C 278 CONTINUE C C... CHECK IF SUBROUTINE AUTHOR CALLED BY USER IF (ITFLAG .EQ. -88) GO TO 280 C C... NO, CALL AUTHOR CALL AUTHOR(36HUNIVERSAL VERSAPLOT COLOR RANDOM 2.0,36) 280 CONTINUE RETURN END