SUBROUTINE CHANGE C C NAME: CHANGE 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 5/7/84 DON'T ALLOW FORM FEED IN COLOR MODE C C 5/24/84 RECOMPUTE PAPER/WINDOW/VIEWPORT AFTER C CHANGING XFACT OR YFACT. C COMPUTE YDEN AS A FUNCTION OF YFACT C INSTEAD OF XFACT. C ALLOW FONT PATTERN NUMBER 0. C C REV. C 1/9/85 SUPPORT PDQ OPTIONS, MULTIPLEXER, C SPACE BETWEEN COPIES, AND RPM SERIES C CONTROLLER. C C CHANGE - MODIFY PLOT OPTIONS AT RUN-TIME C C SUBROUTINE CHANGE ALLOWS THE USER TO CHANGE VARIOUS PLOT C OPTIONS AT RUN-TIME. C C ENTRY: CALL CHANGE C C EXIT: RETURN C C CALLS: NONE C C CALLED BY: PLOTS C C COMMON USED: C /DVCOM/ C I IEOJ - END-OF-JOB IPEN CODE C I IEOP() - END-OF-PLOT IPEN CODE C I PXMAX - PAPER MAXIMUM 'X' DIMENSION C I PXMIN - PAPER MINIMUM 'X' DIMENSION C I PYMAX - PAPER MAXIMUM 'Y' DIMENSION C I PYMIN - PAPER MINIMUM 'Y' DIMENSION C L ROT90 - IF ROT90 = .TRUE. THEN ROTATE THE PLOT C COUNTERCLOCKWISE 90 DEGREES C C /PRMCOM/ C I BMODEL - DEFAULT BLACK AND WHITE PLOTTER MODEL. C I BDEN - DEFAULT BLACK AND WHITE PLOTTER NIBS/INCH. C I BBYTES - DEFAULT BLACK AND WHITE PLOTTER BYTES/SCAN. C I CMODEL - DEFAULT COLOR PLOTTER MODEL. C I CDEN - DEFAULT COLOR PLOTTER NIBS/INCH. C I CBYTES - DEFAULT COLOR PLOTTER BYTES/SCAN. 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 IUSER - RESERVED. C I JCPCMD - COPY COMMAND FLAG C = 0 - DON'T USE COPY COMMAND C = 1 - USE COPY COMMAND WHEN POSSIBLE C I JCUT - PAPER CUT FLAG C = -1 - CUT IMMEDIATE C = 0 - NO PAPER CUT COMMAND C = 1 - SET PAGE MODE C I JSORT - PARTITION FLAG C = 0 - NEVER PARTITION C = 1 - ALWAYS PARTITION C = 2 - PARTITION ONLY WHEN NECESSARY 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 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 MODEL - DEFAULT PLOTTER MODEL. C I MTAPE - MAG TAPE OUTPUT FLAG C = 0 - OUTPUT TO A CONTROLLER C = 1 - OUTPUT TO A 430 MAG TAPE C = 2 - OUTPUT TO A REP OR RPM C I NCOPY - PLOT COPY COUNT. C R PMSIZE - RPM CONTROLLER MEMORY SIZE IN MEGABYTES C R RDEN - DEFAULT PLOTTER NIBS/INCH VALUE. C R SCALE - DEFAULT DRAWING SCALE FACTOR. C R UNITS - DEFAULT UNITS MEASURE EXPRESSED C IN UNITS/INCH. 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 L VSTRP - .TRUE. IFF Y-STRIPPING ENABLED C /VRFCOM/ C I PRECIS - COORDINATE PRECISION FOR THE VRF C OUTPUT FILE (16 OR 32-BIT PRECISION) C /IOCOM/ C I LUNIT - LOGICAL UNIT NUMBER OF LISTING DEVICE C /CLRCOM/ C I ICLMAX - NUMBER OF TONE COLORS DEFINED C I ITNCLR - CURRENT TONE COLOR INDEX C I ITNFLG - USE PEN OR TONE COLOR FOR AREAS 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 LOCAL VARIABLES: C C I IEMAX - MAXIMUM NUMBER OF ENTRIES C I KUNIT - LOGICAL INPUT UNIT C I IVALUE - INTEGER OF VALUE C I IROT - TEMPORARY VARIABLE FOR ROT90 C R VALUE - NEW PLOT OPTION VALUE 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 /IOCOM/ - INPUT/OUTPUT VARIABLES C COMMON /IOCOM/ * IUNIT, LUNIT, LREC, IOTYPE 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 /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 DATA IEMAX/ 6 / C C C********************************************************** C C FORMAT STATEMENTS C ----------------- C C C OUTPUT STATEMENTS C 9000 FORMAT ( * //, 16X, 10H MAIN MENU, //, * 10H (1) EXIT, /, * 10H (2) LIST, /, * 23H (3) PLOT OPTIONS MENU, /, * 37H (4) PLOTTER/CONTROLLER OPTIONS MENU, /, * 26H (5) VIEWING OPTIONS MENU, /, * 24H (6) COLOR OPTIONS MENU, //, * 43H PLEASE ENTER THE NUMBER OF YOUR SELECTION ) 9010 FORMAT ( * 24H WHAT IS THE NEW VALUE? ) 9100 FORMAT ( * //, 33X, 13H PLOT OPTIONS, //, * 30H ( 1) EXIT , 10X, * 30H ( 2) LIST , /, * 30H ( 3) NUMBER OF COPIES = , I10, * 30H ( 4) COORDINATE PRECISION = , I10, /, * 30H ( 5) FONT PATTERN NUMBER = , I10, * 30H ( 6) INITIAL FORM-FEED = , I10, /, * 30H ( 7) END-OF-PLOT CODE 1 = , I10, * 30H ( 8) END-OF-PLOT CODE 2 = , I10, /, * 30H ( 9) END-OF-PLOT CODE 3 = , I10, * 30H (10) END-OF-PLOT CODE 4 = , I10, /, * 30H (11) END-OF-JOB CODE = , I10, * 30H (12) NOT SUPPORTED ) 9110 FORMAT ( * 30H (13) UNITS PER INCH = , F10.2, * 30H (14) PLOT ROTATION = , I10, /, * 30H (15) DRAWING SCALE FACTOR = , F10.2, * 30H (16) X SCALING FACTOR = , F10.2, /, * 30H (17) Y SCALING FACTOR = , F10.2, * 30H (18) STARTING X COORD. = , F10.2, /, * 30H (19) STARTING Y COORD. = , F10.2, * 30H (20) CURRENT PEN = , I10, /, * 30H (21) FF/SPACE AFTER COPIES= , I10, * 30H (22) FF/SPACE AFTER PLOTS = , I10, /, * 30H (23) LAST FORM FEED = , I10, * 30H (24) INVOKE VRF OUTPUT = , I10, /, * 30H (25) STRIP WIDE PLOTS = , I10, //, * 43H PLEASE ENTER THE NUMBER OF YOUR SELECTION ) 9130 FORMAT ( * 44H WHAT IS THE PEN NUMBER? (ENTER -1 TO EXIT) ) 9140 FORMAT ( * 24H WHAT IS THE PEN WIDTH? ) 9200 FORMAT (//, 31X, 27H PLOTTER/CONTROLLER OPTIONS, //, * 30H ( 1) EXIT , 10X, * 30H ( 2) LIST , /, * 30H ( 3) PLOTTER MODEL = , I10, * 30H ( 4) NIBS PER INCH = , F10.2, /, * 30H ( 5) BYTES PER SCAN = , I10, * 30H ( 6) SPEED CONTROL = , I10, /, * 30H ( 7) SPEED CONTROL VALUE = , I10, * 30H ( 8) OUTPUT CONTROLLER = , I10, /, * 30H ( 9) CONTROLLER WITH DISK = , I10, * 30H (10) NOT SUPPORTED , /, * 30H (11) LINE ENHANCE = , I10, * 30H (12) INVERSE IMAGE = , I10, /, * 30H (13) MIRROR IMAGE = , I10, * 30H (14) RASTER DATA TRANSLATE= , I10 ) 9205 FORMAT ( * 30H (15) NOT SUPPORTED , 10X, * 30H (16) PLOTTER DEVICE # = , I10, /, * 30H (17) RPM MEMORY SIZE = , F8.1,'MB', * 30H (18) MAG TAPE OUTPUT = , I10, /, * 30H (19) PARTITION FLAG = , I10, * 30H (20) COPY COMMAND FLAG = , I10, /, * 30H (21) NOT SUPPORTED , 10X, * 30H (22) PAPER CUT FLAG = , I10, /, * 30H (23) RPM DISK USE FLAG = , I10, * 31H (24) MODIFY RPM CONTROL ARRAY, 9X, //, * 43H PLEASE ENTER THE NUMBER OF YOUR SELECTION ) 9210 FORMAT ( * 34H WHAT IS THE SPEED CONTROL VALUE? ) 9250 FORMAT (4X,37H CHANGE - ERROR, 200 DOT/INCH ONLY ) 9300 FORMAT ( * //, 31X, 16H VIEWING OPTIONS, //, * 30H ( 1) EXIT , 10X, * 30H ( 2) LIST , /, * 30H ( 3) MIN. PAPER X DIM. = , F10.2, * 30H ( 4) MIN. PAPER Y DIM. = , F10.2, /, * 30H ( 5) MAX. PAPER X DIM. = , F10.2, * 30H ( 6) MAX. PAPER Y DIM. = , F10.2, /, * 30H ( 7) MIN. VIEWPORT X DIM. = , F10.2, * 30H ( 8) MIN. VIEWPORT Y DIM. = , F10.2, /, * 30H ( 9) MAX. VIEWPORT X DIM. = , F10.2, * 30H (10) MAX. VIEWPORT Y DIM. = , F10.2, /, * 30H (11) MIN. WINDOW X DIM. = , F10.2, * 30H (12) MIN. WINDOW Y DIM. = , F10.2, /, * 30H (13) MAX. WINDOW X DIM. = , F10.2, * 30H (14) MAX. WINDOW Y DIM. = , F10.2, //, * 43H PLEASE ENTER THE NUMBER OF YOUR SELECTION ) 9400 FORMAT ( * //, 22X, 23H COLOR PLOTTING OPTIONS, //, * 30H ( 1) EXIT , /, * 30H ( 2) LIST , /, * 50H ( 3) MODE (-1=COLOR; 0=B/W) = , I4, /, * 50H ( 4) CURRENT TONE COLOR = , I4, /, * 50H ( 5) TONE FLAG (0=PEN COLOR; -1=TONE COLOR) = , I4, /, * 50H ( 6) CURRENT TONING SEQUENCE = , * 3(I2,1H,),I2, /, * 57H (0=NOT USED; 1=BLACK; 2=CYAN; 3=MAGENTA; 4=YELLOW), /, * 30H ( 7) DEFINE THE PENS , //, * 43H PLEASE ENTER THE NUMBER OF YOUR SELECTION ) 9410 FORMAT ( * //, 9X, 24H CURRENT TONING SEQUENCE, //, * 20H NUMBER OF TONERS = , I2, /, * 11H TONER 1 = , I2, /, * 11H TONER 2 = , I2, /, * 11H TONER 3 = , I2, /, * 11H TONER 4 = , I2, // ) 9420 FORMAT ( * 48H WHAT IS TOTAL NUMBER OF TONERS? (MAXIMUM OF 4) ,/, * 44H (-1=BLACK/WHITE MODE; 0=DEFAULT COLOR MODE), /) 9430 FORMAT ( * 29H WHAT IS THE NUMBER OF TONER , I2, 1H? ) 9440 FORMAT ( * /, 16H PEN RANGE: 0 - , I2, / ) 9445 FORMAT( * 5H PEN , I2, 10H COLOR = , I2, 10H WIDTH = , I2 ) 9450 FORMAT ( * 24H WHAT IS THE PEN COLOR? ) 9501 FORMAT ( * /, 43H ENTER INDEX OF WORD TO MODIFY (0 TO EXIT) ) 9502 FORMAT ( * 17H CURRENT VALUE = ,I20 ) 9503 FORMAT ( * 12H NEW VALUE? ) 9504 FORMAT ( * 28H *** ALSO UPDATE OPTION #18 ) C C-E 9900 FORMAT (4X,35HCHANGE - ILLEGAL OR INVALID VALUE) 9902 FORMAT (4X,39HCHANGE - THIS OPTION IS NOT SUPPORTED) C----------------------------------------------------------- C C C-W ******** SYSTEM DEPENDENT VARIABLE C... LOGICAL INPUT UNIT KUNIT = 5 C-W ********* C C----------------------------------------------------------- C C MAIN MENU C C C... PRINT THE LIST OF OPTIONS. 0100 CONTINUE WRITE ( LUNIT, 9000 ) C C... READ IN ENTRY NUMBER CALL FLUSH (LUNIT) READ ( KUNIT, *, ERR=105 ) IENTRY C C... CHECK FOR A LEGAL ENTRY AND GO PROCESS IF IT IS LEGAL. IF ( IENTRY .GE. 1 .AND. IENTRY .LE. IEMAX ) GO TO 0110 C C... PRINT ILLEGAL ENTRY MESSAGE AND GO GET ENTRY AGAIN. 0105 WRITE ( LUNIT, 9900 ) GO TO 0100 C C... PROCESS A LEGAL ENTRY. 0110 CONTINUE GO TO ( 9999, 0100, 1000, 2000, 3000, 4000 ), IENTRY C C----------------------------------------------------------- C C PLOT OPTIONS MENU C C C... PRINT THE LIST OF OPTIONS. 1000 CONTINUE WRITE ( LUNIT, 9100 ) * NCOPY, PRECIS, IFONT, INITFF, * IEOP(1), IEOP(2), IEOP(3), IEOP(4), IEOJ C C... INITIALIZE ROTATE FLAG AND STRIPPING FLAG IROT = 0 IF (ROT90) IROT = -1 IVSTRP = 0 IF (VSTRP) IVSTRP = -1 WRITE ( LUNIT, 9110 ) * UNITS, IROT, SCALE, XFACT, * YFACT, XSTART, YSTART, IJPEN, * ISPACE, IFFAP, LASTFF, MODE1, IVSTRP C C... READ IN ENTRY NUMBER CALL FLUSH (LUNIT) READ ( KUNIT, *, ERR=1010 ) IENTRY C C... CHECK FOR A LEGAL ENTRY AND GO PROCESS IF IT IS LEGAL. IF ( IENTRY .GE. 1 .AND. IENTRY .LE. 25 ) GO TO 1020 C C... PRINT ILLEGAL ENTRY MESSAGE AND GO GET ENTRY AGAIN. 1010 CONTINUE WRITE ( LUNIT, 9900 ) GO TO 1000 C C... PROCESS THE EXIT OR LIST OPTIONS. 1020 CONTINUE IF ( IENTRY .EQ. 1 ) GO TO 0100 IF ( IENTRY .EQ. 2 ) GO TO 1000 C C... CHECK FOR NOT SUPPORTED FUNCTIONS HERE IF ( IENTRY .EQ. 12 ) GO TO 1999 C C... READ IN A NEW VALUE FOR THE OTHER MENU ITEMS. 1025 WRITE ( LUNIT, 9010 ) CALL FLUSH (LUNIT) READ ( KUNIT, *, ERR=1025 ) VALUE IVALUE = IFIX ( VALUE ) C C... GO PROCESS THE ITEM WITH ITS NEW VALUE. GO TO ( 0100, 1000, 1030, 1050, 1060, 1070, 1080, * 1090, 1100, 1110, 1120, 1130, 1140, 1150, 1160, * 1170, 1180, 1190, 1200, 1210, 1220, 1230, * 1240, 1250, 1260 ), IENTRY C C... NUMBER OF COPIES. 1030 CONTINUE IF ( IVALUE .LE. 0 ) GO TO 1010 NCOPY = IVALUE GO TO 1000 C C... COORDINATE PRECISION, 16 OR 32 BIT. 1050 CONTINUE IF ( IVALUE .NE. 16 .AND. IVALUE .NE. 32 ) GO TO 1010 PRECIS = IVALUE GO TO 1000 C C... FONT PATTERN NUMBER. 1060 CONTINUE IF ( IVALUE .LT. 0 .OR. IVALUE .GT. 19 ) GO TO 1010 IFONT = IVALUE GO TO 1000 C C... INITIAL FORM-FEED FLAG. 1070 CONTINUE INITFF = 0 IF (IVALUE .NE. 0) INITFF = -1 GO TO 1000 C C... END-OF-PLOT IPEN CODE (DEFAULT = +999). 1080 CONTINUE IEOP(1) = IVALUE GO TO 1000 C C... END-OF-PLOT IPEN CODE (DEFAULT = -999). 1090 CONTINUE IEOP(2) = IVALUE GO TO 1000 C C... END-OF-PLOT IPEN CODE (DEFAULT = +23). 1100 CONTINUE IEOP(3) = IVALUE GO TO 1000 C C... END-OF-PLOT IPEN CODE (DEFAULT = -23). 1110 CONTINUE IEOP(4) = IVALUE GO TO 1000 C C... END-OF-JOB IPEN CODE (DEFAULT = +999). 1120 CONTINUE IEOJ = IVALUE GO TO 1000 C C... PLOT HEADER FLAG - NOT SUPPORTED 1130 CONTINUE GO TO 1000 C C... UNITS PER INCH. 1140 CONTINUE IF ( VALUE .LE. 0.0 ) GO TO 1010 UNITS = VALUE C C... UPDATE PAPER/VIEWPORT/WINDOW DIMENSIONS 1145 DOTS = (RDEN * SCALE) / UNITS XDEN = DOTS * XFACT YDEN = DOTS * YFACT FNIBS = FLOAT (IBYTES*8) - 1.0 PXMAX = FNIBS/XDEN PYMAX = FNIBS/YDEN VXMAX = PXMAX VYMAX = PYMAX WXMAX = PXMAX WYMAX = PYMAX PXMIN = 0.0 PYMIN = 0.0 VXMIN = 0.0 VYMIN = 0.0 WXMIN = 0.0 WYMIN = 0.0 GO TO 1000 C C... PLOT ROTATION FLAG. 1150 CONTINUE ROT90 = .TRUE. IF ( IVALUE .EQ. 0 ) ROT90 = .FALSE. GO TO 1000 C C... DRAWING SCALE FACTOR. 1160 CONTINUE IF ( VALUE .LE. 0.0 ) GO TO 1010 SCALE = VALUE GO TO 1145 C C... X SCALING FACTOR. 1170 CONTINUE IF ( VALUE .LE. 0.0 ) GO TO 1010 XFACT = VALUE GO TO 1145 C C... Y SCALING FACTOR. 1180 CONTINUE IF ( VALUE .LE. 0.0 ) GO TO 1010 YFACT = VALUE GO TO 1145 C C... STARTING X COORDINATE. 1190 CONTINUE XSTART = VALUE GO TO 1000 C C... STARTING Y COORDINATE. 1200 CONTINUE YSTART = VALUE GO TO 1000 C C... CURRENT PEN. 1210 CONTINUE IF ( IVALUE .LT. 0 .OR. IVALUE .GT. MXPEN ) GO TO 1010 IJPEN = IVALUE GO TO 1000 C C... SPACE BETWEEN COPIES. 1220 IF ( IVALUE .LT. -1 ) GO TO 1010 ISPACE = IVALUE GO TO 1000 C C... FORM FEED OR SPACE AFTER EACH PLOT. 1230 IF ( IVALUE .LT. -1 ) GO TO 1010 IFFAP = IVALUE GO TO 1000 C C... FORM FEED AFTER FINAL PLOT. 1240 LASTFF = 0 IF ( IVALUE .NE. 0) LASTFF = -1 GO TO 1000 C C... INVOKE VRF OUTPUT FLAG 1250 CONTINUE IF ( IVALUE .LT. 0 .OR. IVALUE .GT. 2 ) GO TO 1010 MODE1 = IVALUE GO TO 1000 C C... STRIPPING FLAG. 1260 CONTINUE VSTRP = .TRUE. IF ( IVALUE .EQ. 0 ) VSTRP = .FALSE. GO TO 1000 C C... NOT SUPPORTED OPTIONS 1999 WRITE (LUNIT, 9902) GO TO 1000 C C----------------------------------------------------------- C C PLOTTER/CONTROLLER OPTIONS MENU C C C... PRINT THE LIST OF OPTIONS. 2000 CONTINUE WRITE ( LUNIT, 9200 ) * MODEL, RDEN, IBYTES, ISFLAG, ISPEED, KREP, * IDISK, INHNCE, INVERS, MIRROR, IRDT WRITE ( LUNIT, 9205 ) * MUXOUT, PMSIZE, MTAPE, JSORT, JCPCMD, JCUT, KDISK C C... READ IN ENTRY NUMBER CALL FLUSH (LUNIT) READ ( KUNIT, *, ERR=2010 ) IENTRY C C... CHECK FOR A LEGAL ENTRY AND GO PROCESS IF IT IS LEGAL. IF ( IENTRY .GE. 1 .AND. IENTRY .LE. 24 ) GO TO 2020 C C... PRINT ILLEGAL ENTRY MESSAGE AND GO GET THE ENTRY AGAIN. 2010 CONTINUE WRITE ( LUNIT, 9900 ) GO TO 2000 C C... PROCESS THE EXIT OR LIST OPTIONS. 2020 CONTINUE IF ( IENTRY .EQ. 1 ) GO TO 0100 IF ( IENTRY .EQ. 2 ) GO TO 2000 C C... PROCESS THE CONTROL ARRAY OPTION IF ( IENTRY .EQ. 24 ) GO TO 2260 C C... CHECK FOR NOT SUPPORTED OPTIONS IF ( IENTRY .EQ. 10 .OR. IENTRY .EQ. 15 .OR. * IENTRY .EQ. 21) GO TO 2999 C C... READ IN A NEW VALUE FOR THE MENU ITEM. 2025 WRITE ( LUNIT, 9010 ) CALL FLUSH (LUNIT) READ ( KUNIT, *, ERR=2025 ) VALUE IVALUE = IFIX ( VALUE ) C C... GO PROCESS THE ITEM WITH ITS NEW VALUE. GO TO ( 0100, 2000, 2030, 2060, 2070, * 2080, 2090, 2100, 2110, 2120, 2130, * 2140, 2150, 2160, 2170, 2180, 2190, * 2200, 2210, 2220, 2230, 2240, 2250, 2260 ), IENTRY C C... PLOTTER MODEL NUMBER. 2030 CONTINUE C C... CHECK FOR A VALID MODEL NUMBER. DO 2040 IA=1,NMODL MODNUM = IA IF ( MODL(IA) .EQ. IVALUE ) GO TO 2050 2040 CONTINUE C C... REPORT AN ILLEGAL ENTRY FOR THE MODEL NUMBER. GO TO 2010 C C... MODEL NUMBER OK, ASSIGN MODEL, DENSITY, AND SCAN SIZE. 2050 CONTINUE MODEL = IVALUE RDEN = RDENS(MODNUM) IF (RDEN .EQ. 400.0) INHNCE = 0 IBYTES = JBYTES(MODNUM) GO TO 2075 C C... PLOTTER PRINT NIB DENSITY, NIBS PER INCH. 2060 CONTINUE IF ( VALUE .LE. 0.0 ) GO TO 2010 RDEN = VALUE GO TO 2075 C C... PLOTTER SCAN LINE WIDTH, IN BYTES. 2070 CONTINUE IF ( IVALUE .LE. 0 ) GO TO 2010 IBYTES = IVALUE C C... UPDATE PAPER/VIEWPORT/WINDOW DIMENSIONS 2075 DOTS = (RDEN * SCALE) / UNITS XDEN = DOTS * XFACT YDEN = DOTS * XFACT FNIBS = FLOAT (IBYTES*8) - 1.0 PXMAX = FNIBS/XDEN PYMAX = FNIBS/YDEN VXMAX = PXMAX VYMAX = PYMAX WXMAX = PXMAX WYMAX = PYMAX PXMIN = 0.0 PYMIN = 0.0 VXMIN = 0.0 VYMIN = 0.0 WXMIN = 0.0 WYMIN = 0.0 GO TO 2000 C C... SPEED CONTROL FLAG. 2080 CONTINUE ISFLAG = IVALUE IF (ISFLAG .EQ. 0) GO TO 2000 ISFLAG = -1 C C... ALSO UPDATE THE SPEED VALUE. WRITE ( LUNIT, 9210 ) CALL FLUSH (LUNIT) READ ( KUNIT, *, ERR=2090 ) IVALUE C C... SPEED CONTROL VALUE. 2090 CONTINUE IF (IVALUE .LT. -1 .OR. IVALUE .GT. 4) GO TO 2010 ISFLAG = -1 ISPEED = IVALUE GO TO 2000 C C... OUTPUT DEVICE TYPE REP, TAPE, OR RPM SERIES 2100 CONTINUE IF (IVALUE .NE. 0 .AND. IVALUE .NE. 1 * .AND. IVALUE .NE. 4) GO TO 2010 KREP = IVALUE C C... CHECK IF RPM SPECIFIED IF (KREP .EQ. 1) GO TO 2000 C C... TELL USER PMSIZE = 0.0 IF (PMSIZE .EQ. 0.0) WRITE (LUNIT,9504) GO TO 2000 C C... DISK CONTROLLER FLAG. 2110 CONTINUE IF (IVALUE .LT. 0 .OR. IVALUE .GT. 3) GO TO 2010 IDISK = IVALUE GO TO 2000 C C... SCANS PER BAND, NOT SUPPORTED 2120 GO TO 2000 C C... LINE ENHANCE. 2130 IF (RDEN .EQ. 400.0) GO TO 2135 INHNCE = 0 IF (IVALUE .NE. 0) INHNCE = -1 GO TO 2000 2135 INHNCE = 0 WRITE (LUNIT,9250) GO TO 2000 C C... INVERSE IMAGE PLOTTING. 2140 INVERS = 0 IF (IVALUE .NE. 0) INVERS = -1 GO TO 2000 C C... MIRROR IMAGE PLOTTING. 2150 MIRROR = 0 IF (IVALUE .NE. 0) MIRROR = -1 GO TO 2000 C C... RASTER DATA TRANSLATION. 2160 IRDT = 0 IF (IVALUE .NE. 0) IRDT = -1 GO TO 2000 C C... OUTPUT MODE, NOT SUPPORTED 2170 GO TO 2000 C C... PLOTTER DEVICE NUMBER 2180 IF (IVALUE .LT. 0 .OR. IVALUE .GT. 3) GO TO 2010 MUXOUT = IVALUE GO TO 2000 C C... RPM MEMORY SIZE IN MEGABYTES 2190 IF (VALUE .LE. 0.0) GO TO 2010 PMSIZE = VALUE GO TO 2000 C C... MAG TAPE OUTPUT 2200 IF (IVALUE .LT. 0 .OR. IVALUE .GT. 2) GO TO 2010 MTAPE = IVALUE GO TO 2000 C C... PARTITION FLAG 2210 IF (IVALUE .LT. 0 .OR. IVALUE .GT. 2) GO TO 2010 JSORT = IVALUE GO TO 2000 C C... COPY COMMAND FLAG 2220 IF (IVALUE .NE. 0 .AND. IVALUE .NE. 1) GO TO 2010 JCPCMD = IVALUE GO TO 2000 C C... BYTES/RASTER BUFFER, NOT SUPPORTED 2230 GO TO 2000 C C... PAPER CUT FLAG 2240 IF (IVALUE .LT. -1 .OR. IVALUE .GT. 1) GO TO 2010 JCUT = IVALUE GO TO 2000 C C... RPM DISK USE FLAG 2250 IF (IVALUE .LT. 0 .OR. IVALUE .GT. 2) GO TO 2010 KDISK = IVALUE GO TO 2000 C C... CONTROLLER CONTROL ARRAY MENU C C... GET INDEX OF WORD TO MODIFY 2260 WRITE ( LUNIT, 9501 ) CALL FLUSH (LUNIT) READ ( KUNIT, *, ERR=2260 ) IVALUE C C... CHECK RANGE OF INDEX IF ( IVALUE .GE. 1 .AND. IVALUE .LE. (IPRISM(1)-5) ) GO TO 2265 C C... CHECK IF DONE IF ( IVALUE .EQ. 0 ) GO TO 2000 C C... ILLEGAL VALUE TELL USER WRITE (LUNIT, 9900 ) GO TO 2260 C 2265 INDX = IVALUE + 6 C C... DISPLAY CURRENT VALUE WRITE ( LUNIT, 9502 ) IPRISM(INDX) C C... GET NEW VALUE 2266 WRITE (LUNIT, 9503 ) CALL FLUSH (LUNIT) READ ( KUNIT, *, ERR=2266 ) IVALUE C C... UPDATE CONTROL ARRAY IPRISM(INDX) = IVALUE GO TO 2260 C C C... NOT SUPPORTED OPTIONS MESSAGE 2999 WRITE (LUNIT, 9902) GO TO 2000 C C----------------------------------------------------------- C C VIEWING OPTIONS MENU C C C... PRINT THE LIST OF OPTIONS. 3000 CONTINUE WRITE ( LUNIT, 9300 ) * PXMIN, PYMIN, PXMAX, PYMAX, * VXMIN, VYMIN, VXMAX, VYMAX, * WXMIN, WYMIN, WXMAX, WYMAX C C... READ IN ENTRY NUMBER CALL FLUSH (LUNIT) READ ( KUNIT, *, ERR=3010 ) IENTRY C C... CHECK FOR A LEGAL ENTRY AND GO PROCESS IF IT IS LEGAL. IF ( IENTRY .GE. 1 .AND. IENTRY .LE. 14 ) GO TO 3020 C C... PRINT ILLEGAL ENTRY MESSAGE AND GO GET THE ENTRY AGAIN. 3010 CONTINUE WRITE ( LUNIT, 9900 ) GO TO 3000 C C... PROCESS THE EXIT OR LIST OPTIONS. 3020 CONTINUE IF ( IENTRY .EQ. 1 ) GO TO 0100 IF ( IENTRY .EQ. 2 ) GO TO 3000 C C... READ IN A NEW VALUE FOR THE MENU ITEM. 3025 WRITE ( LUNIT, 9010 ) CALL FLUSH (LUNIT) READ ( KUNIT, *, ERR=3025 ) VALUE IVALUE = IFIX ( VALUE ) C C... GO PROCESS THE ITEM WITH ITS NEW VALUE. GO TO ( 0100, 3000, 3030, 3040, 3050, 3060, * 3070, 3080, 3090, 3100, 3110, 3120, * 3130, 3140 ), IENTRY C C... MINIMUM PAPER X DIMENSION. 3030 CONTINUE IF ( VALUE .LT. 0.0 ) GO TO 3010 PXMIN = VALUE C C... UPDATE VIEWPORT/WINDOW DIMENSIONS VXMIN = PXMIN WXMIN = PXMIN GO TO 3000 C C... MINIMUM PAPER Y DIMENSION. 3040 CONTINUE IF ( VALUE .LT. 0.0 ) GO TO 3010 PYMIN = VALUE C C... UPDATE VIEWPORT/WINDOW DIMENSIONS VYMIN = PYMIN WYMIN = PYMIN GO TO 3000 C C... MAXIMUM PAPER X DIMENSION. 3050 CONTINUE IF ( VALUE .LT. 0.0 ) GO TO 3010 PXMAX = VALUE C C... UPDATE VIEWPORT/WINDOW DIMENSIONS VXMAX = PXMAX WXMAX = PXMAX GO TO 3000 C C... MAXIMUM PAPER Y DIMENSION. 3060 CONTINUE IF ( VALUE .LT. 0.0 ) GO TO 3010 PYMAX = VALUE C C... UPDATE VIEWPORT/WINDOW DIMENSIONS VYMAX = PYMAX WYMAX = PYMAX GO TO 3000 C C... VIEWPORT MINIMUM X DIMENSION. 3070 CONTINUE IF ( VALUE .LT. 0.0 ) GO TO 3010 VXMIN = VALUE GO TO 3000 C C... VIEWPORT MINIMUM Y DIMENSION. 3080 CONTINUE IF ( VALUE .LT. 0.0 ) GO TO 3010 VYMIN = VALUE GO TO 3000 C C... VIEWPORT MAXIMUM X DIMENSION. 3090 CONTINUE IF ( VALUE .LT. 0.0 ) GO TO 3010 VXMAX = VALUE GO TO 3000 C C... VIEWPORT MAXIMUM Y DIMENSION. 3100 CONTINUE IF ( VALUE .LT. 0.0 ) GO TO 3010 VYMAX = VALUE GO TO 3000 C C... CLIPPING MINIMUM X DIMENSION. 3110 CONTINUE WXMIN = VALUE GO TO 3000 C C... CLIPPING MINIMUM Y DIMENSION. 3120 CONTINUE WYMIN = VALUE GO TO 3000 C C... CLIPPING MAXIMUM X DIMENSION. 3130 CONTINUE WXMAX = VALUE GO TO 3000 C C... CLIPPING MAXIMUM Y DIMENSION. 3140 CONTINUE WYMAX = VALUE GO TO 3000 C C----------------------------------------------------------- C C COLOR MENU C C C... PRINT THE LIST OF OPTIONS. 4000 CONTINUE WRITE ( LUNIT, 9400 ) * IVCFLG,LTNCLR,LTNFLG,ITNSEQ(1),ITNSEQ(2),ITNSEQ(3),ITNSEQ(4) C C... READ IN ENTRY NUMBER CALL FLUSH (LUNIT) READ ( KUNIT, *, ERR=4010 ) IENTRY C C... CHECK FOR A LEGAL ENTRY AND GO PROCESS IF IT IS LEGAL. IF ( IENTRY .GE. 1 .AND. IENTRY .LE. 7 ) GO TO 4020 C C... PRINT ILLEGAL ENTRY MESSAGE AND GO GET ENTRY AGAIN. 4010 CONTINUE WRITE ( LUNIT, 9900 ) GO TO 4000 C C... PROCESS THE EXIT OR LIST OPTIONS. 4020 CONTINUE IF ( IENTRY .EQ. 1 ) GO TO 0100 IF ( IENTRY .EQ. 2 ) GO TO 4000 C C... PROCESS THE TONING SEQUENCE SUB-MENU SEPARATELY. IF ( IENTRY .EQ. 6 ) GO TO 4040 C C... PROCESS THE PEN DEFINITION SUB-MENU SEPARATELY. IF ( IENTRY .EQ. 7 ) GO TO 4130 C C... READ IN A NEW VALUE FOR THE OTHER MENU ITEMS. 4025 WRITE ( LUNIT, 9010 ) CALL FLUSH (LUNIT) READ ( KUNIT, *, ERR=4025 ) VALUE IVALUE = IFIX ( VALUE ) C C... GO PROCESS THE ITEM WITH ITS NEW VALUE. GO TO ( 0100, 4000, 4030, 4120, 4110, 4040 ), IENTRY C C... COLOR PLOTTING FLAG. 4030 CONTINUE IVCFLG = 0 IF (IVALUE .NE. 0) IVCFLG = -1 IF ( IVCFLG .NE. 0 ) GO TO 4055 GO TO 4045 C C... COLOR TONING SEQUENCE. 4040 CONTINUE WRITE ( LUNIT, 9410 ) * NCPASS, ( ITNSEQ(IA), IA=1,4 ) WRITE ( LUNIT, 9420 ) CALL FLUSH (LUNIT) READ ( KUNIT, *, ERR=4100 ) IVALUE IF ( IVALUE .GT. 4 ) GO TO 4100 NPASS = IVALUE C C... BLACK AND WHITE PLOTTING ONLY. IF ( NPASS .GE. 0 ) GO TO 4050 4045 NCPASS = 1 ITNSEQ(1) = 1 ITNSEQ(2) = 0 ITNSEQ(3) = 0 ITNSEQ(4) = 0 IVCFLG = 0 INITFF = -1 LASTFF = -1 MODEL = BMODEL RDEN = BDEN IBYTES = BBYTES GO TO 4085 C C... DEFAULT TONING SEQUENCE. 4050 CONTINUE IF ( NPASS .NE. 0 ) GO TO 4060 C C... SET DEFAULT 4 PASS COLOR 4055 NCPASS = 4 ITNSEQ(1) = 1 ITNSEQ(2) = 2 ITNSEQ(3) = 3 ITNSEQ(4) = 4 GO TO 4075 C C... USER DEFINED TONING SEQUENCE. 4060 CONTINUE NCPASS = NPASS DO 4070 IA=1,NCPASS WRITE ( LUNIT, 9430 ) IA CALL FLUSH (LUNIT) READ ( KUNIT, *, ERR=4090 ) IVALUE IF ( IVALUE .LT. 1 .OR. IVALUE .GT. 4 ) GO TO 4090 ITNSEQ(IA) = IVALUE 4070 CONTINUE 4075 IVCFLG = -1 INITFF = 0 LASTFF = 0 IBYTES = CBYTES RDEN = CDEN MODEL = CMODEL IF ( NCPASS .GE. 4 ) GO TO 4085 I = NCPASS+1 DO 4080 IA = I,4 ITNSEQ(IA) = 0 4080 CONTINUE C C... UPDATE PAPER/VIEWPORT/WINDOW DIMENSIONS 4085 DOTS = (RDEN * SCALE) / UNITS XDEN = DOTS * XFACT YDEN = DOTS * XFACT FNIBS = FLOAT (IBYTES*8) - 1.0 PXMAX = FNIBS/XDEN PYMAX = FNIBS/YDEN VXMAX = PXMAX VYMAX = PYMAX WXMAX = PXMAX WYMAX = PYMAX PXMIN = 0.0 PYMIN = 0.0 VXMIN = 0.0 VYMIN = 0.0 WXMIN = 0.0 WYMIN = 0.0 GO TO 4000 C C... PROCESS AN ILLEGAL OR INVALID TONER NUMBER. 4090 CONTINUE WRITE ( LUNIT, 9900 ) GO TO 4060 C C... PROCESS AN ILLEGAL OR INVALID NUMBER OF TONERS. 4100 CONTINUE WRITE ( LUNIT, 9900 ) GO TO 4040 C C... COLOR TONING OR HATCH PATTERNING FLAG. 4110 CONTINUE IF ( IVALUE .NE. 0 .AND. IVCFLG .EQ. 0) GO TO 4010 LTNFLG = 0 IF (IVALUE .NE. 0) LTNFLG = -1 GO TO 4000 C C... TONE COLOR. 4120 CONTINUE IF ( IVALUE .LT. 1 .OR. IVALUE .GT. ICLMAX) GO TO 4010 LTNCLR = IVALUE GO TO 4000 C C... DEFINE THE PENS. C C... GET THE PEN NUMBER. 4130 CONTINUE WRITE ( LUNIT, 9440 ) MXPEN WRITE ( LUNIT, 9130 ) CALL FLUSH (LUNIT) READ ( KUNIT, *, ERR=4140 ) IVALUE IF ( IVALUE .EQ. -1 ) GO TO 4000 IF ( IVALUE .LT. 0 .OR. IVALUE .GT. MXPEN ) GO TO 4140 NUMPEN = IVALUE + 1 C C... PRINT THE CURRENT VALUES FOR THIS PEN WRITE ( LUNIT, 9445 ) IVALUE,PENTBL(NUMPEN,1),PENTBL(NUMPEN,2) GO TO 4150 C C... PROCESS AN ILLEGAL OR INVALID PEN NUMBER. 4140 CONTINUE WRITE ( LUNIT, 9900 ) GO TO 4130 C C... GET THE PEN COLOR. 4150 CONTINUE WRITE ( LUNIT, 9450 ) CALL FLUSH (LUNIT) READ ( KUNIT, *, ERR=4160 ) IVALUE IF ( IVALUE .LT. 1 .OR. IVALUE .GT. 8 ) GO TO 4160 PENTBL(NUMPEN,1) = IVALUE GO TO 4170 C C... PROCESS AN ILLEGAL OR INVALID PEN COLOR. 4160 CONTINUE WRITE ( LUNIT, 9900 ) GO TO 4150 C C... GET THE PEN WIDTH. 4170 CONTINUE WRITE ( LUNIT, 9140 ) CALL FLUSH (LUNIT) READ ( KUNIT, *, ERR=4180 ) IVALUE ITMP = MAXPEN IF ( KREP .EQ. 1) ITMP = 14 IF ( IVALUE .LT. 0 .OR. IVALUE .GT. ITMP ) GO TO 4180 PENTBL(NUMPEN,2) = IVALUE GO TO 4130 C C... PROCESS AN ILLEGAL OR INVALID PEN WIDTH. 4180 CONTINUE WRITE ( LUNIT, 9900 ) GO TO 4170 C 9999 CONTINUE RETURN END