SUBROUTINE PLOT ( X, Y, IPEN ) C C NAME: PLOT 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 5/30/84 ADD CALL TO RWAIT BEFORE FINAL RWRIT C C 5/30/84 RENUMBER TO MATCH B/W C C 6/13/84 DELETE SUPERFLUOUS RWAIT CALL C IN DO LOOP 1100 C C REV C 2/21/85 SET PMOVE TO TRUE IF THE FIRST ENDPOINT C OF THE VECTOR IS OUTSIDE THE CLIPPING C WINDOW. C C SUBROUTINE OUTVEC NOW USED TO OUTPUT THE C VECTOR INSTEAD OF AN INLINE SUBROUTINE. C C THE NEW VARIABLES LASTX AND LASTY ARE C NOW USED AND UPDATED. C C WE NOW CHECK FOR PENS THAT HAVE BEEN C DEFINED AS DASHED AND WE CALL DRWPEN TO C STROKE THEM OUT. C C AUTOMATIC Y-STRIPPING HAS BEEN ADDED. C SUBROUTINE VSTRIP IS CALLED IF THE C VECTOR CROSSES THE STRIPPING BOUNDARY. C C THE XSTRIPPING CHECK HAS BEEN MODIFIED C IF THE OUTPUT IS GOING TO A PRISM. C C 2/25/85 SOME GLOBAL VARIABLES ARE NOW RESET C AFTER THE CALL TO VRFPLT. THIS MAKES C SUBROUTINE PLOTS REENTRANT. C C PLOT - CLIP AND TRANSFORM VECTORS TO PLOTTER COORDINATES C C PLOT CONVERTS CALLS INTO VECTORS, AND CLIPS THESE VECTORS TO C THE USER DEFINED PLOTTING WINDOW. IT ALSO DOES THE BOOKKEEPING C NECESSARY TO MAINTAIN THE CURRENT ORIGIN AND THE CURRENT C POSITION OF THE VIRTUAL PEN RELATIVE TO THAT ORIGIN. C C THE CLIPPING OF VECTORS IS A PROCESS WHICH ASSURES THAT ALL C VECTORS GENERATED LIE WITHIN A RECTANGULAR REGION CALLED THE C VIEWING WINDOW. THE VIEWING WINDOW IS DEFINED BY AN XMIN EDGE, C AN XMAX EDGE, A YMIN EDGE, AND A YMAX EDGE. VECTORS WHOSE C ENDPOINTS ARE WITHIN THE WINDOW ARE COMPLETELY VISIBLE ON THE C PLOT. VECTORS THAT CROSS WINDOW BOUNDARIES ARE PARTIALLY C VISIBLE AND MUST BE CLIPPED. THE CLIPPING PROCESS CONSISTS OF C COMPUTING THE COORDINATES OF THE INTERSECTION OF THE VECTOR C WITH THE WINDOW BOUNDARY AND REPLACING THE INVISIBLE C ENDPOINT(S) WITH THE INTERSECTION COORDINATES. SUBROUTINE C *CLIP* TAKES CARE OF CLIPPING VECTORS TO THE VIEW WINDOW. C C C ENTRY: PLOT (X,Y,IPEN) C C X = X-COORDINATE (REAL) C Y = Y-COORDINATE (REAL) C C IPEN = +13 = MOVE TO OFFSET/SCALED (X,Y) C = +12 = DRAW TO OFFSET/SCALED (X,Y) C * = +3 = MOVE TO (X,Y) C * = +2 = DRAW TO (X,Y) C * = -2 = DRAW TO (X,Y), RE-ORIGIN C * = -3 = MOVE TO (X,Y), RE-ORIGIN C = -12 = DRAW TO OFFSET/SCALED (X,Y), RE-ORIGIN C = -13 = MOVE TO OFFSET/SCALED (X,Y), RE-ORIGIN C = IEOP = END-OF-PLOT (DEFAULT = -999,+-23) C * = IEOJ = END-OF-PLOT AND END-OF-JOB C (DEFAULT = +999) C C THE VARIABLES IEOP AND IEOJ ARE INITIALIZED IN C ROUTINE PLOTS/BLKDTA AND CAN BE SET TO ANY VALUE C BY THE USER. C C * DENOTES 'STANDARDIZED' PEN PLOTTER ARGUEMENTS; ADDITIONAL C VALUES ARE BASED ON A CONSENSUS OF CONVENTIONAL PRACTICES C THAT MAY VARY SOMEWHAT BETWEEN DIFFERENT PLOTTING C INSTALLATIONS. C C NOTES: C C AN END-OF-PLOT CALL MUST BE ISSUED TO COMPLETE A PLOT. C THE CURRENT PLOT IN PROGRESS IS ENDED AND THE SOFTWARE C SYSTEM INITIALIZES FOR A NEW PLOT. THE REINITIALIZATION C RESTORES ALL VARIABLES (SCALES, ORIGINS, LIMITS, COPY C COUNT, AND SO FORTH) TO THEIR ORIGINAL SETTINGS AS C DEFINED FOLLOWING THE INITIAL PLOTS CALL. C C WHEN AN END-OF-JOB IPEN VALUE IS ENCOUNTERED, THE CURRENT C PLOT IN PROCESS IS ENDED AND THE OUTPUT FILES ARE CLOSED. C THIS CALL MUST BE CALLED TO TERMINATE THE OUTPUT FILE C CORRECTLY. C C EXIT: CURRENT PEN POSITION = IF IPEN < 0 THEN (0,0) ELSE (X,Y) C C CALLS: CLIP,DRWPEN,MSGLG1,OCHUNK,OUTVEC,VPINIT,VSTRIP C XSTRIP,RCLOS,RWAIT,RWRIT,VRFPLT C C CALLED BY: USER,AXIS,CARC,CONVEX,CURVE,DASHLN,ELLIPS,LINE, C RECT,SYMBOL,XCIRCL,XTEXT C C COMMON USED: C /DVCOM/ C L DASHPN - .TRUE. IFF THE CURRENT PEN IS DEFINED AS C AN ON-OFF-ON-OFF PATTERN C I IAUTXT()- ARRAY TO HOLD AUTHOR TEXT STRING C I ICXPTS - MAXIMUM NUMBER OF POLYGON ELEMENTS ALLOWED C I IEOJ - END-OF-JOB IPEN CODE C I IEOP() - END-OF-PLOT IPEN CODE C I IHBUF() - VERSATEC DATA STANDARD HEADER WORDS C I ILWP - (LINE WIDTH - 1)/2 C I ILWM - LINE WIDTH/2 C I IOPEN - SUBROUTINE PLOTS FIRST CALL FLAG C I ISORT - PHASE II SORT FLAG SET BY SUBROUTINE PLOT C = 0 - NO PARTITIONING REQUIRED C = 1 - REP PARTITIONING REQUIRED C = 2 - RPM PARTITIONING REQUIRED C = 3 - REP AND RPM PARTITIONING REQUIRED C I IX1,IX2 C IY1,IY2 - WORKING STORAGE FOR CURRENT VECTOR C I MAXPAT - MAXIMUM NUMBER OF FILL PATTERNS DEFINABLE C I MSB - WORD TO SET HIGH ORDER BIT DETERMINED BY C PRECISION (16/32) SELECTED. C I NCH - NUMBER OF CHARACTERS IN AUTHOR TEXT STRING C I NCLIP - NUMBER OF CLIPPED VECTORS C I NPAT() - NPAT(I) IS THE NUMBER OF WORDS IN TONE C PATTERN #I C I NPLOT - NUMBER OF CURRENT PLOT C L PMOVE - STATUS OF LAST PLOT CALL (.TRUE.=MOVE) C R RORG() - AN X,Y PAIR WHICH DEFINES THE CURRENT C SOFTWARE ORIGIN. SET BY REORIGIN CALL C TO *PLOT* C L ROT90 - IF ROT90 = .TRUE. THEN ROTATE THE PLOT C COUNTERCLOCKWISE 90 DEGREES C R VCP() - CURRENT POINT IN COMPUTATIONAL COORDINATES C L VSFLAG - .TRUE. IFF STRIPPING IN THE Y-DIRECTION C IS NECESSARY C I VSMAX - MAXIMUM Y-VALUE FOR A STRIPPED VECTOR C R WIN() - THE CURRENT VIEW WINDOW IN COMPUTATIONAL C COORDINATES C R WTV() - WINDOW TRANSFORMATION VARIABLES. USED TO C TRANSFORM COORDINATES FROM THE VIEW WINDOW C SYSTEM TO THE VIEWPORT SYSTEM C R XFAC - SCALING FACTOR SET BY *OFFSET* AND USED BY C *PLOT* FOR SCALED/OFFSET MOVES C L XMAJOR - INDICATES IF XMAJOR MOVE VECTOR 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 I YNIPS - NIBS PER SCAN 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 IDISK - CONTROLLER WITH DISK FLAG. C = 0 - NO DISK [DEFAULT] C = 1 - DISK INSTALLED IN REP CONTROLLER C = 2 - DISK INSTALLED IN RPM CONTROLLER C = 3 - DISK INSTALLED IN BOTH REP AND C RPM CONTROLLER C I IRDT - RASTER DATA TRANSLATE FLAG. FOR EITHER C 100/200 OR 200/400 DOT SELECTION. NOT C SUPPORTED ON ALL VERSATEC MODELS. C = 0 - NO RASTER DATA TRANSLATE [DEFAULT] C # 0 - RASTER DATA TRANSLATE C I IFFAP - INDICATES WHETHER A FORM FEED OR SPACE C AFTER EACH PLOT IS DESIRED. C < 0 - FORM FEED AFTER PLOT C >= 0 - SPACE AFTER EACH PLOT (IN UNITS) C [DEFAULT = 0] C I INHNCE - LINE ENHANCE FLAG. NOT SUPPORTED ON ALL C VERSATEC MODELS. C = 0 - NO LINE ENHANCEMENT [DEFAULT] C # 0 - LINE ENHANCEMENT C I INITFF - INITIAL FORM FEED FLAG. C = 0 - NO INITIAL FORM FEED [DEFAULT] C # 0 - OUTPUT INITIAL FORM FEED C I INVERS - INVERSE IMAGE PLOTTING FLAG. NOT SUPPORTED C ON ALL VERSATEC MODELS. C = 0 - NO INVERSE IMAGE PLOTTING [DEFAULT] C # 0 - INVERSE IMAGE PLOTTING C I IPRISM()- CONTROLLER CONTROL ARRAY C I ISFLAG - PLOTTER SPEED CHANGE FLAG. C = 0 - NO SPEED CONTROL OUTPUT [DEFAULT] C # 0 - OUTPUT SPEED CONTROL COMMAND C I ISPACE - SPACE BETWEEN COPIES OF PLOTS. C >= 0 - SPACE BETWEEN COPIES C [DEFAULT= 2 * (RDEN/UNITS)] C = -1 - FORM FEED BETWEEN COPIES 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 KDISK - RPM DISK USE FLAG C = 0 - OVERFLOW ELEMENTS TO DISK IF C MEMORY CAPACITY EXCEEDED C = 1 - RASTER TO DISK ONLY IF MEMORY EXCEEDED C = 2 - RASTER TO DISK C I KREP - TARGET OUTPUT CONTROLLER C = 0 - UNKNOWN C = 1 - REP CONTROLLER C = 4 - RPM CONTROLLER C I KTWO - REP/RPM CONFIGURATION FLAG C = 0 - ONLY ONE TYPE OF CONTROLLER AVAILABLE C # 0 - REP & RPM SERIES CONTROLLER AVAILABLE C I LASTFF - LAST FORM FEED FLAG. C = 0 - NO FORM FEED AFTER THE LAST PLOT C # 0 - FORM FEED AFTER THE LAST PLOT C I MIRROR - MIRROR IMAGE PLOTTING FLAG. NOT C SUPPORTED ON ALL VERSATEC MODELS. C = 0 - NO MIRROR IMAGE PLOTTING [DEFAULT] C # 0 - MIRROR IMAGE PLOTTING C I MODE1 - INVOKE VRF OUTPUT FLAG C = 0 - DO NOT INVOKE VRF OUTPUT C = 1 - INVOKE VRF OUTPUT AT END-OF-JOB C = 2 - INVOKE VRF OUTPUT AT END-OF-PLOT C I MUXOUT - OUTPUT MULTIPLEXER PORT NUMBER C = 0 - NO OUTPUT MULTIPLEXER [DEFAULT] C = 1 - OUTPUT TO PORT #1 C = 2 - OUTPUT TO PORT #2 C = 3 - OUTPUT TO PORTS #1 AND #2 C R PMSIZE - RPM CONTROLLER MEMORY SIZE IN MEGABYTES C R RDEN - DEFAULT PLOTTER NIBS/INCH VALUE. C R UNITS - DEFAULT UNITS MEASURE EXPRESSED C IN UNITS/INCH. C /VRFCOM/ C R BYTKNT()- BYTE COUNT FOR EACH COLOR C R DRWELM - ELEMENT COUNT FOR A DRAW COMMAND C R DRWKNT - BYTE COUNT FOR A DRAW COMMAND C R RMXELM - MAXIMUM ELEMENT COUNT FOR BANDING C I IBXMAX - MAXIMUM X VALUE (USED FOR BANDING) C I ICOPY - PHASE II PLOT COPY COUNT C I IREC() - CURRENT RECORD POINTER C I NREC - NEXT RECORD POINTER C I NHEAD - POINTER TO NEXT FRAME HEADER BLOCK 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 ICOMD() - INTEGER ARRAY TO HOLD 16/32 BIT VRF C COMMANDS, INITIALIZED IN PLOTS C I IOCODE()- THE OUTCODES FOR THE STARTING AND C ENDING POINTS OF A VECTOR C I MAX() - THE END OF BUFFER POINTER OF THE C CURRENT VRF OUTPUT BUFFER 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 I PRECIS - COORDINATE PRECISION FOR THE VRF C OUTPUT FILE (16 OR 32-BIT PRECISION) C R VRFMAX - MAXIMUM ELEMENT COUNT FOR UNPARTITIONED C PLOT C /IOCOM/ C I LREC - LENGTH OF DATA FILE RECORD IN WORDS C C /MSGCOM/ C I INTARG()- ARRAY FOR PASSING INTEGER OUTPUT ARGUMENTS C R RELARG()- ARRAY FOR PASSING REAL OUTPUT ARGUMENTS C C /CLRCOM/ 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 /KLCOM/ C L KFLAG - FLAG INDICATING REP OUTPUT AND .GT. 13.65' C PLOTTING REQUIRED. C I KSIZE - VARIABLE DEFINING 13.65' IN SCANS, USED TO C DETERMINE IF ELEMENT CROSSES A 13.65' PAGE C BOUNDARY. C C LOCAL: C I IBND - INDEX TO CURRENT COLOR PARTITION C I IBYTS - BYTES REMAINING IN OUTPUT BUFFER C I IC200 - FORM-FEED COMMAND C I ICAREC - SAVE POINTER TO CONTROL ARRAY C I ICC04 - PRINT PASS-ALL COMMAND C I ICPCMD - COPY COMMAND FLAG WORD C I IDTBND - CURRENT PARTITION INDEX C I IEVRF - END-VRF COMMAND C I I,IA,IB, - INDEX FOR LOOPS C J C I IP - ABSOLUTE VALUE OF THE IPEN FUNCTION CODE C I IPLMAX - MAXIMUM X VALUE ALLOWED FOR PLOT + SPACE C I IPAGE1, - 13.65' PAGE INDEX C IPAGE2 C I IRECP - TEMP I*4 VARIABLE FOR EQU TO 2 16 BIT VAL C I IRECT() - TEMP I*2 VARIABLE FOR EQU TO 32 BIT VALUE C I IREW - PLOTTER REWIND COMMAND C I ISKIP - SKIP COMMAND TO FILL OUTPUT BUFFER C I ISKIP0 - INITIAL SKIP COMMAND C I ISPFF - SPACE/FORM-FEED FLAG C I ISTAT - STATUS OF THE CLIPPING OPERATION C I JDISK() - RPM DISK CONTROL FLAGS C I JFLAG - DISK/MULTI-COPY FLAG C I KSORT() - SORT FLAGS C I NDLTX - DELTA X (IX2-IX1) VALUE C I NDTBND - NUMBER OF PARTITIONS WITH ELEMENTS C I NTNSEQ() - TEMP STORAGE FOR ITNSEQ() C I NUMPAT - NUMBER OF PATTERNS DEFINED C R PATSIZ - BYTES OF RPM MEMORY REQUIRED FOR PATTERNS C L PENUP - PROCESSING FLAG: PEN UP/DOWN C R PSIZE - RPM MEMORY SIZE IN BYTES C R TMP - TEMPORARY VARIABLE C R VEC() - WORKING VECTOR C R XX,YY - CURRENT POINT IN WINDOW COORDINATES C R WCP() - SAVE CURRENT POINT IN WINDOW COORDINATES C C C LOGICAL PENUP 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 /MSGCOM/ - MESSAGE OUTPUT VARIABLES C COMMON /MSGCOM/ INTARG(8), RELARG(12) 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 /KLCOM/ - X STRIPPING VARIABLES C LOGICAL KFLAG COMMON /KLCOM/ KFLAG, KSIZE C DIMENSION WCP(2), VEC(4), NTNSEQ(4), KSORT(4), JDISK(4) C C C... DEFINE END-VRF('8000'X),FORM-FEED('C200'X),SKIP('C000'X) DATA IEVRF/32768/,IC200/49664/,ISKIP0/49152/ C C... DEFINE PASS-ALL COMMAND('CC04'X),REWIND-COMMAND('9B57'X), C PAPER-CUT COMMAND('9B4B'X), AND SET-PEN COMMAND('8301'X) DATA ICC04/52228/,IREW/39767/,ICUTP/39755/,ISETPN/33537/ C C C ******************************* C * DECODE IPEN SPECIFICATION * C ******************************* C XX = X YY = Y IP = IABS(IPEN) C-D C... CALL TO BE PRINTED? C RELARG(1)=XX C RELARG(2)=YY C INTARG(1)=IPEN C CALL MSGLG1(35) C-D C C... PEN DOWN MOVE? IF (IP.NE.2) GO TO 100 PENUP = .FALSE. GO TO 220 C C... PEN UP MOVE? 100 IF (IP.NE.3) GO TO 120 PENUP = .TRUE. GO TO 220 C C... PEN DOWN OFFSET/SCALED? 120 IF (IP.NE.12) GO TO 140 PENUP = .FALSE. GO TO 200 C C... PEN UP OFFSET/SCALED? 140 IF (IP.NE.13) GO TO 160 PENUP = .TRUE. GO TO 200 C C... END OF JOB? 160 IF (IPEN .EQ. IEOJ) GO TO 740 C C... CHECK END-OF-PLOT CODE DO 180 I = 1,4 IF (IEOP(I) .EQ. IPEN) GO TO 740 180 CONTINUE C-I C... OUTPUT UNDEFINED CALL MESSAGE INTARG(1)=IPEN CALL MSGLG1(36) GO TO 1380 C-I C C... SCALE/OFFSET COORDINATES 200 XX = (XX - XOFF)/XFAC YY = (YY - YOFF)/YFAC C C... TRANSLATE TO ACCOUNT FOR REORIGIN C SPECIAL *PLOT* CALLS ALLOW THE USER TO RESPECIFY THE SOFTWARE C PLOTTING ORIGIN. USER COORDINATES, WHICH ARE SPECIFIED RELATIVE C TO THE DYNAMIC SOFTWARE ORIGIN MUST BE TRANSLATED INTO THE WINDOW C COORDINATE SYSTEM. 220 XX = XX + RORG(1) YY = YY + RORG(2) C C... SAVE CURRENT POSITION IN WINDOW SYSTEM WCP(1) = XX WCP(2) = YY C C... ROTATE COORDINATES IF NECESSARY C IF THE PLOT IS BEING ROTATED, THEN THE VIEW WINDOW AND ALL C EXCLUSIVE CLIPPING WINDOWS ARE PRE-ROTATED. VECTORS MUST BE C TRANSFORMED TO THE ROTATED WINDOW COORDINATE SYSTEM. IF (.NOT. ROT90) GO TO 240 TMP = XX XX = -YY YY = TMP 240 IF (.NOT. PENUP) GO TO 260 C C... INDICATE PENUP CALL PMOVE = .TRUE. GO TO 720 C C... PROCESS PENDOWN CALL 260 VEC(1) = VCP(1) VEC(2) = VCP(2) VEC(3) = XX VEC(4) = YY C C... COMPUTE OUT CODES FOR ENDPOINTS C OUT CODES ARE CODES THAT SUMMARIZE THE POSITION OF A POINT IN C RELATION TO A RECTAGULAR WINDOW AREA. C C... CHECK FIRST END-POINT IOCODE(1) = 0 IF (VEC(1) .GE. WIN(1)) GO TO 280 IOCODE(1) = 1 GO TO 300 280 IF (VEC(1) .LE. WIN(3)) GO TO 300 IOCODE(1) = 2 300 IF (VEC(2) .GE. WIN(2)) GO TO 320 IOCODE(1) = IOCODE(1) + 4 GO TO 340 320 IF (VEC(2) .LE. WIN(4)) GO TO 340 IOCODE(1) = IOCODE(1) + 8 C C... CHECK END-POINT 340 IOCODE(2) = 0 IF (VEC(3) .GE. WIN(1)) GO TO 360 IOCODE(2) = 1 GO TO 380 360 IF (VEC(3) .LE. WIN(3)) GO TO 380 IOCODE(2) = 2 380 IF (VEC(4) .GE. WIN(2)) GO TO 400 IOCODE(2) = IOCODE(2) + 4 GO TO 420 400 IF (VEC(4) .LE. WIN(4)) GO TO 420 IOCODE(2) = IOCODE(2) + 8 C C... TEST FOR TRIVIAL ACCEPTANCE OF VECTOR C IF BOTH ENDPOINTS ARE INSIDE OF THE VIEW WINDOW, THEN THE VECTOR C IS COMPLETELY VISIBLE AND DOESN'T NEED TO BE CLIPPED. C-D C... CHANGE 'GO TO 500' TO 'GO TO 480' IF DEBUG MESSAGE #5 IS ENABLED C-D 420 IF (IOCODE(1) + IOCODE(2) .EQ. 0) GO TO 500 C C... IF THE FIRST ENDPOINT OF THE VECTOR IS OUTSIDE THE CLIPPING C WINDOW WE MUST SET PMOVE TO TRUE SO THAT A MOVE IS OUTPUT C TO THE CONTROLLER. IF (IOCODE(1) .NE. 0) PMOVE = .TRUE. C C... TEST FOR TRIVIAL REJECTION OF VECTOR C A VECTOR CAN BE REJECTED WITHOUT FURTHER TESTING IF ONE OF THE C FOLLOWING CONDITIONS IS TRUE: C C A) BOTH ENDPOINTS ARE ABOVE THE TOP EDGE OF THE VIEW WINDOW C B) BOTH ENDPOINTS ARE BELOW THE BOTTOM EDGE OF THE VIEW WINDOW C C) BOTH ENDPOINTS ARE LEFT OF THE LEFT EDGE OF THE VIEW WINDOW C D) BOTH ENDPOINTS ARE RIGHT OF THE RIGHT EDGE OF THE VIEW WINDOW C C IF 'AND'ING THE OUT CODES FOR TWO POINTS PRODUCES A NON-ZERO C RESULT, THEN ONE OF THE ABOVE CONDITIONS IS TRUE AND THE VECTOR C CAN BE REJECTED WITHOUT FURTHER TESTING. THIS IS SO BECAUSE EACH C OF THE FOUR BITS OF THE OUT CODE REPRESENTS THE RELATIONSHIP OF C THE POINT TO ONE OF THE WINDOW EDGES. A ZERO BIT INDICATES THAT C THE PT. IS ON THE VISIBLE SIDE OF THE CORRESPONDING WINDOW EDGE. C A ONE BIT INDICATES THAT THE POINT IS ON THE INVISIBLE SIDE OF C THE CORRESPONDING EDGE. THE OUTCODES FOR TWO PTS. CAN ONLY HAVE C THE SAME BIT SET IF BOTH POINTS ARE ON THE INVISIBLE SIDE OF THE C SAME WINDOW EDGE. THIS MEANS THAT ONE OF THE CONDITIONS A-D IS C TRUE. IF (AND(IOCODE(1),IOCODE(2)) .NE. 0) GO TO 440 C C... VECTOR MUST BE CLIPPED TO THE VIEW WINDOW C *CLIP* RETURNS THE PORTION OF A VECTOR WHICH IS INSIDE THE SPEC- C IFIED WINDOW AND THE STATUS OF THE CLIPPING OPERATION. CALL CLIP (VEC(1), ISTAT) C C... TEST FOR REJECTION OF VECTOR IF (ISTAT .NE. 4) GO TO 460 C C... UNPLOTTABLE VECTOR TO BE PRINTED? C IF THE CLIPPED VECTOR'S STATUS = 4, THEN THE VECTOR IS C INVISIBLE AND CAN BE REJECTED. 440 CONTINUE C-D C... OUTPUT UNPLOTTABLE VECTOR MESSAGE C RELARG(1)=VEC(1) C RELARG(2)=VEC(2) C RELARG(3)=VEC(3) C RELARG(4)=VEC(4) C RELARG(5)=WIN(1) C RELARG(6)=WIN(2) C RELARG(7)=WIN(3) C RELARG(8)=WIN(4) C RELARG(9)=RORG(1) C RELARG(10)=RORG(2) C CALL MSGLG1(37) C-D NCLIP = NCLIP + 1 C C... CHANGE CALL TO MOVE PMOVE = .TRUE. GO TO 720 C C... INCREMENT CLIPPING OPERATION COUNTER 460 NCLIP = NCLIP + 1 C-D C... OUTPUT CLIPPED VECTOR MESSAGE C RELARG(1)=VEC(1) C RELARG(2)=VEC(2) C RELARG(3)=VEC(3) C RELARG(4)=VEC(4) C RELARG(5)=WIN(1) C RELARG(6)=WIN(2) C RELARG(7)=WIN(3) C RELARG(8)=WIN(4) C RELARG(9)=RORG(1) C RELARG(10)=RORG(2) C CALL MSGLG1(38) C-D GO TO 500 C C 480 CONTINUE C-D C... OUTPUT PLOTTABLE VECTOR MESSAGE C RELARG(1)=VEC(1) C RELARG(2)=VEC(2) C RELARG(3)=VEC(3) C RELARG(4)=VEC(4) C RELARG(5)=WIN(1) C RELARG(6)=WIN(2) C RELARG(7)=WIN(3) C RELARG(8)=WIN(4) C RELARG(9)=RORG(1) C RELARG(10)=RORG(2) C CALL MSGLG1(39) C-D C C ******************************************************** C * PLOTTABLE VECTOR: TO * C ******************************************************** C C... TRANSFORM COORDINATES FROM WINDOW TO VIEWPORT SYSTEM C C... CHECK IF PREVIOUS POINT NEEDS TO BE COMPUTED 500 IF (PMOVE) GO TO 520 IX1 = LASTX IY1 = LASTY GO TO 540 520 IX1 = VEC(1)*WTV(1) + WTV(2) IY1 = VEC(2)*WTV(3) + WTV(4) 540 IX2 = VEC(3)*WTV(1) + WTV(2) IY2 = VEC(4)*WTV(3) + WTV(4) LASTX = IX2 LASTY = IY2 C C... DETERMINE IF THIS IS AN X-MAJOR MOVE XMAJOR = .FALSE. IF (IABS(IX2-IX1) .GE. IABS(IY2-IY1)) XMAJOR = .TRUE. C C... CHECK FOR A DEFINED PEN THAT MUST BE STROKED OUT IF (.NOT. DASHPN) GO TO 560 IF (IX1 .EQ. IX2 .AND. IY1 .EQ. IY2) GO TO 560 CALL DRWPEN GO TO 720 C C... CHECK IF STRIPPING IN THE Y-DIRECTION IS NECESSARY 560 IF (.NOT. VSFLAG) GO TO 620 IF (XMAJOR) GO TO 580 IF (IY1 .LT. YNIPS .AND. IY2 .LT. YNIPS) GO TO 620 GO TO 600 580 IF ((IY1+ILWP).LT.YNIPS .AND. (IY2+ILWP).LT.YNIPS) GO TO 620 600 CALL VSTRIP GO TO 720 C 620 CONTINUE C C... CHECK IF STRIPPING IN THE X-DIRECTION IS NECESSARY IF (.NOT. KFLAG) GO TO 700 C C... CHECK IF THE VECTOR IS LONGER THAN KSIZE NDLTX = IABS(IX2-IX1) IF (NDLTX .GE. KSIZE) GO TO 680 C C... IF PRISM, STRIPPING NOT NECESSARY IF (KREP .EQ. 4) GO TO 700 C C... CHECK IF THE VECTOR CROSSES A PAGE BOUNDARY IF (.NOT. XMAJOR) GO TO 630 IPAGE1 = (IX1+8)/KSIZE IPAGE2 = (IX2+8)/KSIZE GO TO 660 630 IF (IX1 .GT. IX2) GO TO 640 IPAGE1 = (IX1+8-ILWM)/KSIZE IPAGE2 = (IX2+8+ILWP)/KSIZE GO TO 660 640 IPAGE1 = (IX2+8-ILWM)/KSIZE IPAGE2 = (IX1+8+ILWP)/KSIZE 660 IF (IPAGE1 .EQ. IPAGE2) GO TO 700 C 680 CALL XSTRIP GO TO 720 C 700 CONTINUE CALL OUTVEC C C C... THE CURRENT PEN LOCATION IS UPDATED TO THE POINT SPECIFIED C IN THE *PLOT* CALL AFTER IT HAS BEEN TRANSFORMED TO THE WINDOW C COORDINATE SYSTEM BUT BEFORE IT HAS BEEN CLIPPED. 720 VCP(1) = XX VCP(2) = YY C C C ***************************** C * EXAMINE SPECIAL FUNCTIONS * C ***************************** C C... TEST FOR RE-ORIGIN SPECIFICATION IF (IPEN .GE. 0) RETURN C C C ****************** C * RE-ORIGIN CALL * C ****************** C C-D C... OUTPUT RE-ORGIN MESSAGE C RELARG(1)=RORG(1) C RELARG(2)=RORG(2) C RELARG(3)=WIN(1) C RELARG(4)=WIN(2) C RELARG(5)=WIN(3) C RELARG(6)=WIN(4) C CALL MSGLG1(40) C-D C C THE SOFTWARE ORIGIN IS SET TO THE CURRENT POSITION. RORG(1) = WCP(1) RORG(2) = WCP(2) C C... RE-ORIGIN TO BE PRINTED? C-D C... OUTPUT RE-ORGIN MESSAGE C RELARG(1)=RORG(1) C RELARG(2)=RORG(2) C RELARG(3)=WIN(1) C RELARG(4)=WIN(2) C RELARG(5)=WIN(3) C RELARG(6)=WIN(4) C CALL MSGLG1(40) C-D RETURN C C C ******************** C * END OF PLOT CALL * C ******************** 740 KPEN = IPEN IF (MODE1 .EQ. 2) KPEN = IEOJ C C SEE IF ANY ELEMENTS WERE MADE IN LAST PLOT C SAVE ITNSEQ() AND SET TO POSITIVE NUMBER C SEE HOW MANY PARTITIONS HAVE ELEMENTS IN THEM C NDTBND = 0 DO 760 IBND = 1,NCPASS,1 NTNSEQ(IBND) = ITNSEQ(IBND) ITNSEQ(IBND) = IABS(ITNSEQ(IBND)) IF (VRFKNT(IBND) .GT. 0.0) NDTBND = NDTBND + 1 760 CONTINUE C C... IF NDTBND = 0 AND NO ELEMENTS CLIPPED THEN NULL PLOT IF (NDTBND .EQ. 0 .AND. NCLIP .EQ. 0) GO TO 1260 C-I C... OUTPUT PLOT SUMMARY MESSAGES INTARG(1)=NPLOT INTARG(2)=NCLIP CALL MSGLG1(42) C C... IF NDTBND = 0, ALL ELEMENTS CLIPPED - IGNORE PLOT IF (NDTBND .EQ. 0) GO TO 1260 C C... OUTPUT OBJECT COUNT MESSAGES DO 765 J = 1,4 RELARG(1) = OBJKNT(J) IF (RELARG(1) .NE. 0.0) CALL MSGLG1(111+J) 765 CONTINUE C-I C C... GET TOTAL LENGTH OF TONE PATTERNS, ADJUST PRISM MEMORY SIZE ITEMP = 0 DO 770 I = 1,MAXPAT ITEMP = ITEMP + NPAT(I) 770 CONTINUE PATSIZ = 2.0 * ITEMP C C... CALCULATE PRISM MEMORY CAPACITY PSIZE = PMSIZE * 1048576.0 PMCAP = 0.0 IF (KREP .EQ. 1 .AND. KTWO .EQ. 0) GO TO 775 C C... DETERMINE LENGTH OF PLOT MAXXR = IBXMAX + 1 IF (IVCFLG .NE. 0) GO TO 773 ISPFF = ISPACE IF (NCOPY .EQ. 1 .OR. IFFAP .GT. ISPACE) ISPFF = IFFAP IF (ISPFF .LE. 0) GO TO 773 IPLMAX = 32759 IF (KREP .EQ. 4) IPLMAX = 32767 IF (PRECIS .EQ. 32) IPLMAX = 2147483647 I = ISPFF * INT(RDEN/UNITS) J = IPLMAX - IBXMAX IF (J .LE. 0) GO TO 773 IF (I .GT. J) I = J MAXXR = IBXMAX + I + 1 773 PMCAP = RPMCAP (IBYTES,MAXXR,0,PSIZE) 775 CONTINUE C C... SET COPY COUNT TO ONE IF 430 MAG TAPE OUTPUT IF (MTAPE .EQ. 1) ICOPY = 1 C C... SET COPY COMMAND FLAG ICPCMD = JCPCMD IF (ICOPY .EQ. 1) ICPCMD = 0 C C... CHECK IF COPY COMMAND CAN BE USED WITH THE REP IF (KREP.EQ.1 .AND. IDISK.NE.1 .AND. IDISK.NE.3) ICPCMD = 0 C C... OUTPUT BYTE COUNT MESSAGE AND SET SORT FLAGS CALL MSGLG1(116) DO 900 IBND = 1,NCPASS C C... ADD PATTERN BYTE COUNT TO TOTAL BYTE COUNT BYTKNT(IBND) = BYTKNT(IBND) + PATSIZ C C... OUTPUT MESSAGE RELARG(1) = BYTKNT(IBND) RELARG(2) = VRFKNT(IBND) IA = IABS(ITNSEQ(IBND)) IF (VRFKNT(IBND) .GT. 0.0) CALL MSGLG1(116+IA) C C... NOW CHECK IF PLOT REQUIRES PARTITIONING KSORT(IBND) = 0 C C... CHECK IF SORTING REQUIRED FOR A REP IF (KREP .EQ. 1 .AND. (JSORT .EQ. 1 .OR. (JSORT .EQ. 2 * .AND. MTAPE .NE. 1 .AND. IDISK .NE. 1 .AND. * IDISK .NE. 3 .AND. VRFKNT(IBND) .GT. VRFMAX))) * KSORT(IBND) = 1 C C... DETERMINE RPM DISK CONTROL FLAG. C IF USER SET PRISM CONTROL ARRAY, USE THAT VALUE. C OTHERWISE, IF THERE IS A PRISM WITH A DISK, SET THE C FLAG BASED ON THE DISK CONTROL FLAG AND WHETHER THE C PLOT EXCEEDS THE MEMORY CAPACITY. C NOTE: THIS FLAG, NOT THE DISK FLAG, IS USED C TO DETERMINE WHETHER SORTING IS NEEDED FOR THE RPM JDISK(IBND) = IPRISM(15) IF (KREP .EQ. 1 .AND. KTWO .EQ. 0) GO TO 895 IF ( (JDISK(IBND) .NE. -1) * .OR. (IDISK .EQ. 0 .OR. IDISK .EQ. 1)) GO TO 880 IF ( (KDISK .EQ. 1 .AND. BYTKNT(IBND) .GT. PMCAP) * .OR. KDISK .EQ. 2) JDISK(IBND) = 2 IF ( KDISK .EQ. 0 .AND. BYTKNT(IBND) .GT. PMCAP) * JDISK(IBND) = 4 880 CONTINUE C C... CHECK IF SORTING REQUIRED FOR AN RPM IF ((KREP .EQ. 4 .OR. KTWO .NE. 0) .AND. (JSORT .EQ. 1 * .OR. (JSORT .EQ. 2 .AND. MTAPE .NE. 1 .AND. * JDISK(IBND) .NE. 3 .AND. JDISK(IBND) .NE. 4 .AND. * BYTKNT(IBND) .GT. PMCAP))) * KSORT(IBND) = KSORT(IBND) + 2 C C... CHECK IF PARTITIONING NECESSARY IF (KSORT(IBND) .NE. 0 .OR. (JSORT .NE. 0 .AND. * KREP .NE. 4 .AND. IBXMAX .GT. 32767 .AND. * MTAPE .EQ. 0)) * GO TO 890 C C... NO PARTITIONING - C CHECK IF COPY COMMAND CAN BE USED WITH THE RPM IF (BYTKNT(IBND) .GT. PMCAP .AND. JDISK(IBND) .NE. 2 * .AND. JDISK(IBND) .NE. 3 .AND. JDISK(IBND) .NE. 4) * ICPCMD = 0 GO TO 895 C C... PARTITIONING - C CHECK IF COPY COMMAND CAN BE USED WITH THE RPM 890 IF (JDISK(IBND) .NE. 2) ICPCMD = 0 C C... SET GLOBAL SORT FLAG 895 IF (KSORT(IBND) .NE. 0) ISORT = -1 C 900 CONTINUE C C... ONLY SEND MULTIPLE COPIES TO TAPE IF C THE COPY COMMAND IS TO BE USED IF (MTAPE .EQ. 2 .AND. ICPCMD .EQ. 0) ICOPY = 1 C C C ************************************************************* C * THIS LOOP INSERTS THE REQUIRED MOVE/DRAW CMD FOR SPACING * C * BETWEEN COPIES/PLOTS; END-VRF, REWIND, FORM-FEED AND SKIP * C * COMMANDS IF REQUIRED. * C ************************************************************* C C... SEE IF EACH DATA BUFFER FOR EACH PARTITION NEEDS FLUSHING IDTBND = 0 DO 1100 IBND = 1,NCPASS,1 IF (VRFKNT(IBND) .EQ. 0) GO TO 1100 IDTBND = IDTBND + 1 ITNSEQ(IBND) = - ITNSEQ(IBND) C C... CHECK IF INVISIBLE DOT SHOULD BE DRAWN TO GET SPACE C C... CHECK IF COLOR OR COPY COMMAND TO BE USED IF (IVCFLG .NE. 0 .OR. ICPCMD .NE. 0) GO TO 980 C C... SET FF/SPACE FLAG ISPFF = ISPACE C C... IF SINGLE COPY, USE IFFAP FLAG IF (ICOPY .EQ. 1) ISPFF = IFFAP C C... CHECK IF FORM-FEED OR ZERO SPACE REQUESTED IF (ISPFF .LE. 0) GO TO 980 C C... SET SPACE LIMIT FOR DEVICE IPLMAX = 32759 IF (KREP .EQ. 4) IPLMAX = 32767 IF (PRECIS .EQ. 32) IPLMAX = 2147483647 C C... COMPUTE SPACE AFTER PLOT AND MAXIMUM ALLOWABLE SPACE I = ISPFF * INT(RDEN/UNITS) J = IPLMAX - IBXMAX C C... CHECK IF MOVE/DRAW REQUIRED IF (J .LE. 0) GO TO 980 C C... CHECK IF 32 BIT PRECISION IF (PRECIS .EQ. 32) GO TO 940 C C... CHECK IF IBXMAX TOO LARGE FOR 16 BIT PRECISION IF (I .LE. J) GO TO 940 IBXMAX = IPLMAX CALL MSGLG1 (126) GO TO 960 C C... COMPUTE NEW IBXMAX 940 IBXMAX = IBXMAX + I C C... OUTPUT SET PEN #0 COMMAND 960 CALL OCHUNK (ISETPN, 0) CALL OCHUNK (0, 0) C C... OUTPUT MOVE/DRAW CALL OCHUNK (IBXMAX, -1) CALL OCHUNK (0, -1) CALL OCHUNK (IBXMAX, -1) CALL OCHUNK (MSB, -1) C C... COUNT THE CONSTRUCT VRFKNT(IBND) = VRFKNT(IBND) + DRWELM C C... OUTPUT END-OF-PLOT CODE 980 CALL OCHUNK (IEVRF, 0) C C... ISSUE A REWIND IF NOT LAST PARTITION IF (NDTBND .EQ. IDTBND) GO TO 1000 CALL OCHUNK (ICC04, 0) CALL OCHUNK (IREW, 0) CALL OCHUNK (0, 0) GO TO 1020 C C... OUTPUT AN IMMEDIATE PAPER CUT IF NECESSARY 1000 IF (ICUT .NE. -1) GO TO 1010 CALL OCHUNK (ICC04, 0) CALL OCHUNK (ICUTP, 0) CALL OCHUNK (0, 0) C C... OUTPUT A FORM FEED IF NECESSARY 1010 IF (IVCFLG.NE.0 .OR. (ICOPY .EQ. 1 .AND. IFFAP .EQ. -1) .OR. * (ICOPY.GT.1 .AND. ((ICPCMD.EQ.0 .AND. ISPACE.EQ.-1) .OR. * (ICPCMD.EQ.1 .AND. IFFAP .EQ.-1)))) CALL OCHUNK (IC200,0) C C... CALCULATE REMAINING BYTE COUNT 1020 IBYTS = (MAX(IBND) - NEXTO(IBND) + 1) * 2 C C... INSERT SKIP COMMANDS 1040 IF (IBYTS .LE. 256) GO TO 1060 ISKIP = OR (ISKIP0,254) CALL OCHUNK (ISKIP,0) NEXTO(IBND) = NEXTO(IBND) + 127 IBYTS = IBYTS - 256 GO TO 1040 C C... INSERT LAST SKIP COMMAND 1060 IF (IBYTS .EQ. 0) GO TO 1080 ISKIP = OR (ISKIP0,IBYTS-2) CALL OCHUNK (ISKIP,0) C C... FLUSH THE LAST BUFFER 1080 OBUF(IBEGIN(IBND)) = 0 CALL RWAIT CALL RWRIT(OBUF(IBEGIN(IBND)),IREC(IBND)) ITNSEQ(IBND) = IABS(ITNSEQ(IBND)) 1100 CONTINUE C C... INCREMENT PLOT COUNT NPLOT = NPLOT + 1 CALL RWAIT C C ******************************************************** C * THIS LOOP OUTPUTS THE PARTITION HEADER RECORDS AFTER * C * INSERTING THE REQUIRED PLOTTING PARAMETERS. * C ******************************************************** C C... WRITE PARTITION HEADERS FOR PARTITIONS WITH ELEMENTS IDTBND = 0 DO 1240 IBND=1,NCPASS,1 IF (VRFKNT(IBND) .EQ. 0) GO TO 1240 C C... ZERO OUT HEADER RECORD DO 1120 I = 1,LREC OBUF(I) = 0 1120 CONTINUE IDTBND = IDTBND + 1 C C... SET PHASE II PARTITIONING FLAG OBUF(2) = KSORT(IBND) C C... PUT VRFKNT IN PARTITION HEADER OBUF(8) = INT(VRFKNT(IBND)) C C... PUT PARTITION XMAX IN PARTITION HEADER OBUF(9) = IBXMAX C C... NO X-STRIPPING IF RPM OR IF PARTITION FLAG IS 0 IF (KREP .EQ. 4 .OR. JSORT .EQ. 0) GO TO 1150 C C... SET X-STRIPPING FLAG FOR PHASE II IF (IBXMAX .GT. 32759 .AND. MTAPE .EQ. 0) OBUF(10) = -1 IF (OBUF(10) .EQ. -1) ISORT = -1 1150 CONTINUE C C... INSERT PLOT LENGTH FOR PHASE II IF COLOR FLAG SET IF (IVCFLG .NE. 0) * OBUF(11) = MAX1((FLOAT(IBXMAX)+RDEN-1.0)/RDEN,1.0) C C... INSERT SINGLE/MULTI-PASS COUNT OBUF(12) = NDTBND C C... SET LINKS TO NEXT DATA RECORD AND PARTITION HEADER OBUF(1) = IDASRT(IBND) OBUF(5) = NREC ICAREC = NREC NREC = NREC + 1 OBUF(3) = NREC C C... IF END-OF-JOB CALL, SET ZERO LINK POINTER IF (KPEN .EQ. IEOJ .AND. NDTBND .EQ. IDTBND) OBUF(3) = 0 C C... SET PLOT NUMBER/COPY COUNT OBUF(6) = NPLOT - 1 OBUF(7) = ICOPY C C... INSERT TONER NUMBER FOR THIS PLOT IF (VRFKNT(IBND) .NE. 0) OBUF(13) = ITNSEQ(IBND) C C... INSERT AUTHOR FIELD CHARACTER COUNT OBUF(14) = NCH C C... INSERT AUTHOR FIELD IB = (NCH+3) / 4 DO 1160 I = 1,IB OBUF(I+14) = IAUTXT(I) 1160 CONTINUE C C... SET NUMBER OF ELEMENT BYTES IN VRF PARTITION OBUF(30) = INT(BYTKNT(IBND)) C C... SET COPY COMMAND FLAG WORD OBUF(31) = ICPCMD C C... SET PAPER CUT FLAG OBUF(32) = ICUT C C... SET LENGTH OF PLOT OBUF(33) = IBXMAX C C... OUTPUT RECORD CALL RWRIT (OBUF(1),NHEAD) CALL RWAIT C C... OUTPUT CONTROL ARRAY DO 1180 I = 1,LREC OBUF(I) = 0 1180 CONTINUE C C... SET NUMBER OF CONTROL ARRAY ENTRIES OBUF(1) = IPRISM(1) C C... SET PRISM CONTROL ARRAY FLAGWORD OBUF(2) = IPRISM(2) C C... SET NUMBER OF ELEMENT BYTES IN VRF PARTITION OBUF(3) = INT(BYTKNT(IBND)) C C... SET PARTITION SIZE OBUF(4) = IBXMAX + 1 C C... SET MAXIMUM X OBUF(5) = IBXMAX C C... SET REST OF ARRAY ITMP = IPRISM(1) + 1 DO 1200 I = 6, ITMP OBUF(I) = IPRISM(I) 1200 CONTINUE C C... SET RPM DISK CONTROL FLAG OBUF(15) = JDISK(IBND) CALL RWRIT (OBUF(1),ICAREC) CALL RWAIT C C... RESET THE HEADER POINTER FOR NEXT TIME IF NOT LAST IF (KPEN .EQ. IEOJ .AND. NDTBND .EQ. IDTBND) GO TO 1240 NHEAD = NREC NREC = NREC + 1 1240 CONTINUE C C... RESET ITNSEQ TO ORIGINAL VALUE 1260 DO 1280 IBND=1,NCPASS,1 ITNSEQ(IBND) = NTNSEQ(IBND) 1280 CONTINUE C C... CHECK FOR END-OF-JOB CALL IF (KPEN .EQ. IEOJ) GO TO 1300 C C... INITIALIZE FOR NEXT PLOT CALL VPINIT GO TO 1380 C C **************************************************** C * END-OF-JOB PLOT CALL, UPDATE AND OUTPUT THE FILE * C * HEADER RECORD. * C **************************************************** C C... OUTPUT PARAMETER BLOCK 1300 CALL RWAIT DO 1320 I = 1,LREC OBUF(I) = 0 1320 CONTINUE C C... IF NO DATA GENERATED, SET NREC IF (NDTBND .EQ. 0) NREC = NHEAD + 1 C C... PASS NUMBER OF RECORDS IN FILE OBUF(1) = NREC - 1 C C... PASS FILE SORT FLAG OBUF(2) = ISORT C C... PASS MAX PARTITION ELEMENT SIZE OBUF(3) = INT(RMXELM) C C... SET COLOR RANDOM VERSION NUMBER OBUF(4) = 102 C C... SET POINTER TO FIRST PLOT HEADER OBUF(5) = 2 C C... SET MUX, PDQ AND SPACE SUPPORT OBUF(6) = KREP OBUF(7) = INITFF OBUF(8) = IFFAP OBUF(9) = ISPACE OBUF(10) = LASTFF OBUF(11) = INT(RDEN) OBUF(12) = IBYTES OBUF(13) = MUXOUT OBUF(14) = INHNCE OBUF(15) = INVERS OBUF(16) = MIRROR OBUF(17) = IRDT OBUF(18) = -2 IF (ISFLAG .NE. 0) OBUF(18) = ISPEED OBUF(19) = IDISK OBUF(20) = INT(RDEN/UNITS) OBUF(21) = KTWO OBUF(22) = INT(PSIZE) OBUF(23) = PRECIS OBUF(24) = MTAPE C C... OUTPUT RECORD NREC = 1 CALL RWRIT (OBUF(1),NREC) CALL RWAIT C C... OUTPUT NULL HEADER IF NECESSARY IF (NDTBND .NE. 0) GO TO 1360 DO 1340 I = 1,LREC OBUF(I) = 0 1340 CONTINUE CALL RWRIT (OBUF(1),NHEAD) CALL RWAIT 1360 CONTINUE C C... CLOSE OUTPUT FILE CALL RCLOS C C C... CHECK IF PHASE II NEEDS TO BE CALLED IOPEN = -2 IF (MODE1 .EQ. 0) GO TO 1370 C-C C... ACTIVATE THE FOLLOWING TWO LINES OF CODE C... TO SUPPORT THE VRF OUTPUT OPTION C CALL VRFPLT C IOPEN = 0 C-C C C... SET UP SO PLOTS CAN BE CALLED AGAIN 1370 ICOMD(1) = 36099 ICOMD(2) = 35586 IHBUF(1) = 33536 IHBUF(2) = 33025 ICXPTS = 127 MAXPAT = 255 MAXPEN = 31 ISORT = 0 IF (KTWO .EQ. 1) KREP = 0 IF (IPEN .NE. IEOJ) CALL PLOTS(0,0,0) C 1380 IF (NPLOT .GT. 999) NPLOT = 1 RETURN END