C C THIS FILE CONTAINS THE GRAPHICS DEVICE SPECIFIC CODE. C C THE FOLLOWING ROUTINES TYPICALY NEED TO BE MODIFIED WHEN C ADDING A NEW DEVICE DRIVER: C C 1. GRCLDE - CLOSE THE DEVICE C 2. GRDRLI - DRAW A LINE BETWEEN TWO POINTS C 3. GRDRPM - DRAW A HORIZONTAL POLYMARKER C 4. GRDRPL - DRAW A POLYLINE C 5. GRERSC - ERASE THE SCREEN C 6. GREXIT - SHUT DOWN A DEVICE BEFORE EXITING DATAPLOT C 7. GRFIRE - FILL A POLYGONAL REGION C 8. GRINDE - INITIALIZE THE GRAPHICS DEVICE. C 9. GRMOBE - PERFORM A MOVE C 10. GROPDE - OPEN THE GRAPHICS DEVICE C 11. GRRESC - READ THE SCREEN COORDINATES C 12. GRSAGR - IMPLEMENT SAVE PLOT, REPEAT PLOT, CYCLE PLOT C 13. GRSECO - SET THE COLOR C 14. GRSEPA - SET THE PATTERN (I.E., LINE TYPE, FILL TYPE, ETC.) C 15. GRSEPP - SET THE PICTURE POINTS FOR THE DEVICE C 16. GRSESI - SET THE TEXT SIZE C 17. GRSETH - SET THE LINE THICKNESS C 18. GRTRCO - TRANSLATE THE COLOR C 19. GRTRPA - TRANSLATE THE LINE OR FILL PATTERN C 20. GRTRSI - TRANSLATE THE TEXT SIZE C 21. GRTTHI - TRANSLATE THE LINE THICKNESS C 22. GRWRTH - WRITE A HORIZONTAL TEXT STRING C 23. GRWRTV - WRITE A VERTICAL TEXT STRING C C THE FOLLOWING CODES TYPICALLY DO NOT REQUIRE UPDATING FOR C A NEW GRAPHICS DEVICE (ALTHOUGH YOU MAY WANT TO ADD A C PLACEHOLDER). C C 1. GRCOSC - COPY THE SCREEN (BASICALLY OBSOLETE, PREVIOUSLY C SUPPORTED OLD TEKTRONIX HARD COPY UNITS) C 2. GRDETH - DETERMINE LENGTH OF HORIZONTAL TEXT STRING C 3. GRDETV - DETERMINE LENGTH OF VERTICAL TEXT STRING C 4. GRRIBE - RING THE BELL C 5. GRSECA - SET THE TEXT CASE (LOWER/UPPER) C 6. GRSEDI - SET THE TEXT DIRECTION C 7. GRSEFI - SET THE FILL SPECIFICATION C 8. GRSEFO - SET THE TEXT FONT C 9. GRSEJU - SET THE TEXT JUSTIFICATION C 10. GRSEMO - SET THE DEVICE MODE (GRAPHICS/DIALOGUE) C 11. GRTRCA - TRANSLATE THE TEXT CASE (LOWER/UPPER) C 12. GRTRDI - TRANSLATE THE TEXT DIRECTION C 13. GRTRFI - TRANSLATE THE FILL SPECIFICATION C 14. GRTRFO - TRANSLATE THE TEXT FONT C 15. GRTRJU - TRANSLATE THE TEXT JUSTIFICATION C C C NOTE THAT SOME DRIVERS ARE NOT AVAILBLE ON ALL PLATFORMS. THERE C ARE TWO WAYS THAT WE ADDRESS THIS. C C 1. WE PROVIDE AN INTERMEDIATE LIBRARY. ON UNSUPPORTED SYSTEMS, C A DUMMY VERSION OF THIS LIBRARY IS COMPILED. C C THIS APPROACH IS CURRENTLY USED FOR C C a. X11 (x11_src.c is active, x11_src.f is a dummy version) C b. GD (for PNG and JPEG) (gd_src.c is active, gd_src.f is a C dummy version) C c. AQUA (for Mac OSX) (aqua_src.c is active, aqua_src.f is a C dummy version) C C 2. LINES THAT WOULD CAUSE A COMPILATION ERROR ARE COMMENTED C OUT USING A SPECIAL PREFIX. FOR A SUPPORTED SYSTEM, A QUICK C GLOBAL CHANGE CAN BE IMPLEMENTED TO ACTIVATE THE CODE. C C THIS APPROACH IS USED IN THE FOLLOWING CASES C C FOR THE COMPAQ 6.x WINDOWS COMPILER, DO THE FOLLOWING: C C 1. COPY DP38.FOR TO DP38_QWIN.FOR C 2. MAKE THE FOLLOWING EDITS IN DP38_QWIN.FOR: C A. GLOBAL CHANGE OF "CQWIN" TO " " C B. GLOBAL CHANGE OF "CQWVF" TO " " C C FOR THE INTEL 9.x WINDOWS COMPILER (THE SUCCESSOR TO THE C COMPAQ VISUAL FORTRAN), DO THE FOLLOWING: C C 1. COPY DP38.FOR TO DP38_INTEL.FOR C 2. MAKE THE FOLLOWING EDITS IN DP38_INTEL.FOR: C A. GLOBAL CHANGE OF "CIVFO" TO " " C B. GLOBAL CHANGE OF "CQWVF" TO " " C SUBROUTINE GRCLDE C C PURPOSE--CLOSE A SPECIFIC GRAPHICS DEVICE C THAT IS, TURN OFF A DEVICE WHICH IS C CURRENTLY ON. C C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-921-3651 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--83.6 C ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY 1983. C UPDATED --JANUARY 1989. SUN (BY BILL ANDERSON) C DRIVER OBSOLETE C UPDATED --JANUARY 1989. POSTSCRIPT (BY ALAN HECKERT) C UPDATED --JANUARY 1989. CGM (BY ALAN HECKERT) C UPDATED --JANUARY 1989. QMS QUIC (BY ALAN HECKERT) C UPDATED --JANUARY 1989. CALCOMP (BY ALAN HECKERT) C UPDATED --JANUARY 1989. ZETA (BY ALAN HECKERT) C UPDATED --MARCH 1990. X11 (BY ALAN HECKERT) C UPDATED --MAY 1991. RENUMBER TOP BRANCHES (JJF) C UPDATED --MAY 1991. VGA/TURBOC DRIVER (JJF) C DRIVER OBSOLETE C UPDATED --JULY 1996. LAHEY DRIVER (ALAN HECKERT) C OLD STYLE CALCOMP C DRIVER OBSOLETE C UPDATED --OCTOBER 1996. QUICKWIN DRIVER (ALAN) C UPDATED --OCTOBER 1996. OPENGL DRIVER (ALAN) C USE BILL MITCHELLS OPENGL C BINDING FOR FORTRAN C UPDATED --OCTOBER 1996. GKS (ALAN) C CODED, NOT TESTED C UPDATED --OCTOBER 1996. BINARY CGM (ALAN) C PLACEHOLDER FOR NOW C UPDATED --OCTOBER 1996. DISPLAY POSTSCRIPT (ALAN) C PLACEHOLDER FOR NOW C UPDATED --OCTOBER 1997. LAHEY INTERACTOR (ALAN) C UPDATED --JULY 1998. LAHEY WINTERACTOR C UPDATED --JUNE 2000. GD (FOR JPEG, PNG, WINDOWS BMP) C UPDATED --JUNE 2000. MACINTOSH C PLACEHOLDER FOR NOW C UPDATED --JUNE 2000. PC PRINTER C PLACEHOLDER FOR NOW C UPDATED --MARCH 2002. LATEX (USING EEPIC) C PLACEHOLDER FOR NOW C UPDATED --MARCH 2002. SVG (SCALABLE VECTOR GRAPHICS) C UPDATED --MARCH 2005. SUPPORT FOR AQUATERM C UPDATED --FEBRUARY 2006. IMPLEMENT LATEX DRIVER C C-----NON-COMMON VARIABLES (GRAPHICS)------------------------------------------- C CWINT USE WINTERACTER CINTE USE INTERACTER CQWIN USE DFLIB CIVFO USE IFQWIN C CHARACTER*130 ICSTR CHARACTER*130 IATEMP CHARACTER*4 ISUBN0 CCCCC CHARACTER*1 IQUOTE CCCCC CHARACTER*1 ICARAT CHARACTER*1 IA C CHARACTER*80 IFILE1 CHARACTER*12 ISTAT1 CHARACTER*12 IFORM1 CHARACTER*12 IACCE1 CHARACTER*12 IPROT1 CHARACTER*12 ICURS1 CHARACTER*4 IENDF1 CHARACTER*4 IREWI1 CHARACTER*4 IERRF1 C C-----COMMON---------------------------------------------------------- C INCLUDE 'DPCOGR.INC' INCLUDE 'DPCONP.INC' INCLUDE 'DPCOBE.INC' INCLUDE 'DPCODV.INC' INCLUDE 'DPCOST.INC' INCLUDE 'DPCOF2.INC' CCCCC INCLUDE 'DPCOFO.INC' C C-----COMMON VARIABLES (GENERAL)-------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C EXTERNAL XCLEAR C C-----START POINT----------------------------------------------------- C ISUBN0='CLDE' C NCSTR=(-999) C IERRG4='NO' C IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'CLDE')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF GRCLDE--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)IMANUF,IMODEL,IMODE2,IMODE3 52 FORMAT('IMANUF,IMODEL,IMODE2,IMODE3 = ',A4,2X,A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)IGUNIT,IGCODE 53 FORMAT('IGUNIT,IGCODE = ',I8,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,54)ISOFT,ISOFT2,ISOFT3 54 FORMAT('ISOFT,ISOFT2,ISOFT3 = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,55)IGBAUD 55 FORMAT('IGBAUD = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,56)IBUGG4,ISUBG4,IERRG4 56 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,61)IPPDE1,IPPDE2 61 FORMAT('IPPDE1,IPPDE2 = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,62)NCPOST 62 FORMAT('NCPOST = ',I8) CALL DPWRST('XXX','BUG ') IF(NCPOST.LE.0)GOTO65 DO63I=1,NCPOST WRITE(ICOUT,64)I,ICPOST(I:I) 64 FORMAT('I,ICPOST(I:I) = ',I8,2X,A1,4X) CALL DPWRST('XXX','BUG ') 63 CONTINUE 65 CONTINUE 90 CONTINUE C C ******************************************** C ** STEP 1-- ** C ** BRANCH ACCORDING TO THE MANUFACTURER ** C ** AND THE MODEL ** C ******************************************** C IF(IMANUF.EQ.'TEKT')GOTO1005 IF(IMANUF.EQ.'HP')GOTO1010 IF(IMANUF.EQ.'PCL')GOTO1015 IF(IMANUF.EQ.'GENE')GOTO1020 IF(IMANUF.EQ.'CALC')GOTO1025 IF(IMANUF.EQ.'ZETA')GOTO1030 IF(IMANUF.EQ.'RAMT')GOTO1035 IF(IMANUF.EQ.'SUN ')GOTO1040 IF(IMANUF.EQ.'XXXX')GOTO1045 IF(IMANUF.EQ.'REGI')GOTO1050 IF(IMANUF.EQ.'POST')GOTO1055 IF(IMANUF.EQ.'QUIC')GOTO1060 IF(IMANUF.EQ.'X11 ')GOTO1065 IF(IMANUF.EQ.'TURB')GOTO1070 IF(IMANUF.EQ.'GKS ')GOTO1075 IF(IMANUF.EQ.'LAHE')GOTO1080 IF(IMANUF.EQ.'GD ')GOTO1085 IF(IMANUF.EQ.'QWIN')GOTO1090 IF(IMANUF.EQ.'AQUA')GOTO1091 IF(IMANUF.EQ.'OPGL')GOTO1095 IF(IMANUF.EQ.'PRIN')GOTO1096 IF(IMANUF.EQ.'MACI')GOTO1098 IF(IMANUF.EQ.'LATE')GOTO1097 IF(IMANUF.EQ.'SVG ')GOTO1099 GOTO8900 C 1005 CONTINUE CCCCC IF(IMODEL.EQ.'4662')GOTO1100 CCCCC GOTO8900 GOTO1100 C 1010 CONTINUE IF(IMODEL.EQ.'7221')GOTO2100 IF(IMODEL.EQ.'2622')GOTO2300 IF(IMODEL.EQ.'2623')GOTO2300 IF(IMODEL.EQ.'2627')GOTO2300 IF(IMODEL.EQ.'2647')GOTO2300 GOTO2200 C 1015 CONTINUE GOTO2600 C 1020 CONTINUE IF(IMODEL.EQ.'CODE')GOTO3200 IF(IMODEL.EQ.'CGM')GOTO3300 IF(IMODEL.EQ.'CGMB')GOTO3400 GOTO3100 C 1025 CONTINUE GOTO4100 C 1030 CONTINUE GOTO5100 C 1035 CONTINUE GOTO6100 C 1040 CONTINUE GOTO6600 C 1045 CONTINUE GOTO7100 C 1050 CONTINUE GOTO8100 C 1055 CONTINUE IF(IMODEL.EQ.'DISP')GOTO8910 GOTO8600 C 1060 CONTINUE GOTO9100 C 1065 CONTINUE GOTO9600 C 1070 CONTINUE GOTO10000 C 1075 CONTINUE GOTO11000 C 1080 CONTINUE IF(IMODEL.EQ.'INTE')GOTO4900 IF(IMODEL.EQ.'WINT')GOTO4950 GOTO4600 C 1085 CONTINUE IF(IMODEL.EQ.'JPEG')GOTO12000 IF(IMODEL.EQ.'PNG ')GOTO12000 IF(IMODEL.EQ.'WBMP')GOTO12000 IF(IMODEL.EQ.'GIF')GOTO12000 GOTO12000 C 1090 CONTINUE GOTO4700 C 1091 CONTINUE GOTO13500 C 1095 CONTINUE GOTO4800 C 1096 CONTINUE GOTO14000 C 1097 CONTINUE GOTO15000 C 1098 CONTINUE GOTO13000 C 1099 CONTINUE GOTO16000 C C C ****************************************************** C ** STEP 11-- ** C ** TREAT THE TEKTRONIX 4662 CASE (A PENPLOTTER)-- ** C ** TO TURN IT OFF, ** C ** WRITE OUT AN ESCAPE A F . ** C ****************************************************** C 1100 CONTINUE IF(IMODEL.EQ.'4662')GOTO1110 GOTO1119 1110 CONTINUE CCCCC WRITE(IGUNIT,1111)IESCC C1111 FORMAT(A1,'AF') ICSTR(1:1)=IESCC ICSTR(2:3)='AF' NCSTR=3 CALL GRWRST(ICSTR,NCSTR,ISUBN0) 1119 CONTINUE C IF(IPPDE1.EQ.'TEKT')GOTO1171 GOTO1179 1171 CONTINUE IF(NCPOST.GE.1)GOTO1172 GOTO1179 1172 CONTINUE NCSTR=NCPOST IF(NCSTR.GT.40)NCSTR=40 ICSTR(1:NCSTR)=ICPOST(1:NCSTR) CALL GRWRST(ICSTR,NCSTR,ISUBN0) 1179 CONTINUE C GOTO8900 C C ****************************************************** C ** STEP 21-- ** C ** TREAT THE HEWLETT-PACKARD 7221 CASE ** C ** (MULTI-COLOR PENPLOTTER) ** C ** TO TURN IT OFF, ** C ** SEND ESCAPE PERIOD RIGHT-PARENTHESIS ** C ** REFERENCE--HP 7221A GRAPHICS PLOTTER ** C ** OPERATING AND PROGRAMMING MANUAL, ** C ** PAGE 72. ** C ****************************************************** C 2100 CONTINUE CCCCC WRITE(IGUNIT,2111)IESCC C2111 FORMAT(A1,'.)','}') CCCCC WRITE(IGUNIT,2111)IESCC,IESCC C2111 FORMAT(1H+,A1,'.)',A1,'.Z',':') ICSTR(1:1)='+' ICSTR(2:2)=IESCC ICSTR(3:4)='.)' ICSTR(5:5)=IESCC ICSTR(6:8)='.Z:' NCSTR=8 CALL GRWRST(ICSTR,NCSTR,ISUBN0) C IF(IPPDE1.EQ.'HP'.AND.'IPPDE2'.EQ.'7221')GOTO2171 GOTO2179 2171 CONTINUE IF(NCPOST.GE.1)GOTO2172 GOTO2179 2172 CONTINUE NCSTR=NCPOST IF(NCSTR.GT.40)NCSTR=40 ICSTR(1:NCSTR)=ICPOST(1:NCSTR) CALL GRWRST(ICSTR,NCSTR,ISUBN0) 2179 CONTINUE C GOTO8900 C C ****************************************************** C ** STEP 22-- ** C ** TREAT THE HEWLETT-PACKARD HP-GL CASES ** C ** (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS) ** C ** (MULTI-COLOR PENPLOTTERS) ** C ** THERE IS NO TURN OFF INSTRUCTION PER SE, ** C ** REFERENCE--HP 9872C GRAPHICS PLOTTER ** C ** OPERATING AND PROGRAMMING MANUAL, ** C ** PAGE XX, XXX. ** C ****************************************************** C 2200 CONTINUE C C THE FOLLOWING WAS A SUGGESTED AUGMENTATION C (NBS'S YONG-KI KIM, MARCH, 1985) C WHEN THE PLOTTER IS CONNECTED IN SERIES C BETWEEN THE HOST AND THE TERMINAL, C AND THE PLOTTER NEEDS TO BE PUT IN A C LISTEN-AND-CAPTURE MODE C WHEN GENERATING A PLOT. C TO SPECIFY THIS, THE ANALYST C ENTERS THE COMMAND HP-GL + C RATHER THAN THE USUAL HP-GL C CCCCC IF(IMODE2.EQ.'+')GOTO2210 CCCCC GOTO2219 C2210 CONTINUE CCCCC ICSTR(1:1)=IESCC CCCCC ICSTR(2:3)='.Z' CCCCC NCSTR=3 CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0) C2219 CONTINUE C IF(IPPDE1.EQ.'HPGL')GOTO2271 IF(IPPDE1.EQ.'HP-G')GOTO2271 IF(IPPDE1.EQ.'HP'.AND.IPPDE2.EQ.'GL')GOTO2271 IF(IPPDE1.EQ.'HP'.AND.IPPDE2.EQ.'GL+')GOTO2271 GOTO2279 2271 CONTINUE IF(NCPOST.GE.1)GOTO2272 GOTO2279 2272 CONTINUE NCSTR=NCPOST IF(NCSTR.GT.40)NCSTR=40 ICSTR(1:NCSTR)=ICPOST(1:NCSTR) CALL GRWRST(ICSTR,NCSTR,ISUBN0) 2279 CONTINUE C GOTO8900 C C ********************************************************** C ** STEP 23-- ** C ** TREAT THE HEWLETT-PACKARD HP-2622 CASES ** C ** (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS) ** C ** (MONOCHROME DISPLAY TERMINALS) ** C ** REFERENCE--HP 2322C GRAPHICS PLOTTER ** C ** REFERENCE MANUAL, ** C ** PAGE XX-X, XXX. ** C ********************************************************** C 2300 CONTINUE IF(IPPDE1.EQ.'HP'.AND.'IPPDE2'.EQ.'2622')GOTO2371 IF(IPPDE1.EQ.'HP'.AND.'IPPDE2'.EQ.'2623')GOTO2371 IF(IPPDE1.EQ.'HP'.AND.'IPPDE2'.EQ.'2627')GOTO2371 IF(IPPDE1.EQ.'HP'.AND.'IPPDE2'.EQ.'2647')GOTO2371 GOTO2379 2371 CONTINUE IF(NCPOST.GE.1)GOTO2372 GOTO2379 2372 CONTINUE NCSTR=NCPOST IF(NCSTR.GT.40)NCSTR=40 ICSTR(1:NCSTR)=ICPOST(1:NCSTR) CALL GRWRST(ICSTR,NCSTR,ISUBN0) 2379 CONTINUE C GOTO8900 C C ********************************************************** C ** STEP 26-- ** C ** TREAT THE HEWLETT-PACKARD LASER JET CASES ** C ** LANDSCAPE ORIENTATION ** C ** TO CLOSE DEVICE ** C ** STEP 1-- ** C ** REFERENCE-- ** C ** REFERENCE MANUAL, ** C ** PAGE ** C ********************************************************** C 2600 CONTINUE IF(IPPDE1.EQ.'PCL')GOTO2671 GOTO2679 2671 CONTINUE IF(NCPOST.GE.1)GOTO2672 GOTO2679 2672 CONTINUE NCSTR=NCPOST IF(NCSTR.GT.40)NCSTR=40 ICSTR(1:NCSTR)=ICPOST(1:NCSTR) CALL GRWRST(ICSTR,NCSTR,ISUBN0) 2679 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 31-- ** C ** TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE ** C ****************************************************** C 3100 CONTINUE CCCCC WRITE(IGUNIT,3111) C3111 FORMAT('CLOSE DEVICE') ICSTR(1:12)='CLOSE DEVICE' NCSTR=12 CALL GRWRST(ICSTR,NCSTR,ISUBN0) C IF(IPPDE1.EQ.'GENE')GOTO3171 GOTO3179 3171 CONTINUE IF(NCPOST.GE.1)GOTO3172 GOTO3179 3172 CONTINUE NCSTR=NCPOST IF(NCSTR.GT.40)NCSTR=40 ICSTR(1:NCSTR)=ICPOST(1:NCSTR) CALL GRWRST(ICSTR,NCSTR,ISUBN0) 3179 CONTINUE C GOTO8900 C C *************************************************************** C ** STEP 32-- ** C ** TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE ** C *************************************************************** C 3200 CONTINUE ICSTR(1:4)='CLDE' NCSTR=4 CALL GRWRST(ICSTR,NCSTR,ISUBN0) C IF(IPPDE1.EQ.'CODE')GOTO3271 GOTO3279 3271 CONTINUE IF(NCPOST.GE.1)GOTO3272 GOTO3279 3272 CONTINUE NCSTR=NCPOST IF(NCSTR.GT.40)NCSTR=40 ICSTR(1:NCSTR)=ICPOST(1:NCSTR) CALL GRWRST(ICSTR,NCSTR,ISUBN0) 3279 CONTINUE C GOTO8900 C C *************************************************************** C ** STEP 33-- ** C ** TREAT THE CGM GENERAL (DEVICE-INDEPENDENT) CASE ** C *************************************************************** C 3300 CONTINUE C IF(IPPDE1.EQ.'CODE')GOTO3371 GOTO3379 3371 CONTINUE IF(NCPOST.GE.1)GOTO3372 GOTO3379 3372 CONTINUE NCSTR=NCPOST IF(NCSTR.GT.40)NCSTR=40 ICSTR(1:NCSTR)=ICPOST(1:NCSTR) CALL GRWRST(ICSTR,NCSTR,ISUBN0) 3379 CONTINUE C GOTO8900 C C *************************************************** C ** STEP 34-- ** C ** TREAT THE CGM (BINARY) CASE ** C *************************************************** C 3400 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 41-- ** C ** TREAT THE CALCOMP XXXXXX CASE ** C ** TO TURN IT OFF-- ** C ** WRITE OUT AN XXXXXXXXXXXXXX ** C ** USE CALCOMP LIBRARY (NULL ROUTINE) ** C ** REFERENCE--XX ** C ** XX ** C ** PAGES XX AND XX ** C ****************************************************** C 4100 CONTINUE CCCCC WRITE(IGUNIT,4111) C4111 FORMAT('FIX SUBROUTINE GRCLDE TO CLOSE CALCOMP DEVICE') CCCCC ICSTR(1:45)='FIX SUBROUTINE GRCLDE TO CLOSE CALCOMP DEVICE' CCCCC NCSTR=45 CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0) GOTO8900 C C ****************************************************** C ** STEP 46-- ** C ** TREAT THE LAHEY XXXXXX CASE ** C ** TO TURN IT OFF-- ** C ** CALL PLOT WITH IPEN=999 ** C ** ONLY CALL IF ILAHCL = 'ON' ** C ** REFERENCE--Programmer's Reference, Revision C ** C ** Lahey Computer Systems, January, 1992** C ** PAGES 51 THRU 65 ** C ****************************************************** C 4600 CONTINUE C C ILAHCL = IF ON, RETURN TO VIDEO TEXT MODE. THIS IS PREFERRED C CHOICE FOR BETTER ALPHANUMERIC OUTPUT. HOWEVER, MAY WANT C TO LEAVE IN GRAPHICS MODE TO GENERATE DIAGRAMMATIC GRAPHICS C ILAHPA = IF ON, REQUEST A CARRIAGE RETURN BEFORE CONTINUING. IF C OFF, CONTINUE REGARDLESS. C ILAHSW = ON IF GRAPHICS MODE SET, OFF IF NORMAL VIDEO MODE SET C IF(ILAHPA.EQ.'ON')THEN WRITE(IPR,4601) READ(IRD,'(1X,A1)')IA ENDIF 4601 FORMAT(1X,'ENTER CARRIAGE RETURN TO CONTINUE') IF(ILAHCL.EQ.'ON')THEN AX=0. AY=0. IPEN=999 IF(ILAHSW.EQ.'ON')CALL PLOT(AX,AY,IPEN) ILAHSW='OFF' ENDIF GOTO8900 C C ****************************************************** C ** STEP 47-- ** C ** TREAT THE MICROSOFT QUICKWIN DRIVER ** C ** FOR WINDOWS 95 AND WINDOWS NT. ** C ****************************************************** C 4700 CONTINUE IF(IQWNFC.EQ.'TEXT')THEN CQWVF IRESLT=FOCUSQQ(IPR) CQWVF IRESLT=DISPLAYCURSOR($GCURSORON) ENDIF GOTO9000 C C ****************************************************** C ** STEP 48-- ** C ** TREAT THE OPEN-GL DRIVER ** C ** FOR WINDOWS 95 AND WINDOWS NT AND X11 ** C ****************************************************** C 4800 CONTINUE IFLAG=1 CALL GLCLDE() GOTO9000 C C ****************************************************** C ** STEP 49-- ** C ** TREAT THE LAHEY INTERACTOR CASE ** C ****************************************************** C 4900 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 49B- ** C ** TREAT THE LAHEY WINTERACTOR CASE ** C ****************************************************** C 4950 CONTINUE CCCCC IHAND1=0 CCCCC CALL WindowSelect(IHAND1) GOTO9000 C C ****************************************************** C ** STEP 51-- ** C ** TREAT THE ZETA 3600SX AND 3653SX CASES ** C ** TO TURN IT OFF-- ** C ** WRITE OUT 70Z ** C ** REFERENCE--USER MANUAL FOR DIGITAL PLOTTER ** C ** MODELS 3600SX AND 3653SX ** C ** PAGES B-0 AND B-1 ** C ** USE CALCOMP LIBRARY (NULL ROUTINE) ** C ****************************************************** C 5100 CONTINUE CCCCC WRITE(IGUNIT,5111) C5111 FORMAT('70Z') CCCCC ICSTR(1:3)='70Z' CCCCC NCSTR=3 CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0) GOTO8900 C C ****************************************************** C ** STEP 61-- ** C ** TREAT THE RAMTEK XXXXXX CASE ** C ** TO TURN IT OFF-- ** C ** WRITE OUT AN XXXXXXXXXXXXXX ** C ** (NOT DONE) ** C ** REFERENCE--XX ** C ** XX ** C ** PAGES XX AND XX ** C ****************************************************** C 6100 CONTINUE CCCCC WRITE(IGUNIT,6111) C6111 FORMAT('FIX SUBROUTINE GRCLDE TO CLOSE RAMTEK DEVICE') ICSTR(1:44)='FIX SUBROUTINE GRCLDE TO CLOSE RAMTEK DEVICE' NCSTR=44 CALL GRWRST(ICSTR,NCSTR,ISUBN0) GOTO8900 C C ****************************************************** C ** STEP 66-- ** C ** TREAT THE SUN CASE ** C ** NOT NECESSARY TO CLOSE DEVICE ** C ****************************************************** C 6600 CONTINUE IF(IPPDE1.EQ.'SUN')GOTO6671 GOTO6679 6671 CONTINUE IF(NCPOST.GE.1)GOTO6672 GOTO6679 6672 CONTINUE NCSTR=NCPOST IF(NCSTR.GT.40)NCSTR=40 ICSTR(1:NCSTR)=ICPOST(1:NCSTR) CALL GRWRST(ICSTR,NCSTR,ISUBN0) 6679 CONTINUE GOTO9000 C C ***************************************************** C ** STEP 71-- ** C ** TREAT THE XXXXXX XXXXXX CASE ** C ** TO TURN IT OFF-- ** C ** WRITE OUT AN XXXXXXXXXXXXXX ** C ** (NOT DONE) ** C ** REFERENCE--XX ** C ** XX ** C ** PAGES XX AND XX ** C ***************************************************** C 7100 CONTINUE CCCCC WRITE(IGUNIT,7111) C7111 FORMAT('FIX SUBROUTINE GRCLDE TO CLOSE XXXXXX DEVICE') ICSTR(1:44)='FIX SUBROUTINE GRCLDE TO CLOSE XXXXXX DEVICE' NCSTR=44 CALL GRWRST(ICSTR,NCSTR,ISUBN0) GOTO8900 C C ****************************************************** C ** STEP 81-- ** C ** TREAT THE DEC REGIS CASE ** C ** TO CLOSE DEVICE--- ** C ** WRITE OUT AN XX ** C ** REFERENCE--VT125 GRAPHICS TERMINAL USER GUIDE ** C ** PAGES XX AND XX ** C ****************************************************** C 8100 CONTINUE IF(IPPDE1.EQ.'REGI')GOTO8171 GOTO8179 8171 CONTINUE IF(NCPOST.GE.1)GOTO8172 GOTO8179 8172 CONTINUE NCSTR=NCPOST IF(NCSTR.GT.40)NCSTR=40 ICSTR(1:NCSTR)=ICPOST(1:NCSTR) CALL GRWRST(ICSTR,NCSTR,ISUBN0) 8179 CONTINUE C GOTO8900 C C ****************************************************** C ** STEP 86-- ** C ** TREAT THE POSTSCRIPT CASE ** C ** REFERENCE: POSTSCRIPT LANGUAGE TUTORIAL AND ** C ** COOKBOOK FROM ADOBE SYSTEMS ** C ****************************************************** C 8600 CONTINUE C IF(IPPDE1.EQ.'POST')GOTO8671 GOTO8679 8671 CONTINUE IF(NCPOST.GE.1)GOTO8672 GOTO8679 8672 CONTINUE NCSTR=NCPOST IF(NCSTR.GT.40)NCSTR=40 ICSTR(1:NCSTR)=ICPOST(1:NCSTR) CALL GRWRST(ICSTR,NCSTR,ISUBN0) 8679 CONTINUE C GOTO8900 C C ****************************************************** C ** STEP 89-- ** C ** TREAT THE DISPLAY POSTSCRIPT DRIVER ** C ****************************************************** C 8910 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 91-- ** C ** TREAT THE QUIC CASE - NULL ROUTINE ** C ****************************************************** C 9100 CONTINUE C IF(IPPDE1.EQ.'QUIC')GOTO9171 GOTO9179 9171 CONTINUE IF(NCPOST.GE.1)GOTO9172 GOTO9179 9172 CONTINUE NCSTR=NCPOST IF(NCSTR.GT.40)NCSTR=40 ICSTR(1:NCSTR)=ICPOST(1:NCSTR) CALL GRWRST(ICSTR,NCSTR,ISUBN0) 9179 CONTINUE C GOTO8900 C C ****************************************************** C ** STEP 96-- ** C ** TREAT THE X11 CASE - FLUSH THE BUFFER ** C ** REFERENCE--DDC SOFTWARE TRANSLATOR MANUAL ** C ****************************************************** C 9600 CONTINUE C IF(IPPDE1.EQ.'X11 ')GOTO9671 GOTO9679 9671 CONTINUE IF(NCPOST.GE.1)GOTO9672 GOTO9679 9672 CONTINUE NCSTR=NCPOST IF(NCSTR.GT.40)NCSTR=40 ICSTR(1:NCSTR)=ICPOST(1:NCSTR) CALL GRWRST(ICSTR,NCSTR,ISUBN0) 9679 CONTINUE C IF(IX11OF.NE.'OFF')CALL XCLEAR GOTO8900 C CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1991 (JJF) C ************************************************* C ** STEP 100-- ** C ** TREAT THE VGA VIA TURBO-C CASE ** C ************************************************* C 10000 CONTINUE CALL TCCLDE GOTO9000 C C ****************************************************** C ** STEP 110-- ** C ** TREAT THE GKS DRIVER ** C ****************************************************** C 11000 CONTINUE CGKS CALL GDAWK(IGKSWK) GOTO9000 C C ****************************************************** C ** STEP 120-- ** C ** TREAT THE GD DRIVER ** C ** THIS LIBRARY PROVIDES SUPPORT FOR: ** C ** 1) JPEG ** C ** 2) PNG ** C ** 3) WINDOWS BMP (BLACK/WHITE ONLY) ** C ****************************************************** C 12000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 130-- ** C ** TREAT THE MACINTOSH DRIVER ** C ** LIBRARY FROM ABSOFT COMPILER ** C ****************************************************** C 13000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 135-- ** C ** TREAT THE MAC OSX AQUATERM DRIVER ** C ****************************************************** C 13500 CONTINUE CAQUA CALL aqtRenderPlot() GOTO9000 C C ****************************************************** C ** STEP 140-- ** C ** TREAT THE PC PRINTER DRIVER ** C ****************************************************** C 14000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 150-- ** C ** TREAT THE LATEX (USING EEPIC) DRIVER ** C ****************************************************** C 15000 CONTINUE C CCCCC ICSTR(1:1)=IBASLC CCCCC ICSTR(2:13)='end{picture}' CCCCC NCSTR=13 CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0) C CCCCC IF(IMODEL.NE.'STAN')THEN C CCCCC ICSTR(1:1)=' ' CCCCC NCSTR=1 CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0) C CCCCC ICSTR(1:1)=IBASLC CCCCC ICSTR(2:18)='begin{verbatim}' CCCCC NCSTR=18 CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0) C CCCCC ELSEIF(ILATFO.EQ.'NULL')THEN C CCCCC ICSTR(1:1)=' ' CCCCC NCSTR=1 CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0) C CCCCC ICSTR(1:1)=IBASLC CCCCC ICSTR(2:16)='end{document}' CCCCC NCSTR=16 CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0) C CCCCC ELSE CCCCC IOUNI1=IST1NU CCCCC IFILE1=ILATFO CCCCC ISTAT1='OLD' CCCCC IFORM1='FORMATTED' CCCCC IACCE1='SEQUENTIAL' CCCCC IPROT1='READONLY' CCCCC ICURS1='CLOSED' CCCCC ISUBN0='CAPT' CCCCC IERRF1='NO' C CCCCC IREWI1='ON' CCCCC CALL DPOPFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1, CCCCC1 IREWI1,ISUBN0,IERRF1,IBUGS2,ISUBRO,IERROR) CCCCC IF(IERRF1.EQ.'YES')GOTO9000 C C NOW LOOP THROUGH FILE (ASSUME MAXIMUM OF 1,000 LINES). C CCCCC DO15301I=1,1000 CCCCC IATEMP=' ' CCCCC READ(IOUNI2,15392,END=15399,ERR=15399)IATEMP 15392 FORMAT(A240) CCCCC ILAST=1 CCCCC DO15410J=240,1,-1 CCCCC IF(IATEMP(J:J).NE.' ')THEN CCCCC ILAST=J CCCCC GOTO15419 CCCCC ENDIF 15410 CONTINUE 15419 CONTINUE CCCCC ICSTR(1:ILAST)=IATEMP(1:ILAST) CCCCC NCSTR=ILAST CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0) 15301 CONTINUE 15399 CONTINUE CCCCC IENDF1='OFF' CCCCC IREWI1='ON' CCCCC CALL DPCLFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1,IPROT1,ICURS1, CCCCC1 IENDF1,IREWI1,ISUBN0,IERRF1,IBUGS2,ISUBRO,IERROR) CCCCC IF(IERRF1.EQ.'YES')GOTO9000 CCCCC ENDIF GOTO9000 C C ****************************************************** C ** STEP 160-- ** C ** TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER ** C ****************************************************** C 16000 CONTINUE GOTO9000 C C ******************************************** C ** STEP 89-- ** C ** IF CALLED FOR, WRITE OUT ** C ** A USER-DEFINED POST-PLOT LINE ** C ******************************************** C 8900 CONTINUE IF(IPPDE1.EQ.'ANY')GOTO8971 IF(IPPDE1.EQ.'ALL')GOTO8971 GOTO8979 8971 CONTINUE IF(NCPOST.GE.1)GOTO8972 GOTO8979 8972 CONTINUE NCSTR=NCPOST IF(NCSTR.GT.40)NCSTR=40 ICSTR(1:NCSTR)=ICPOST(1:NCSTR) CALL GRWRST(ICSTR,NCSTR,ISUBN0) 8979 CONTINUE C GOTO9000 C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'CLDE')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF GRCLDE--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)IMANUF,IMODEL,IMODE2,IMODE3 9012 FORMAT('IMANUF,IMODEL,IMODE2,IMODE3 = ',A4,2X,A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)IGUNIT,IGCODE 9013 FORMAT('IGUNIT,IGCODE = ',I8,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)ISOFT,ISOFT2,ISOFT3 9014 FORMAT('ISOFT,ISOFT2,ISOFT3 = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9015)IGBAUD 9015 FORMAT('IGBAUD = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9023)NCSTR 9023 FORMAT('NCSTR = ',I8) CALL DPWRST('XXX','BUG ') IF(NCSTR.LE.0)GOTO9027 DO9025I=1,NCSTR CCCCC IASCNE=ICHAR(ICSTR(I:I)) CALL DPCOAN(ICSTR(I:I),IASCNE) WRITE(ICOUT,9026)I,ICSTR(I:I),IASCNE 9026 FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8) CALL DPWRST('XXX','BUG ') 9025 CONTINUE 9027 CONTINUE WRITE(ICOUT,9029)IBUGG4,ISUBG4,IERRG4 9029 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9031)IPPDE1,IPPDE2 9031 FORMAT('IPPDE1,IPPDE2 = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9032)NCPOST 9032 FORMAT('NCPOST = ',I8) CALL DPWRST('XXX','BUG ') IF(NCPOST.LE.0)GOTO9035 DO9033I=1,NCPOST WRITE(ICOUT,9034)I,ICPOST(I:I) 9034 FORMAT('I,ICPOST(I:I) = ',I8,2X,A1,4X) CALL DPWRST('XXX','BUG ') 9033 CONTINUE 9035 CONTINUE 9090 CONTINUE C RETURN END SUBROUTINE GRCOSC C C PURPOSE--COPY THE SCREEN C OF A SPECIFIC GRAPHICS DEVICE. C NOTE--THIS SUBROUTINE IS NEEDED FOR COLOR DEVICES ONLY. C C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-921-3651 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--83.6 C ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY 1983. C UPDATED --JANUARY 1989. SUN (BY BILL ANDERSON) C DRIVER OBSOLETE C UPDATED --JANUARY 1989. POSTSCRIPT (BY ALAN HECKERT) C UPDATED --JANUARY 1989. CGM (BY ALAN HECKERT) C UPDATED --JANUARY 1989. QMS QUIC (BY ALAN HECKERT) C UPDATED --JANUARY 1989. CALCOMP (BY ALAN HECKERT) C UPDATED --JANUARY 1989. ZETA (BY ALAN HECKERT) C UPDATED --MARCH 1990. X11 (BY ALAN HECKERT) C UPDATED --MAY 1991. RENUMBER TOP BRANCHES (JJF) C UPDATED --MAY 1991. VGA/TURBOC DRIVER (JJF) C DRIVER OBSOLETE C UPDATED --JULY 1996. LAHEY DRIVER (ALAN HECKERT) C DRIVER OBSOLETE C UPDATED --OCTOBER 1996. QUICKWIN DRIVER (ALAN) C UPDATED --OCTOBER 1996. OPENGL DRIVER (ALAN) C USE BILL MITCHELLS OPENGL C BINDING FOR FORTRAN C UPDATED --OCTOBER 1996. GKS (ALAN) C CODED, NOT TESTED C UPDATED --OCTOBER 1996. BINARY CGM (ALAN) C PLACEHOLDER FOR NOW C UPDATED --OCTOBER 1996. DISPLAY POSTSCRIPT (ALAN) C PLACEHOLDER FOR NOW C UPDATED --OCTOBER 1996. PORTABLE BITMAP (PBM) (ALAN) C UPDATED --JULY 1998. LAHEY WINTERACTOR C UPDATED --JUNE 2000. GD (FOR JPEG, PNG, WINDOWS BMP) C UPDATED --JUNE 2000. MACINTOSH C PLACEHOLDER FOR NOW C UPDATED --JUNE 2000. PC PRINTER C PLACEHOLDER FOR NOW C UPDATED --MARCH 2005. SUPPORT FOR AQUATERM C C-----NON-COMMON VARIABLES (GRAPHICS)------------------------------------------- C CWINT USE WINTERACTER CINTE USE INTERACTER CHARACTER*130 ICSTR CHARACTER*4 ISUBN0 CHARACTER*4 ICARAT C C-----COMMON---------------------------------------------------------- C INCLUDE 'DPCOGR.INC' INCLUDE 'DPCONP.INC' INCLUDE 'DPCOBE.INC' C C-----COMMON VARIABLES (GENERAL)-------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C ISUBN0='COSC' C NCSTR=(-999) C IERRG4='NO' C ICHAPS=0 INULLI=0 C IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'COSC')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF GRCOSC--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)IGBAUD,AGCODE 53 FORMAT('IGBAUD,AGCODE = ',I8,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,54)IMANUF,IMODEL 54 FORMAT('IMANUF,IMODEL = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,55)IBUGG4 55 FORMAT('IBUGG4 = ',A4) CALL DPWRST('XXX','BUG ') 90 CONTINUE C C ******************************************** C ** STEP 1-- ** C ** BRANCH ACCORDING TO THE MANUFACTURER ** C ** AND THE MODEL ** C ******************************************** C IF(IMANUF.EQ.'TEKT')GOTO1005 IF(IMANUF.EQ.'HP')GOTO1010 IF(IMANUF.EQ.'PCL')GOTO1015 IF(IMANUF.EQ.'GENE')GOTO1020 IF(IMANUF.EQ.'CALC')GOTO1025 IF(IMANUF.EQ.'ZETA')GOTO1030 IF(IMANUF.EQ.'RAMT')GOTO1035 IF(IMANUF.EQ.'SUN ')GOTO1040 IF(IMANUF.EQ.'XXXX')GOTO1045 IF(IMANUF.EQ.'REGI')GOTO1050 IF(IMANUF.EQ.'POST')GOTO1055 IF(IMANUF.EQ.'QUIC')GOTO1060 IF(IMANUF.EQ.'X11 ')GOTO1065 IF(IMANUF.EQ.'TURB')GOTO1070 IF(IMANUF.EQ.'GKS ')GOTO1075 IF(IMANUF.EQ.'LAHE')GOTO1080 IF(IMANUF.EQ.'GD ')GOTO1085 IF(IMANUF.EQ.'QWIN')GOTO1090 IF(IMANUF.EQ.'AQUA')GOTO1091 IF(IMANUF.EQ.'OPGL')GOTO1095 IF(IMANUF.EQ.'PRIN')GOTO1096 IF(IMANUF.EQ.'MACI')GOTO1098 GOTO9000 C 1005 CONTINUE IF(IMODEL.EQ.'4662')GOTO9000 C IF(IMODEL.EQ.'4020')GOTO1200 IF(IMODEL.EQ.'4022')GOTO1200 IF(IMODEL.EQ.'4025')GOTO1200 IF(IMODEL.EQ.'4027')GOTO1200 C IF(IMODEL.EQ.'4105')GOTO1300 IF(IMODEL.EQ.'4107')GOTO1300 IF(IMODEL.EQ.'4109')GOTO1300 IF(IMODEL.EQ.'4115')GOTO1300 C GOTO1100 C 1010 CONTINUE IF(IMODEL.EQ.'7221')GOTO2100 IF(IMODEL.EQ.'2622')GOTO2300 IF(IMODEL.EQ.'2623')GOTO2300 IF(IMODEL.EQ.'2627')GOTO2300 IF(IMODEL.EQ.'2647')GOTO2300 GOTO2200 C 1015 CONTINUE GOTO2600 C 1020 CONTINUE IF(IMODEL.EQ.'CODE')GOTO3200 IF(IMODEL.EQ.'CGM')GOTO3300 IF(IMODEL.EQ.'CGMB')GOTO3400 GOTO3100 C 1025 CONTINUE GOTO4100 C 1030 CONTINUE GOTO5100 C 1035 CONTINUE GOTO6100 C 1040 CONTINUE GOTO6600 C 1045 CONTINUE GOTO7100 C 1050 CONTINUE GOTO8100 C 1055 CONTINUE IF(IMODEL.EQ.'DISP')GOTO8900 GOTO8600 C 1060 CONTINUE GOTO9100 C 1065 CONTINUE GOTO9600 C 1070 CONTINUE GOTO10000 C 1075 CONTINUE GOTO11000 C 1080 CONTINUE IF(IMODEL.EQ.'INTE')GOTO4900 IF(IMODEL.EQ.'WINT')GOTO4950 GOTO4600 C 1085 CONTINUE IF(IMODEL.EQ.'JPEG')GOTO12000 IF(IMODEL.EQ.'PNG ')GOTO12000 IF(IMODEL.EQ.'WBMP')GOTO12000 IF(IMODEL.EQ.'GIF')GOTO12000 GOTO12000 C 1090 CONTINUE GOTO4700 C 1091 CONTINUE GOTO13500 C 1095 CONTINUE GOTO4800 C 1096 CONTINUE GOTO14000 C 1098 CONTINUE GOTO13000 C C ************************************************************ C ** STEP 11-- ** C ** TREAT THE TEKTRONIX 400X, 401X, 405X, AND 4114 CASES ** C ** (THESE ARE ALL NON-COLOR (= MONOCHROME) DEVICES) ** C ** TO COPY THE SCREEN, ** C ** WRITE OUT AN ESCAPE ETB ** C ************************************************************ C 1100 CONTINUE CCCCC WRITE(IGUNIT,1111)IESCC,IETBC C1111 FORMAT(A1,A1) ICSTR(1:1)=IESCC ICSTR(2:2)=IETBC NCSTR=2 CALL GRWRST(ICSTR,NCSTR,ISUBN0) C DO1130J=1,10 ICSTR(J:J)=INULC 1130 CONTINUE NCSTR=10 C CCCCC ICHAPS=IGBAUD/10 CCCCC INULLI=ICHAPS/10 INULLI=AGCODE+0.5 IF(INULLI.LE.0)GOTO1139 DO1135I=1,INULLI CALL GRWRST(ICSTR,NCSTR,ISUBN0) 1135 CONTINUE 1139 CONTINUE C GOTO9000 C C ****************************************************** C ** STEP 12-- ** C ** TREAT THE TEKTRONIX 4020, 4022, AND 4025 CASES ** C ** (NON-COLOR RASTER DEVICES). ** C ** TO COPY THE SCREEN, ** C ** XXX ** C ** REFERENCE--4027 OPERATOR'S MANUAL, PAGE B-5. ** C ****************************************************** C 1200 CONTINUE CCCCC WRITE(IGUNIT,1411) C1411 FORMAT('!MON H') CCCCC WRITE(IGUNIT,1412) C1412 FORMAT('!HCO W') CCCCC WRITE(IGUNIT,1413) C1413 FORMAT('!WOR H') CCCCC WRITE(IGUNIT,1211) C1211 FORMAT('!COP W/N P;') ICSTR(1:11)='!COP W/N P;' NCSTR=11 CALL GRWRST(ICSTR,NCSTR,ISUBN0) GOTO9000 C C ****************************************************** C ** STEP 13-- ** C ** TREAT THE 4105 CASE ** C ** (COLOR DEVICE) ** C ** REFERENCE--PAGE 5-53 ** C ****************************************************** C 1300 CONTINUE CCCCC WRITE(IGUNIT,1311)IESCC,IETBC C1311 FORMAT(A1,A1) ICSTR(1:1)=IESCC ICSTR(2:2)=IETBC NCSTR=2 CALL GRWRST(ICSTR,NCSTR,ISUBN0) C DO1330J=1,10 ICSTR(J:J)=INULC 1330 CONTINUE NCSTR=10 C CCCCC ICHAPS=IGBAUD/10 CCCCC INULLI=ICHAPS/10 INULLI=AGCODE+0.5 IF(INULLI.LE.0)GOTO1339 DO1335I=1,INULLI CALL GRWRST(ICSTR,NCSTR,ISUBN0) 1335 CONTINUE 1339 CONTINUE C GOTO9000 C C ****************************************************** C ** STEP 21-- ** C ** TREAT THE HEWLETT-PACKARD 7221 CASE ** C ** (MULTI-COLOR PENPLOTTER) ** C ** REFERENCE--HP 7221A GRAPHICS PLOTTER ** C ** OPERATING AND PROGRAMMING MANUAL, ** C ** PAGE XX. ** C ****************************************************** C 2100 CONTINUE CCCCC WRITE(IGUNIT,2111) C2111 FORMAT('~+}') ICSTR(1:3)='~+}' NCSTR=3 CALL GRWRST(ICSTR,NCSTR,ISUBN0) GOTO9000 C C ****************************************************** C ** STEP 22-- ** C ** TREAT THE HEWLETT-PACKARD HP-GL CASES ** C ** (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS) ** C ** (MULTI-COLOR PENPLOTTERS) ** C ** THERE IS NO COPY SCREEN INSTRUCTION PER SE.** C ** REFERENCE--HP 9872C GRAPHICS PLOTTER ** C ** OPERATING AND PROGRAMMING MANUAL, ** C ** PAGE XX, XXX. ** C ****************************************************** C 2200 CONTINUE GOTO9000 C C ********************************************************** C ** STEP 23-- ** C ** TREAT THE HEWLETT-PACKARD HP-2622 CASES ** C ** (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS) ** C ** (MONOCHROME DISPLAY TERMINALS) ** C ** REFERENCE--HP 2322C GRAPHICS PLOTTER ** C ** REFERENCE MANUAL, ** C ** PAGE 10-17, 5-5???. ** C ********************************************************** C 2300 CONTINUE IF(IMODEL.EQ.'2647')GOTO2320 GOTO2310 2310 CONTINUE ICSTR(1:1)=IESCC ICSTR(2:9)='&p7s4dmZ' NCSTR=9 CALL GRWRST(ICSTR,NCSTR,ISUBN0) GOTO2390 2320 CONTINUE ICSTR(1:1)=IESCC ICSTR(2:9)=',cTR A G' ICSTR(10:10)=ICRC NCSTR=10 CALL GRWRST(ICSTR,NCSTR,ISUBN0) GOTO2390 2390 CONTINUE GOTO9000 C C ********************************************************** C ** STEP 26-- ** C ** TREAT THE HEWLETT-PACKARD LASER JET CASES ** C ** TO MAKE MULTIPLE COPIES, ESCC &laaX ** C ** WHERE aa IS AN INTEGER NUMBER OF COPIES (UP TO 99) ** C ** PROBLEM: THIS COMMAND DOES NOT DO AN IMMEDIATE COPY,** C ** IT SETS THE NUMBER OF COPIES TO BE DONE WHEN A PRINT** C ** PAGE COMMAND IS ISSUED. MAY HAVE TO CHANGE LOGIC ** C ** OF WHEN THIS COMMAND IS DONE. ** C ** REFERENCE-- LASER JET SERIES II TECHNICAL ** C ** REFERENCE MANUAL, ** C ** PAGE 4-2 ** C ********************************************************** C 2600 CONTINUE ICSTR(1:1)=IESCC ICSTR(2:5)='&l1X' NCSTR=5 CALL GRWRST(ICSTR,NCSTR,ISUBN0) GOTO9000 C C ****************************************************** C ** STEP 31-- ** C ** TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE ** C ****************************************************** C 3100 CONTINUE CCCCC WRITE(IGUNIT,3111) C3111 FORMAT('COPY SCREEN') ICSTR(1:11)='COPY SCREEN' NCSTR=11 CALL GRWRST(ICSTR,NCSTR,ISUBN0) GOTO9000 C C *************************************************************** C ** STEP 32-- ** C ** TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE ** C *************************************************************** C 3200 CONTINUE ICSTR(1:4)='COSC' NCSTR=4 CALL GRWRST(ICSTR,NCSTR,ISUBN0) GOTO9000 C C *************************************************************** C ** STEP 32-- ** C ** TREAT THE CGM GENERAL (DEVICE-INDEPENDENT) CASE ** C ** CGM DOES NOT SUPPORT THIS FEATURE ** C *************************************************************** C 3300 CONTINUE GOTO9000 C C *************************************************** C ** STEP 34-- ** C ** TREAT THE CGM (BINARY) CASE ** C *************************************************** C 3400 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 41-- ** C ** TREAT THE CALCOMP XXXXXX CASE ** C ** TO COPY SCREEN-- ** C ** NO COPY SCREEN FUNCTION ** C ** REFERENCE--CALCOMP LIBRARY MANUAL ** C ** XX ** C ** PAGES XX AND XX ** C ****************************************************** C 4100 CONTINUE CCCCC WRITE(IGUNIT,4111) C4111 FORMAT('FIX SUBROUTINE GRCOSC TO COPY CALCOMP DEVICE') CCCCC ICSTR(1:44)='FIX SUBROUTINE GRCOSC TO COPY CALCOMP DEVICE' CCCCC NCSTR=44 CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0) GOTO9000 C C ****************************************************** C ** STEP 46-- ** C ** TREAT THE LAHEY XXXXXX CASE ** C ** NO COPY SCREEN COMMAND SUPPORTED AT THIS TIME ** C ** REFERENCE--Programmer's Reference, Revision C ** C ** Lahey Computer Systems, January, 1992** C ** PAGES 51 THRU 65 ** C ****************************************************** C 4600 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 47-- ** C ** TREAT THE MICROSOFT QUICKWIN DRIVER ** C ** FOR WINDOWS 95 AND WINDOWS NT. ** C ****************************************************** C 4700 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 48-- ** C ** TREAT THE OPEN-GL DRIVER ** C ** FOR WINDOWS 95 AND WINDOWS NT AND X11 ** C ****************************************************** C 4800 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 49-- ** C ** TREAT THE LAHEY INTERACTOR CASE ** C ****************************************************** C 4900 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 49B- ** C ** TREAT THE LAHEY WINTERACTOR CASE ** C ****************************************************** C 4950 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 51-- ** C ** TREAT THE ZETA 3600SX AND 3653SX CASES ** C ** THERE IS NO COPY SCREEN INSTRUCTION PER SE.** C ** REFERENCE--USER MANUAL FOR DIGITAL PLOTTER ** C ** MODELS 3600SX AND 3653SX ** C ** PAGES B-0 AND B-1 ** C ** USE CALCOMP LIBRARY (NULL ROUTINE) ** C ****************************************************** C 5100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 61-- ** C ** TREAT THE RAMTEK XXXXXX CASE ** C ** TO COPY SCREEN-- ** C ** WRITE OUT AN XXXXXXXXXXXXXX ** C ** (NOT DONE) ** C ** REFERENCE--XX ** C ** XX ** C ** PAGES XX AND XX ** C ****************************************************** C 6100 CONTINUE CCCCC WRITE(IGUNIT,6111) C6111 FORMAT('FIX SUBROUTINE GRCOSC TO COPY RAMTEK DEVICE') ICSTR(1:43)='FIX SUBROUTINE GRCOSC TO COPY RAMTEK DEVICE' NCSTR=43 CALL GRWRST(ICSTR,NCSTR,ISUBN0) GOTO9000 C C ****************************************************** C ** STEP 66-- ** C ** TREAT THE SUN CASE - NULL ROUTINE ** C ****************************************************** C 6600 CONTINUE GOTO 9000 C C ****************************************************** C ** STEP 71-- ** C ** TREAT THE XXXXXX XXXXXX CASE ** C ** TO COPY SCREEN-- ** C ** WRITE OUT AN XXXXXXXXXXXXXX ** C ** (NOT DONE) ** C ** REFERENCE--XX ** C ** XX ** C ** PAGES XX AND XX ** C ****************************************************** C 7100 CONTINUE CCCCC WRITE(IGUNIT,7111) C7111 FORMAT('FIX SUBROUTINE GRCOSC TO COPY XXXXXX DEVICE') ICSTR(1:43)='FIX SUBROUTINE GRCOSC TO COPY XXXXXX DEVICE' NCSTR=43 CALL GRWRST(ICSTR,NCSTR,ISUBN0) GOTO9000 C C ****************************************************** C ** STEP 81-- ** C ** TREAT THE DEC REGIS CASE ** C ** TO COPY (GRAPHICS) SCREEN--- ** C ** WRITE OUT AN S ( H ) ** C ** REFERENCE--VT125 GRAPHICS TERMINAL USER GUIDE ** C ** PAGES 146 ** C ****************************************************** C 8100 CONTINUE ICSTR(1:1)=IESCC ICSTR(2:3)='Pp' ICSTR(4:7)='S(H)' NCSTR=7 CALL GRWRST(ICSTR,NCSTR,ISUBN0) GOTO9000 C C ****************************************************** C ** STEP 86-- ** C ** TREAT THE POSTSCRIPT CASE ** C ** NO COPY COMMAND - NULL ROUTINE ** C ****************************************************** C 8600 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 89-- ** C ** TREAT THE DISPLAY POSTSCRIPT DRIVER ** C ****************************************************** C 8900 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 91-- ** C ** TREAT THE QUIC CASE ** C ** 1) ^DCnnnn - PRINTS nnnn COPIES OF CURRENT PAGE** C ** 2) ^DCCnnnn - PRINTS nnnn COPIES OF ALL ** C ** SUBSEQUENT PAGES ** C ** REFERENCE: QMS PROGRAMMING MANUAL ** C ** PAGE: 12-6 ** C ****************************************************** C 9100 CONTINUE CALL DPCONA(94,ICARAT) ICSTR(1:1)=ICARAT ICSTR(2:8)='DC00001' NCSTR=8 CALL GRWRST(ICSTR,NCSTR,ISUBN0) GOTO9000 C C ****************************************************** C ** STEP 95-- ** C ** TREAT THE X11 CASE - NULL ROUTINE ** C ****************************************************** C 9600 CONTINUE GOTO9000 C C ************************************************* C ** STEP 100-- ** C ** TREAT THE VGA VIA TURBO-C CASE ** C ************************************************* C 10000 CONTINUE CALL TCCOSC GOTO9000 C C ****************************************************** C ** STEP 110-- ** C ** TREAT THE GKS DRIVER ** C ****************************************************** C 11000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 120-- ** C ** TREAT THE GD DRIVER ** C ** THIS LIBRARY PROVIDES SUPPORT FOR: ** C ** 1) JPEG ** C ** 2) PNG ** C ** 3) WINDOWS BMP (BLACK/WHITE ONLY) ** C ****************************************************** C 12000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 130-- ** C ** TREAT THE MACINTOSH DRIVER ** C ** LIBRARY FROM ABSOFT COMPILER ** C ****************************************************** C 13000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 135-- ** C ** TREAT THE MAC OSX AQUATERM DRIVER ** C ****************************************************** C 13500 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 140-- ** C ** TREAT THE PC PRINTER DRIVER ** C ****************************************************** C 14000 CONTINUE GOTO9000 C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'COSC')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF GRCOSC--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)IGBAUD,AGCODE 9013 FORMAT('IGBAUD,AGCODE = ',I8,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)ICHAPS,INULLI 9014 FORMAT('ICHAPS,INULLI = ',2I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9015)IESCC,IETBC,ISYNC 9015 FORMAT('IESCC,IETBC,ISYNC = ',A1,2X,A1,2X,A1) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9018)IMANUF,IMODEL 9018 FORMAT('IMANUF,IMODEL = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9023)NCSTR 9023 FORMAT('NCSTR = ',I8) CALL DPWRST('XXX','BUG ') IF(NCSTR.LE.0)GOTO9027 DO9025I=1,NCSTR CCCCC IASCNE=ICHAR(ICSTR(I:I)) CALL DPCOAN(ICSTR(I:I),IASCNE) WRITE(ICOUT,9026)I,ICSTR(I:I),IASCNE 9026 FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8) CALL DPWRST('XXX','BUG ') 9025 CONTINUE 9027 CONTINUE WRITE(ICOUT,9029)IBUGG4,ISUBG4,IERRG4 9029 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE GRDETH(ICTEXT,NCTEXT, 1IFONT,IDIR,ANGLE, 1JFONT,JDIR,ANGLE2, 1PHEIGH,PWIDTH,PVEGAP,PHOGAP, 1JSIZE, 1JHEIG2,JWIDT2,JVEGA2,JHOGA2, 1PHEIG2,PWIDT2,PVEGA2,PHOGA2, 1PXLEC,PXLECG,PYLEC,PYLECG) C C PURPOSE--FOR A SPECIFIC GRAPHICS DEVICE, C FOR THE STANDARD (SPECIFIC) FONT, C AND FOR THE HORIZONTAL DIRECTION, C DETERMINE THE LENGTH OF THE TEXT STRING IN THE C CHARACTER VECTOR ICTEXT(.), C WHICH CONSISTS OF NTEXT CHARACTERS. C NOTE--THE LENGTH IS IN STANDARDIZED COORDINATES C THAT IS, 0.0 TO 100.0 C C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-921-3651 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONCTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--83.6 C ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY 1983. C UPDATED --JANUARY 1989. SUN (BY BILL ANDERSON) C DRIVER OBSOLETE C UPDATED --JANUARY 1989. POSTSCRIPT (BY ALAN HECKERT) C UPDATED --JANUARY 1989. CGM (BY ALAN HECKERT) C UPDATED --JANUARY 1989. QMS QUIC (BY ALAN HECKERT) C UPDATED --JANUARY 1989. CALCOMP (BY ALAN HECKERT) C UPDATED --JANUARY 1989. ZETA (BY ALAN HECKERT) C UPDATED --MARCH 1990. X11 (BY ALAN HECKERT) C UPDATED --MAY 1991. RENUMBER TOP BRANCHES (JJF) C UPDATED --MAY 1991. VGA/TURBOC DRIVER (JJF) C DRIVER OBSOLETE C UPDATED --JULY 1996. LAHEY DRIVER (ALAN HECKERT) C OLD CALCOMP STYLE C DRIVER OBSOLETE C UPDATED --OCTOBER 1996. QUICKWIN DRIVER (ALAN) C UPDATED --OCTOBER 1996. OPENGL DRIVER (ALAN) C USE BILL MITCHELLS OPENGL C BINDING FOR FORTRAN C UPDATED --OCTOBER 1996. GKS (ALAN) C CODED, NOT TESTED C UPDATED --OCTOBER 1996. BINARY CGM (ALAN) C PLACEHOLDER FOR NOW C UPDATED --OCTOBER 1996. DISPLAY POSTSCRIPT (ALAN) C PLACEHOLDER FOR NOW C UPDATED --OCTOBER 1997. LAHEY INTERACTOR (ALAN) C UPDATED --JULY 1998. LAHEY WINTERACTOR C UPDATED --JUNE 2000. GD (FOR JPEG, PNG, WINDOWS BMP) C UPDATED --JUNE 2000. MACINTOSH C PLACEHOLDER FOR NOW C UPDATED --JUNE 2000. PC PRINTER C PLACEHOLDER FOR NOW C UPDATED --MARCH 2005. SUPPORT FOR AQUATERM C C-----NON-COMMON VARIABLES (GRAPHICS)------------------------------------------- C CWINT USE WINTERACTER CINTE USE INTERACTER CHARACTER*4 ICTEXT CHARACTER*4 IFONT CHARACTER*4 IDIR C DIMENSION ICTEXT(*) C C-----COMMON---------------------------------------------------------- C INCLUDE 'DPCOGR.INC' INCLUDE 'DPCOBE.INC' INCLUDE 'DPCODV.INC' INCLUDE 'DPCOST.INC' C C-----COMMON VARIABLES (GENERAL)-------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DETH')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF GRDETH--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,54)NCTEXT 54 FORMAT('NCTEXT = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,55)(ICTEXT(I),I=1,NCTEXT) 55 FORMAT('(ICTEXT(I),I=1,NCTEXT) = ',25A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,61)IFONT,JFONT 61 FORMAT('IFONT,JFONT= ',A4,I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,62)IDIR,JDIR 62 FORMAT('IDIR,JDIR= ',A4,I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,64)ANGLE,ANGLE2 64 FORMAT('ANGLE,ANGLE2= ',E15.7,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,67)PHEIGH,JHEIG2,PHEIG2 67 FORMAT('PHEIGH,JHEIG2,PHEIG2= ',E15.7,I8,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,68)PWIDTH,JWIDT2,PWIDT2 68 FORMAT('PWIDTH,JWIDT2,PWIDT2= ',E15.7,I8,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,69)PVEGAP,JVEGA2,PVEGA2 69 FORMAT('PVEGAP,JVEGA2,PVEGA2= ',E15.7,I8,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,70)PHOGAP,JHOGA2,PHOGA2 70 FORMAT('PHOGAP,JHOGA2,PHOGA2= ',E15.7,I8,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,71)JSIZE 71 FORMAT('JSIZE= ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,73)PXLEC,PXLECG 73 FORMAT('PXLEC,PXLECG= ',E15.7,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,74)PYLEC,PYLECG 74 FORMAT('PYLEC,PYLECG= ',E15.7,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,79)IBUGG4,ISUBG4,IERRG4 79 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') 90 CONTINUE C C ***************************************************** C ** APRIL, 1988. GENERIC CASE FOR FIXED SPACE FONT** C ***************************************************** C ANCTEX=NCTEXT PXLEC=(ANCTEX-1.0)*(PWIDT2+PHOGA2)+PWIDT2 PXLECG=ANCTEX*(PWIDT2+PHOGA2) PYLEC=PHEIG2 PYLECG=PHEIG2+PVEGA2 C C C ******************************************** C ** STEP 1-- ** C ** BRANCH ACCORDING TO THE MANUFACTURER ** C ** AND THE MODEL ** C ******************************************** C IF(IMANUF.EQ.'TEKT')GOTO1005 IF(IMANUF.EQ.'HP')GOTO1010 IF(IMANUF.EQ.'PCL')GOTO1015 IF(IMANUF.EQ.'GENE')GOTO1020 IF(IMANUF.EQ.'CALC')GOTO1025 IF(IMANUF.EQ.'ZETA')GOTO1030 IF(IMANUF.EQ.'RAMT')GOTO1035 IF(IMANUF.EQ.'SUN ')GOTO1040 IF(IMANUF.EQ.'XXXX')GOTO1045 IF(IMANUF.EQ.'REGI')GOTO1050 IF(IMANUF.EQ.'POST')GOTO1055 IF(IMANUF.EQ.'QUIC')GOTO1060 IF(IMANUF.EQ.'X11 ')GOTO1065 IF(IMANUF.EQ.'TURB')GOTO1070 IF(IMANUF.EQ.'GKS ')GOTO1075 IF(IMANUF.EQ.'LAHE')GOTO1080 IF(IMANUF.EQ.'GD ')GOTO1085 IF(IMANUF.EQ.'QWIN')GOTO1090 IF(IMANUF.EQ.'AQUA')GOTO1091 IF(IMANUF.EQ.'OPGL')GOTO1095 IF(IMANUF.EQ.'PRIN')GOTO1096 IF(IMANUF.EQ.'MACI')GOTO1098 GOTO9000 C 1005 CONTINUE IF(IMODEL.EQ.'4662')GOTO1100 C IF(IMODEL.EQ.'4027')GOTO1200 C IF(IMODEL.EQ.'4105')GOTO1300 IF(IMODEL.EQ.'4107')GOTO1300 IF(IMODEL.EQ.'4109')GOTO1300 IF(IMODEL.EQ.'4115')GOTO1300 IF(IMODEL.EQ.'4107')GOTO1300 IF(IMODEL.EQ.'4113')GOTO1300 C GOTO9000 C 1010 CONTINUE IF(IMODEL.EQ.'7221')GOTO2100 IF(IMODEL.EQ.'2622')GOTO2300 IF(IMODEL.EQ.'2623')GOTO2300 IF(IMODEL.EQ.'2627')GOTO2300 IF(IMODEL.EQ.'2647')GOTO2300 GOTO2200 C 1015 CONTINUE GOTO2600 C 1020 CONTINUE IF(IMODEL.EQ.'CODE')GOTO3200 IF(IMODEL.EQ.'CGM')GOTO3300 IF(IMODEL.EQ.'CGMB')GOTO3400 GOTO3100 C 1025 CONTINUE GOTO4100 C 1030 CONTINUE GOTO5100 C 1035 CONTINUE GOTO6100 C 1040 CONTINUE GOTO6600 C 1045 CONTINUE GOTO7100 C 1050 CONTINUE GOTO8100 C 1055 CONTINUE GOTO8600 C 1060 CONTINUE GOTO9100 C 1065 CONTINUE GOTO9600 C 1070 CONTINUE GOTO10000 C 1075 CONTINUE GOTO11000 C 1080 CONTINUE IF(IMODEL.EQ.'INTE')GOTO4900 IF(IMODEL.EQ.'WINT')GOTO4950 GOTO4600 C 1085 CONTINUE IF(IMODEL.EQ.'JPEG')GOTO12000 IF(IMODEL.EQ.'PNG ')GOTO12000 IF(IMODEL.EQ.'WBMP')GOTO12000 IF(IMODEL.EQ.'GIF')GOTO12000 GOTO12000 C 1090 CONTINUE GOTO4700 C 1091 CONTINUE GOTO13500 C 1095 CONTINUE GOTO4800 C 1096 CONTINUE GOTO14000 C 1098 CONTINUE GOTO13000 C C ****************************************************** C ** STEP 11-- ** C ** TREAT THE TEKTRONIX 4662 ** C ** (A PENPLOTTER). ** C ** REFERENCE--XXX ** C ****************************************************** C 1100 CONTINUE GOTO9000 C C ************************************************************** C ** STEP 12-- ** C ** TREAT THE TEKTRONIX 4027 CASE ** C ** (COLOR RASTER DEVICES). ** C ** REFERENCE--XXX ** C ************************************************************** C 1200 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 13-- ** C ** TREAT THE TEKTRONIX 4105 ** C ** (COLOR RASTER DEVICE). ** C ** REFERENCE--PAGE XXXX (LINE), XXXX (TEXT), ** C ** XXXX (REGION) ** C ****************************************************** C 1300 CONTINUE GOTO9000 C ****************************************************** C ** STEP 21-- ** C ** TREAT THE HEWLETT-PACKARD 7221 CASE ** C ** (MULTI-COLOR PENPLOTTER) ** C ** REFERENCE--HP 7221A GRAPHICS PLOTTER ** C ** OPERATING AND PROGRAMMING MANUAL, ** C ** PAGE 73. ** C ****************************************************** C 2100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 22-- ** C ** TREAT THE HEWLETT-PACKARD HP-GL CASES ** C ** (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS) ** C ** (MULTI-COLOR PENPLOTTERS) ** C ** DEFAULT NO-OP END-OF-INSTRUCTION TERMINATOR). ** C ** REFERENCE--HP 9872C GRAPHICS PLOTTER ** C ** OPERATING AND PROGRAMMING MANUAL, ** C ** PAGE XX, XXX. ** C ****************************************************** C 2200 CONTINUE GOTO9000 C C ********************************************************** C ** STEP 23-- ** C ** TREAT THE HEWLETT-PACKARD HP-2622 CASES ** C ** (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS) ** C ** (MONOCHROME DISPLAY TERMINALS) ** C ** REFERENCE--HP 2322C GRAPHICS PLOTTER ** C ** REFERENCE MANUAL, ** C ** PAGE 10-10, XXX. ** C ********************************************************** C 2300 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 26-- ** C ** TREAT THE PCL CASE (HP-LASERJET II LASER PRINTER)* C ****************************************************** C 2600 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 31-- ** C ** TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE ** C ****************************************************** C 3100 CONTINUE GOTO9000 C C *************************************************************** C ** STEP 32-- ** C ** TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE ** C *************************************************************** C 3200 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 33-- ** C ** TREAT THE CGM CASE ** C ****************************************************** C 3300 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 33-- ** C ** TREAT THE CGM (BINARY) CASE ** C ****************************************************** C 3400 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 41-- ** C ** TREAT THE CALCOMP XXXXXX CASE ** C ** TO SET FILL-- ** C ** WRITE OUT AN XXXXXXXXXX ** C ** (NOT DONE) ** C ** REFERENCE--XX ** C ** XX ** C ** PAGES XX AND XX ** C ****************************************************** C 4100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 46-- ** C ** TREAT THE LAHEY XXXXXX CASE ** C ** REFERENCE--Programmer's Reference, Revision C ** C ** Lahey Computer Systems, January, 1992** C ** PAGES 51 THRU 65 ** C ****************************************************** C 4600 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 47-- ** C ** TREAT THE MICROSOFT QUICKWIN DRIVER ** C ** FOR WINDOWS 95 AND WINDOWS NT. ** C ****************************************************** C 4700 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 48-- ** C ** TREAT THE OPEN-GL DRIVER ** C ** FOR WINDOWS 95 AND WINDOWS NT AND X11 ** C ****************************************************** C 4800 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 49-- ** C ** TREAT THE LAHEY INTERACTOR CASE ** C ****************************************************** C 4900 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 49B- ** C ** TREAT THE LAHEY WINTERACTOR CASE ** C ****************************************************** C 4950 CONTINUE GOTO9000 C C C ****************************************************** C ** STEP 51-- ** C ** TREAT THE ZETA 3600SX AND 3653SX CASES ** C ** REFERENCE--USER MANUAL FOR DIGITAL PLOTTER ** C ** MODELS 3600SX AND 3653SX ** C ** PAGES B-0 AND B-1 ** C ****************************************************** C 5100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 61-- ** C ** TREAT THE RAMTEK XXXXXX CASE ** C ** TO SET FILL-- ** C ** WRITE OUT AN XXXXXXXXXX ** C ** (NOT DONE) ** C ** REFERENCE--XX ** C ** XX ** C ** PAGES XX AND XX ** C ****************************************************** C 6100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 66-- ** C ** TREAT THE SUN CASE ** C ****************************************************** C 6600 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 71-- ** C ** TREAT THE XXXXXX XXXXXX CASE ** C ** TO SET FILL-- ** C ** WRITE OUT AN XXXXXXXXXX ** C ** (NOT DONE) ** C ** REFERENCE--XX ** C ** XX ** C ** PAGES XX AND XX ** C ****************************************************** C 7100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 81-- ** C ** TREAT THE REGIS CASE ** C ****************************************************** C 8100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 86-- ** C ** TREAT THE POSTSCRIPT CASE ** C ****************************************************** C 8600 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 89-- ** C ** TREAT THE DISPLAY POSTSCRIPT DRIVER ** C ****************************************************** C 8900 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 91-- ** C ** TREAT THE QUIC CASE ** C ** SUPPORT THE PROPORTIONAL FONTS THAT ARE ** C ** "HARD-CODED" IN THE QMS. ** C ** ** C ****************************************************** C 9100 CONTINUE ANUMPP=ANUMHP IFONTT=IQUIFN IF(IORNSW.EQ.'PORT'.AND.( 1IFONTT.EQ.521.OR. 1IFONTT.EQ.522.OR. 1IFONTT.EQ.523.OR. 1IFONTT.EQ.524))IFONTT=10 IF(IORNSW.NE.'PORT'.AND.( 1IFONTT.EQ.124.OR. 1IFONTT.EQ.144.OR. 1IFONTT.EQ.16.OR. 1IFONTT.EQ.328.OR. 1IFONTT.EQ.998.OR. 1IFONTT.EQ.404.OR. 1IFONTT.EQ.444.OR. 1IFONTT.EQ.532))IFONTT=10 IF(IFONTT.EQ.10)GOTO9000 IF(IFONTT.EQ.404)GOTO9000 IF(IFONTT.EQ.444)GOTO9000 IF(IFONTT.EQ.521)GOTO9000 IF(IFONTT.EQ.522)GOTO9000 IF(IFONTT.EQ.523)GOTO9000 IF(IFONTT.EQ.524)GOTO9000 IF(IFONTT.EQ.532)GOTO9000 IF(IFONTT.EQ.517)GOTO9000 IF(IFONTT.EQ.536)GOTO9000 IF(IFONTT.EQ.904)GOTO9000 IF(IFONTT.EQ.924)GOTO9000 IF(IFONTT.EQ.104)CALL QUICH1(ICTEXT,NCTEXT,PXLEC,PXLECG,ANUMPP) IF(IFONTT.EQ.124)CALL QUICH2(ICTEXT,NCTEXT,PXLEC,PXLECG,ANUMPP) IF(IFONTT.EQ.144)CALL QUICH3(ICTEXT,NCTEXT,PXLEC,PXLECG,ANUMPP) IF(IFONTT.EQ.16) CALL QUICH4(ICTEXT,NCTEXT,PXLEC,PXLECG,ANUMPP) IF(IFONTT.EQ.204)CALL QUICH5(ICTEXT,NCTEXT,PXLEC,PXLECG,ANUMPP) IF(IFONTT.EQ.328)CALL QUICH6(ICTEXT,NCTEXT,PXLEC,PXLECG,ANUMPP) IF(IFONTT.EQ.998)CALL QUICH7(ICTEXT,NCTEXT,PXLEC,PXLECG,ANUMPP) IF(IFONTT.EQ.664)CALL QUICH8(ICTEXT,NCTEXT,PXLEC,PXLECG,ANUMPP) GOTO9000 C C ****************************************************** C ** STEP 96-- ** C ** TREAT THE X11 CASE ** C ****************************************************** C 9600 CONTINUE GOTO9000 C C ************************************************* C ** STEP 100-- ** C ** TREAT THE VGA VIA TURBO-C CASE ** C ************************************************* C 10000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 110-- ** C ** TREAT THE GKS DRIVER ** C ****************************************************** C 11000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 120-- ** C ** TREAT THE GD DRIVER ** C ** THIS LIBRARY PROVIDES SUPPORT FOR: ** C ** 1) JPEG ** C ** 2) PNG ** C ** 3) WINDOWS BMP (BLACK/WHITE ONLY) ** C ****************************************************** C 12000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 130-- ** C ** TREAT THE MACINTOSH DRIVER ** C ** LIBRARY FROM ABSOFT COMPILER ** C ****************************************************** C 13000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 135-- ** C ** TREAT THE MAC OSX AQUATERM DRIVER ** C ****************************************************** C 13500 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 140-- ** C ** TREAT THE PC PRINTER DRIVER ** C ****************************************************** C 14000 CONTINUE GOTO9000 C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DETH')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF GRDETH--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)NCTEXT 9014 FORMAT('NCTEXT = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9015)(ICTEXT(I),I=1,NCTEXT) 9015 FORMAT('(ICTEXT(I),I=1,NCTEXT) = ',25A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9021)IFONT,JFONT 9021 FORMAT('IFONT,JFONT= ',A4,I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9022)IDIR,JDIR 9022 FORMAT('IDIR,JDIR= ',A4,I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9024)ANGLE,ANGLE2 9024 FORMAT('ANGLE,ANGLE2= ',E15.7,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9027)PHEIGH,JHEIG2,PHEIG2 9027 FORMAT('PHEIGH,JHEIG2,PHEIG2= ',E15.7,I8,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9028)PWIDTH,JWIDT2,PWIDT2 9028 FORMAT('PWIDTH,JWIDT2,PWIDT2= ',E15.7,I8,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9029)PVEGAP,JVEGA2,PVEGA2 9029 FORMAT('PVEGAP,JVEGA2,PVEGA2= ',E15.7,I8,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9030)PHOGAP,JHOGA2,PHOGA2 9030 FORMAT('PHOGAP,JHOGA2,PHOGA2= ',E15.7,I8,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9031)JSIZE 9031 FORMAT('JSIZE= ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9033)PXLEC,PXLECG 9033 FORMAT('PXLEC,PXLECG= ',E15.7,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9034)PYLEC,PYLECG 9034 FORMAT('PYLEC,PYLECG= ',E15.7,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9039)IBUGG4,ISUBG4,IERRG4 9039 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE GRDETV(ICTEXT,NCTEXT, 1IFONT,IDIR,ANGLE, 1JFONT,JDIR,ANGLE2, 1PHEIGH,PWIDTH,PVEGAP,PHOGAP, 1JSIZE, 1JHEIG2,JWIDT2,JVEGA2,JHOGA2, 1PHEIG2,PWIDT2,PVEGA2,PHOGA2, 1PXLEC,PXLECG,PYLEC,PYLECG) C C PURPOSE--FOR A SPECIFIC GRAPHICS DEVICE, C FOR THE STANDARD (TEKTRONIX) FONT, C AND FOR THE VERTICAL DIRECTION, C DETERMINE THE LENGTH OF THE TEXT STRING IN THE C CHARACTER VECTOR ICTEXT(.), C WHICH CONSISTS OF NTEXT CHARACTERS. C NOTE--THE LENGTH IS IN STANDARDIZED COORDINATES C THAT IS, 0.0 TO 100.0 C C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-921-3651 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONCTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--83.6 C ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY 1983. C UPDATED --JANUARY 1989. SUN (BY BILL ANDERSON) C DRIVER OBSOLETE C UPDATED --JANUARY 1989. POSTSCRIPT (BY ALAN HECKERT) C UPDATED --JANUARY 1989. CGM (BY ALAN HECKERT) C UPDATED --JANUARY 1989. QMS QUIC (BY ALAN HECKERT) C UPDATED --JANUARY 1989. CALCOMP (BY ALAN HECKERT) C UPDATED --JANUARY 1989. ZETA (BY ALAN HECKERT) C UPDATED --MARCH 1990. X11 (BY ALAN HECKERT) C UPDATED --MAY 1991. RENUMBER TOP BRANCHES (JJF) C UPDATED --MAY 1991. VGA/TURBOC DRIVER (JJF) C DRIVER OBSOLETE C UPDATED --JULY 1996. LAHEY DRIVER (ALAN HECKERT) C DRIVER OBSOLETE C UPDATED --OCTOBER 1996. QUICKWIN DRIVER (ALAN) C UPDATED --OCTOBER 1996. OPENGL DRIVER (ALAN) C USE BILL MITCHELLS OPENGL C BINDING FOR FORTRAN C UPDATED --OCTOBER 1996. GKS (ALAN) C CODED, NOT TESTED C UPDATED --OCTOBER 1996. BINARY CGM (ALAN) C PLACEHOLDER FOR NOW C UPDATED --OCTOBER 1996. DISPLAY POSTSCRIPT (ALAN) C PLACEHOLDER FOR NOW C UPDATED --OCTOBER 1997. LAHEY INTERACTOR (ALAN) C UPDATED --JULY 1998. LAHEY WINTERACTOR C UPDATED --JUNE 2000. GD (FOR JPEG, PNG, WINDOWS BMP) C UPDATED --JUNE 2000. MACINTOSH C PLACEHOLDER FOR NOW C UPDATED --JUNE 2000. PC PRINTER C PLACEHOLDER FOR NOW C UPDATED --MARCH 2005. SUPPORT FOR AQUATERM C C-----NON-COMMON VARIABLES (GRAPHICS)------------------------------------------- C CWINT USE WINTERACTER CINTE USE INTERACTER CHARACTER*4 ICTEXT CHARACTER*4 IFONT CHARACTER*4 IDIR C DIMENSION ICTEXT(*) C C-----COMMON---------------------------------------------------------- C INCLUDE 'DPCOGR.INC' INCLUDE 'DPCOBE.INC' INCLUDE 'DPCODV.INC' INCLUDE 'DPCOST.INC' C C-----COMMON VARIABLES (GENERAL)-------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DETV')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF GRDETV--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,54)NCTEXT 54 FORMAT('NCTEXT = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,55)(ICTEXT(I),I=1,NCTEXT) 55 FORMAT('(ICTEXT(I),I=1,NCTEXT) = ',25A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,61)IFONT,JFONT 61 FORMAT('IFONT,JFONT= ',A4,I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,62)IDIR,JDIR 62 FORMAT('IDIR,JDIR= ',A4,I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,64)ANGLE,ANGLE2 64 FORMAT('ANGLE,ANGLE2= ',E15.7,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,67)PHEIGH,JHEIG2,PHEIG2 67 FORMAT('PHEIGH,JHEIG2,PHEIG2= ',E15.7,I8,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,68)PWIDTH,JWIDT2,PWIDT2 68 FORMAT('PWIDTH,JWIDT2,PWIDT2= ',E15.7,I8,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,69)PVEGAP,JVEGA2,PVEGA2 69 FORMAT('PVEGAP,JVEGA2,PVEGA2= ',E15.7,I8,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,70)PHOGAP,JHOGA2,PHOGA2 70 FORMAT('PHOGAP,JHOGA2,PHOGA2= ',E15.7,I8,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,71)JSIZE 71 FORMAT('JSIZE= ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,73)PXLEC,PXLECG 73 FORMAT('PXLEC,PXLECG= ',E15.7,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,74)PYLEC,PYLECG 74 FORMAT('PYLEC,PYLECG= ',E15.7,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,79)IBUGG4,ISUBG4,IERRG4 79 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') 90 CONTINUE C C ***************************************************** C ** APRIL, 1988. GENERIC CASE FOR FIXED SPACE FONT** C ***************************************************** C ANCTEX=NCTEXT PXLEC=PWIDT2 PXLECG=PWIDT2+PHOGA2 PYLEC=(ANCTEX-1.0)*(PHEIG2+PVEGA2)+PHEIG2 PYLECG=ANCTEX*(PHEIG2+PVEGA2) C C C C ******************************************** C ** STEP 1-- ** C ** BRANCH ACCORDING TO THE MANUFACTURER ** C ** AND THE MODEL ** C ******************************************** C IF(IMANUF.EQ.'TEKT')GOTO1005 IF(IMANUF.EQ.'HP')GOTO1010 IF(IMANUF.EQ.'PCL')GOTO1015 IF(IMANUF.EQ.'GENE')GOTO1020 IF(IMANUF.EQ.'CALC')GOTO1025 IF(IMANUF.EQ.'ZETA')GOTO1030 IF(IMANUF.EQ.'RAMT')GOTO1035 IF(IMANUF.EQ.'SUN ')GOTO1040 IF(IMANUF.EQ.'XXXX')GOTO1045 IF(IMANUF.EQ.'REGI')GOTO1050 IF(IMANUF.EQ.'POST')GOTO1055 IF(IMANUF.EQ.'QUIC')GOTO1060 IF(IMANUF.EQ.'X11 ')GOTO1065 IF(IMANUF.EQ.'TURB')GOTO1070 IF(IMANUF.EQ.'GKS ')GOTO1075 IF(IMANUF.EQ.'LAHE')GOTO1080 IF(IMANUF.EQ.'GD ')GOTO1085 IF(IMANUF.EQ.'QWIN')GOTO1090 IF(IMANUF.EQ.'AQUA')GOTO1091 IF(IMANUF.EQ.'OPGL')GOTO1095 IF(IMANUF.EQ.'PRIN')GOTO1096 IF(IMANUF.EQ.'MACI')GOTO1098 GOTO9000 C 1005 CONTINUE IF(IMODEL.EQ.'4662')GOTO1100 C IF(IMODEL.EQ.'4027')GOTO1200 C IF(IMODEL.EQ.'4105')GOTO1300 IF(IMODEL.EQ.'4107')GOTO1300 IF(IMODEL.EQ.'4109')GOTO1300 IF(IMODEL.EQ.'4115')GOTO1300 IF(IMODEL.EQ.'4107')GOTO1300 IF(IMODEL.EQ.'4113')GOTO1300 C GOTO9000 C 1010 CONTINUE IF(IMODEL.EQ.'7221')GOTO2100 IF(IMODEL.EQ.'2622')GOTO2300 IF(IMODEL.EQ.'2623')GOTO2300 IF(IMODEL.EQ.'2627')GOTO2300 IF(IMODEL.EQ.'2647')GOTO2300 GOTO2200 C 1015 CONTINUE GOTO2600 C 1020 CONTINUE IF(IMODEL.EQ.'CODE')GOTO3200 IF(IMODEL.EQ.'CGM')GOTO3300 IF(IMODEL.EQ.'CGMB')GOTO3400 GOTO3100 C 1025 CONTINUE GOTO4100 C 1030 CONTINUE GOTO5100 C 1035 CONTINUE GOTO6100 C 1040 CONTINUE GOTO6600 C 1045 CONTINUE GOTO7100 C 1050 CONTINUE GOTO8100 C 1055 CONTINUE IF(IMODEL.EQ.'DISP')GOTO8900 GOTO8600 C 1060 CONTINUE GOTO9100 C 1065 CONTINUE GOTO9600 C 1070 CONTINUE GOTO10000 C 1075 CONTINUE GOTO11000 C 1080 CONTINUE IF(IMODEL.EQ.'INTE')GOTO4900 IF(IMODEL.EQ.'WINT')GOTO4950 GOTO4600 C 1085 CONTINUE IF(IMODEL.EQ.'JPEG')GOTO12000 IF(IMODEL.EQ.'PNG ')GOTO12000 IF(IMODEL.EQ.'WBMP')GOTO12000 IF(IMODEL.EQ.'GIF')GOTO12000 GOTO12000 C 1090 CONTINUE GOTO4700 C 1091 CONTINUE GOTO13500 C 1095 CONTINUE GOTO4800 C 1096 CONTINUE GOTO14000 C 1098 CONTINUE GOTO13000 C C ****************************************************** C ** STEP 11-- ** C ** TREAT THE TEKTRONIX 4662 ** C ** (A PENPLOTTER). ** C ** REFERENCE--XXX ** C ****************************************************** C 1100 CONTINUE GOTO9000 C C ************************************************************** C ** STEP 12-- ** C ** TREAT THE TEKTRONIX 4027 CASE ** C ** (COLOR RASTER DEVICES). ** C ** REFERENCE--XXX ** C ************************************************************** C 1200 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 13-- ** C ** TREAT THE TEKTRONIX 4105 ** C ** (COLOR RASTER DEVICE). ** C ** REFERENCE--PAGE XXXX (LINE), XXXX (TEXT), ** C ** XXXX (REGION) ** C ****************************************************** C 1300 CONTINUE GOTO9000 C ****************************************************** C ** STEP 21-- ** C ** TREAT THE HEWLETT-PACKARD 7221 CASE ** C ** (MULTI-COLOR PENPLOTTER) ** C ** REFERENCE--HP 7221A GRAPHICS PLOTTER ** C ** OPERATING AND PROGRAMMING MANUAL, ** C ** PAGE 73. ** C ****************************************************** C 2100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 22-- ** C ** TREAT THE HEWLETT-PACKARD HP-GL CASES ** C ** (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS) ** C ** (MULTI-COLOR PENPLOTTERS) ** C ** DEFAULT NO-OP END-OF-INSTRUCTION TERMINATOR). ** C ** REFERENCE--HP 9872C GRAPHICS PLOTTER ** C ** OPERATING AND PROGRAMMING MANUAL, ** C ** PAGE XX, XXX. ** C ****************************************************** C 2200 CONTINUE GOTO9000 C C ********************************************************** C ** STEP 23-- ** C ** TREAT THE HEWLETT-PACKARD HP-2622 CASES ** C ** (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS) ** C ** (MONOCHROME DISPLAY TERMINALS) ** C ** REFERENCE--HP 2322C GRAPHICS PLOTTER ** C ** REFERENCE MANUAL, ** C ** PAGE 10-10, XXX. ** C ********************************************************** C 2300 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 26-- ** C ** TREAT THE PCL CASE (HP-LASERJET II LASER PRINTER)* C ****************************************************** C 2600 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 31-- ** C ** TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE ** C ****************************************************** C 3100 CONTINUE GOTO9000 C C *************************************************************** C ** STEP 32-- ** C ** TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE ** C *************************************************************** C 3200 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 33-- ** C ** TREAT THE CGM CASE ** C ****************************************************** C 3300 CONTINUE GOTO9000 C C *************************************************** C ** STEP 34-- ** C ** TREAT THE CGM (BINARY) CASE ** C *************************************************** C 3400 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 41-- ** C ** TREAT THE CALCOMP XXXXXX CASE ** C ** VERTICAL TEXT STRINGS WILL BE ROTATED ** C ** REFERENCE--USE CALCOMP LIBRARY ROUTINES ** C ** XX ** C ** PAGES XX AND XX ** C ****************************************************** C 4100 CONTINUE ANCTEX=NCTEXT PYLEC=PHEIG2 PYLECG=PHEIG2+PVEGA2 PXLEC=(ANCTEX-1.0)*(PWIDT2+PHOGA2)+PWIDT2 PXLECG=ANCTEX*(PWIDT2+PHOGA2) GOTO9000 C C ****************************************************** C ** STEP 46-- ** C ** TREAT THE LAHEY XXXXXX CASE ** C ** REFERENCE--Programmer's Reference, Revision C ** C ** Lahey Computer Systems, January, 1992** C ** PAGES 51 THRU 65 ** C ****************************************************** C 4600 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 47-- ** C ** TREAT THE MICROSOFT QUICKWIN DRIVER ** C ** FOR WINDOWS 95 AND WINDOWS NT. ** C ****************************************************** C 4700 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 48-- ** C ** TREAT THE OPEN-GL DRIVER ** C ** FOR WINDOWS 95 AND WINDOWS NT AND X11 ** C ****************************************************** C 4800 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 49-- ** C ** TREAT THE LAHEY INTERACTOR CASE ** C ****************************************************** C 4900 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 49B- ** C ** TREAT THE LAHEY WINTERACTOR CASE ** C ****************************************************** C 4950 CONTINUE GOTO9000 C C C ****************************************************** C ** STEP 51-- ** C ** TREAT THE ZETA 3600SX AND 3653SX CASES ** C ** REFERENCE--USER MANUAL FOR DIGITAL PLOTTER ** C ** MODELS 3600SX AND 3653SX ** C ** PAGES B-0 AND B-1 ** C ****************************************************** C 5100 CONTINUE ANCTEX=NCTEXT PYLEC=PHEIG2 PYLECG=PHEIG2+PVEGA2 PXLEC=(ANCTEX-1.0)*(PWIDT2+PHOGA2)+PWIDT2 PXLECG=ANCTEX*(PWIDT2+PHOGA2) GOTO9000 C C ****************************************************** C ** STEP 61-- ** C ** TREAT THE RAMTEK XXXXXX CASE ** C ** TO SET FILL-- ** C ** WRITE OUT AN XXXXXXXXXX ** C ** (NOT DONE) ** C ** REFERENCE--XX ** C ** XX ** C ** PAGES XX AND XX ** C ****************************************************** C 6100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 66-- ** C ** TREAT THE SUN CASE ** C ****************************************************** C 6600 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 71-- ** C ** TREAT THE XXXXXX XXXXXX CASE ** C ** TO SET FILL-- ** C ** WRITE OUT AN XXXXXXXXXX ** C ** (NOT DONE) ** C ** REFERENCE--XX ** C ** XX ** C ** PAGES XX AND XX ** C ****************************************************** C 7100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 81-- ** C ** TREAT THE REGIS CASE ** C ****************************************************** C 8100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 86-- ** C ** TREAT THE POSTSCRIPT CASE ** C ****************************************************** C 8600 CONTINUE ANCTEX=NCTEXT PYLEC=PHEIG2 PYLECG=PHEIG2+PVEGA2 PXLEC=(ANCTEX-1.0)*(PWIDT2+PHOGA2)+PWIDT2 PXLECG=ANCTEX*(PWIDT2+PHOGA2) GOTO9000 C C ****************************************************** C ** STEP 89-- ** C ** TREAT THE DISPLAY POSTSCRIPT DRIVER ** C ****************************************************** C 8900 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 91-- ** C ** TREAT THE QUIC CASE ** C ** SUPPORT THE PROPORTIONAL FONTS THAT ARE ** C ** "HARD-CODED" IN THE QMS. ** C ** ** C ****************************************************** C 9100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 96-- ** C ** TREAT THE X11 CASE ** C ****************************************************** C 9600 CONTINUE GOTO9000 C C ************************************************* C ** STEP 100-- ** C ** TREAT THE VGA VIA TURBO-C CASE ** C ************************************************* C 10000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 110-- ** C ** TREAT THE GKS DRIVER ** C ****************************************************** C 11000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 120-- ** C ** TREAT THE GD DRIVER ** C ** THIS LIBRARY PROVIDES SUPPORT FOR: ** C ** 1) JPEG ** C ** 2) PNG ** C ** 3) WINDOWS BMP (BLACK/WHITE ONLY) ** C ****************************************************** C 12000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 130-- ** C ** TREAT THE MACINTOSH DRIVER ** C ** LIBRARY FROM ABSOFT COMPILER ** C ****************************************************** C 13000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 135-- ** C ** TREAT THE MAC OSX AQUATERM DRIVER ** C ****************************************************** C 13500 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 140-- ** C ** TREAT THE PC PRINTER DRIVER ** C ****************************************************** C 14000 CONTINUE GOTO9000 C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DETV')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF GRDETV--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)NCTEXT 9014 FORMAT('NCTEXT = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9015)(ICTEXT(I),I=1,NCTEXT) 9015 FORMAT('(ICTEXT(I),I=1,NCTEXT) = ',25A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9021)IFONT,JFONT 9021 FORMAT('IFONT,JFONT= ',A4,I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9022)IDIR,JDIR 9022 FORMAT('IDIR,JDIR= ',A4,I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9024)ANGLE,ANGLE2 9024 FORMAT('ANGLE,ANGLE2= ',E15.7,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9027)PHEIGH,JHEIG2,PHEIG2 9027 FORMAT('PHEIGH,JHEIG2,PHEIG2= ',E15.7,I8,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9028)PWIDTH,JWIDT2,PWIDT2 9028 FORMAT('PWIDTH,JWIDT2,PWIDT2= ',E15.7,I8,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9029)PVEGAP,JVEGA2,PVEGA2 9029 FORMAT('PVEGAP,JVEGA2,PVEGA2= ',E15.7,I8,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9030)PHOGAP,JHOGA2,PHOGA2 9030 FORMAT('PHOGAP,JHOGA2,PHOGA2= ',E15.7,I8,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9031)JSIZE 9031 FORMAT('JSIZE= ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9033)PXLEC,PXLECG 9033 FORMAT('PXLEC,PXLECG= ',E15.7,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9034)PYLEC,PYLECG 9034 FORMAT('PYLEC,PYLECG= ',E15.7,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9039)IBUGG4,ISUBG4,IERRG4 9039 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE GRDRLI(IX1,IY1,IX2,IY2,PX1,PY1,PX2,PY2,IFACTO,JCOL) C C PURPOSE--FOR A SPECIFIC GRAPHICS DEVICE, C DRAW A LINE FROM (IX1,IY1) TO (IX2,IY2). C NOTE--THE COORDINATES (IX1,IY1) AND (IX2,IY2) ARE IN C INTEGER PICTURE POINT VALUES. C C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C INFORMATION TECHNOLOGY LABORATORY C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY C GAITHERSBURG, MD 20899-8980 C PHONE--301-921-3651 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--83.6 C ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY 1983. C UPDATED --JANUARY 1989. SUN (BY BILL ANDERSON) C DRIVER OBSOLETE C UPDATED --JANUARY 1989. POSTSCRIPT (BY ALAN HECKERT) C UPDATED --JANUARY 1989. CGM (BY ALAN HECKERT) C UPDATED --JANUARY 1989. QMS QUIC (BY ALAN HECKERT) C UPDATED --JANUARY 1989. CALCOMP (BY ALAN HECKERT) C UPDATED --JANUARY 1989. ZETA (BY ALAN HECKERT) C UPDATED --MARCH 1990. X11 (BY ALAN HECKERT) C UPDATED --MAY 1991. BAD ARG IN 2 CALLS TO GRTRIN C UPDATED --MAY 1991. RENUMBER TOP BRANCHES (JJF) C UPDATED --MAY 1991. VGA/TURBOC DRIVER (JJF) C DRIVER OBSOLETE C UPDATED --MAY 1991. X2 TO IX2 FOR SUN (JJF) C UPDATED --APRIL 1992. ZETA FIX C UPDATED --JULY 1996. LAHEY DRIVER (ALAN HECKERT) C OLD CALCOMP STYLE C DRIVER OBSOLETE C UPDATED --OCTOBER 1996. QUICKWIN DRIVER (ALAN) C UPDATED --OCTOBER 1996. OPENGL DRIVER (ALAN) C USE BILL MITCHELLS OPENGL C BINDING FOR FORTRAN C UPDATED --OCTOBER 1996. GKS (ALAN) C CODED, NOT TESTED C UPDATED --OCTOBER 1996. BINARY CGM (ALAN) C PLACEHOLDER FOR NOW C UPDATED --OCTOBER 1996. DISPLAY POSTSCRIPT (ALAN) C PLACEHOLDER FOR NOW C UPDATED --OCTOBER 1997. LAHEY INTERACTOR (ALAN) C UPDATED --DECEMBER 1997. UPDATE TO GENERAL CODED FOR C GUI. C UPDATED --JULY 1998. LAHEY WINTERACTOR C UPDATED --JUNE 2000. GD (FOR JPEG, PNG, WINDOWS BMP) C UPDATED --JUNE 2000. MACINTOSH C PLACEHOLDER FOR NOW C --MARCH 2002. CHANGE TO QUARTZ (NEW MAC GRAPHICS C LIBRARY) C UPDATED --JUNE 2000. PC PRINTER C PLACEHOLDER FOR NOW C --MARCH 2002. CHANGE TO GHOSTSCRIPT C UPDATED --JUNE 2000. PC PRINTER C UPDATED --JULY 2001. ADD JCOL ARGUMENT (COLOR INDEX C FOR GD DEVICE) C UPDATED --MARCH 2002. LATEX (USING EEPIC) C PLACEHOLDER FOR NOW C UPDATED --MARCH 2002. SVG (SCALABLE VECTOR GRAPHICS) C UPDATED --MARCH 2005. SUPPORT FOR AQUATERM C UPDATED --FEBRUARY 2006. IMPLEMENT LATEX DRIVER C C-----NON-COMMON VARIABLES (GRAPHICS)------------------------------------------- C CCCCC ADD FOLLOWING LINES FOR OPEN-GL CINTE USE INTERACTER CCCCC ADD FOLLOWING LINES FOR MICROSOFT WINDOWS QUICKWIN DRIVER. 10/96 CQWIN USE DFLIB CIVFO USE IFQWIN CQWVF LOGICAL MODESTATUS CQWVF TYPE (WINDOWCONFIG) DPSCREEN CHARACTER*4 QWSCRN COMMON/QUICKWN/DPSCREEN,QWSCRN,IQWNFT,IQWNFN CQWVF TYPE (XYCOORD) WXY C CHARACTER*130 ICSTR CHARACTER*4 ISUBN0 CHARACTER*1 ICARAT CHARACTER*1 IQUOTE CHARACTER*2 ICJUNK CHARACTER*4 ICOL INTEGER IXSUN(2) INTEGER IYSUN(2) REAL PXGKS(2) REAL PYGKS(2) C CCCCC MARCH 2002: ADD FOLLOWING LINE FOR SVG DEVICE PARAMETER(MAXCLR=89) INTEGER IRED(MAXCLR), IBLUE(MAXCLR), IGREEN(MAXCLR) C C-----COMMON---------------------------------------------------------- C INCLUDE 'DPCOGR.INC' INCLUDE 'DPCONP.INC' INCLUDE 'DPCOBE.INC' INCLUDE 'DPCODV.INC' INCLUDE 'DPCOST.INC' C C-----COMMON VARIABLES (GENERAL)-------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C EXTERNAL XDRAW C CCCCC MARCH 2002: ADD FOLLOWING LINE FOR SVG DEVICE INCLUDE 'DPCOCT.INC' C C-----START POINT----------------------------------------------------- C ISUBN0='DRLI' C NCSTR=(-999) C IERRG4='NO' C IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'DRLI')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF GRDRLI--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)IX1,IY1,IX2,IY2 52 FORMAT('IX1,IY1, IX2,IY2 = ',2I8,4X,2I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,54)PX1,PY1 54 FORMAT('PX1,PY1 = ',2E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,55)PX2,PY2 55 FORMAT('PX2,PY2 = ',2E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,57)IFACTO 57 FORMAT('IFACTO = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,58)IGUNIT 58 FORMAT('IGUNIT = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,68)IMANUF,IMODEL 68 FORMAT('IMANUF,IMODEL = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,69)IBUGG4,ISUBG4,IERRG4 69 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') 90 CONTINUE C C **************************************** C ** STEP XX-- ** C ** CHECK THAT THE INPUT COORDINATES ** C ** ARE WITHIN SCREEN LIMITS ** C **************************************** C IX3=IX1 IF(IX3.LE.0)IX3=0 IF(IX3.GE.NUMHPP)IX3=NUMHPP-1 C IY3=IY1 IF(IY3.LE.0)IY3=0 IF(IY3.GE.NUMVPP)IY3=NUMVPP-1 C IX4=IX2 IF(IX4.LE.0)IX4=0 IF(IX4.GE.NUMHPP)IX4=NUMHPP-1 C IY4=IY2 IF(IY4.LE.0)IY4=0 IF(IY4.GE.NUMVPP)IY4=NUMVPP-1 C C ******************************************** C ** STEP 1-- ** C ** BRANCH ACCORDING TO THE MANUFACTURER ** C ** AND THE MODEL ** C ******************************************** C IF(IMANUF.EQ.'TEKT')GOTO1005 IF(IMANUF.EQ.'HP')GOTO1010 IF(IMANUF.EQ.'PCL')GOTO1015 IF(IMANUF.EQ.'GENE')GOTO1020 IF(IMANUF.EQ.'CALC')GOTO1025 IF(IMANUF.EQ.'ZETA')GOTO1030 IF(IMANUF.EQ.'RAMT')GOTO1035 IF(IMANUF.EQ.'SUN ')GOTO1040 IF(IMANUF.EQ.'XXXX')GOTO1045 IF(IMANUF.EQ.'REGI')GOTO1050 IF(IMANUF.EQ.'POST')GOTO1055 IF(IMANUF.EQ.'QUIC')GOTO1060 IF(IMANUF.EQ.'X11 ')GOTO1065 IF(IMANUF.EQ.'TURB')GOTO1070 IF(IMANUF.EQ.'GKS ')GOTO1075 IF(IMANUF.EQ.'LAHE')GOTO1080 IF(IMANUF.EQ.'GD ')GOTO1085 IF(IMANUF.EQ.'QWIN')GOTO1090 IF(IMANUF.EQ.'AQUA')GOTO1091 IF(IMANUF.EQ.'OPGL')GOTO1095 IF(IMANUF.EQ.'PRIN')GOTO1096 IF(IMANUF.EQ.'LATE')GOTO1097 IF(IMANUF.EQ.'MACI')GOTO1098 IF(IMANUF.EQ.'SVG ')GOTO1099 GOTO9000 C 1005 CONTINUE IF(IMODEL.EQ.'4027')GOTO1200 GOTO1100 C 1010 CONTINUE IF(IMODEL.EQ.'7221')GOTO2100 IF(IMODEL.EQ.'2622')GOTO2300 IF(IMODEL.EQ.'2623')GOTO2300 IF(IMODEL.EQ.'2627')GOTO2300 IF(IMODEL.EQ.'2647')GOTO2300 GOTO2200 C 1015 CONTINUE GOTO2600 C 1020 CONTINUE IF(IMODEL.EQ.'CODE')GOTO3200 IF(IMODEL.EQ.'CGM')GOTO3300 IF(IMODEL.EQ.'CGMB')GOTO3400 GOTO3100 C 1025 CONTINUE GOTO4100 C 1030 CONTINUE GOTO5100 C 1035 CONTINUE GOTO6100 C 1040 CONTINUE GOTO6600 C 1045 CONTINUE GOTO7100 C 1050 CONTINUE GOTO8100 C 1055 CONTINUE IF(IMODEL.EQ.'DISP')GOTO8900 GOTO8600 C 1060 CONTINUE GOTO9100 C 1065 CONTINUE GOTO9600 C 1070 CONTINUE GOTO10000 C 1075 CONTINUE GOTO11000 C 1080 CONTINUE IF(IMODEL.EQ.'INTE')GOTO4900 IF(IMODEL.EQ.'WINT')GOTO4950 GOTO4600 C 1085 CONTINUE IF(IMODEL.EQ.'JPEG')GOTO12000 IF(IMODEL.EQ.'PNG ')GOTO12000 IF(IMODEL.EQ.'WBMP')GOTO12000 IF(IMODEL.EQ.'GIF')GOTO12000 GOTO12000 C 1090 CONTINUE GOTO4700 C 1091 CONTINUE GOTO13500 C 1095 CONTINUE GOTO4800 C 1096 CONTINUE GOTO14000 C 1097 CONTINUE GOTO15000 C 1098 CONTINUE GOTO13000 C 1099 CONTINUE GOTO16000 C C ****************************** C ** STEP 11-- ** C ** TREAT THE TEKTRONIX 40104 (ETC.) CASE ** C ****************************** C 1100 CONTINUE ICSTR(1:1)=IGSC NCSTR=1 CALL TKTRPT(IX3,IY3,IFACTO,ICSTR,NCSTR,ISUBN0) CALL TKTRPT(IX4,IY4,IFACTO,ICSTR,NCSTR,ISUBN0) CALL GRWRST(ICSTR,NCSTR,ISUBN0) GOTO9000 C C ******************************* C ** STEP 12-- ** C ** TREAT THE 4027 CASE ** C ** (A COLOR RASTER DEVICE) ** C ** REFERENCE--XX ** C ******************************* C 1200 CONTINUE CCCCC WRITE(IGUNIT,1211)IX3,IY3,IX4,IY4 C1211 FORMAT('!VEC ',4I8) ICSTR(1:5)='!VEC ' NCSTR=5 NCHTOT=8 CALL GRTRIN(IX3,NCHTOT,ICSTR,NCSTR) CALL GRTRIN(IY3,NCHTOT,ICSTR,NCSTR) CALL GRTRIN(IX4,NCHTOT,ICSTR,NCSTR) CALL GRTRIN(IY4,NCHTOT,ICSTR,NCSTR) CALL GRWRST(ICSTR,NCSTR,ISUBN0) GOTO9000 C C **************************************************** C ** STEP 21-- ** C ** TREAT THE HEWLETT-PACKARD 7221 CASE ** C ** (MULTI-COLOR PENPLOTTER) ** C ** REFERENCE--HP 7221A GRAPHICS PLOTTER ** C ** OPERATING AND PROGRAMMING MANUAL, ** C ** PAGE XX. ** C **************************************************** C 2100 CONTINUE ICSTR(1:1)='p' NCSTR=1 CALL HPTRPT(IX1,IY1,ICSTR,NCSTR,ISUBN0) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)='q' NCSTR=1 CALL HPTRPT(IX2,IY2,ICSTR,NCSTR,ISUBN0) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C GOTO9000 C C ****************************************************** C ** STEP 22-- ** C ** TREAT THE HEWLETT-PACKARD HP-GL CASES ** C ** (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS) ** C ** (MULTI-COLOR PENPLOTTERS) ** C ** DEFAULT NO-OP END-OF-INSTRUCTION TERMINATOR). ** C ** REFERENCE--HP 9872C GRAPHICS PLOTTER ** C ** OPERATING AND PROGRAMMING MANUAL, ** C ** PAGE XX, XXX. ** C ****************************************************** C 2200 CONTINUE ICSTR(1:5)='PU;PA' NCSTR=5 NCHTOT=5 CALL GRTRIN(IX1,NCHTOT,ICSTR,NCSTR) ICSTR(11:11)=',' NCSTR=11 CALL GRTRIN(IY1,NCHTOT,ICSTR,NCSTR) ICSTR(17:17)=';' NCSTR=17 CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:5)='PD;PA' NCSTR=5 NCHTOT=5 CALL GRTRIN(IX2,NCHTOT,ICSTR,NCSTR) ICSTR(11:11)=',' NCSTR=11 CALL GRTRIN(IY2,NCHTOT,ICSTR,NCSTR) ICSTR(17:17)=';' NCSTR=17 CALL GRWRST(ICSTR,NCSTR,ISUBN0) C GOTO9000 C C ********************************************************** C ** STEP 23-- ** C ** TREAT THE HEWLETT-PACKARD HP-2622 CASES ** C ** (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS) ** C ** (MONOCHROME DISPLAY TERMINALS) ** C ** REFERENCE--HP 2322C GRAPHICS PLOTTER ** C ** REFERENCE MANUAL, ** C ** PAGE XX-X, XXX. ** C ********************************************************** C 2300 CONTINUE ICSTR(1:1)=IESCC ICSTR(2:4)='*pa' NCSTR=4 NCHTOT=5 CALL GRTRIN(IX1,NCHTOT,ICSTR,NCSTR) ICSTR(10:10)=',' NCSTR=10 CALL GRTRIN(IY1,NCHTOT,ICSTR,NCSTR) ICSTR(16:16)='Z' NCSTR=16 CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IESCC ICSTR(2:4)='*pb' NCSTR=4 NCHTOT=5 CALL GRTRIN(IX2,NCHTOT,ICSTR,NCSTR) ICSTR(10:10)=',' NCSTR=10 CALL GRTRIN(IY2,NCHTOT,ICSTR,NCSTR) ICSTR(16:16)='Z' NCSTR=16 CALL GRWRST(ICSTR,NCSTR,ISUBN0) GOTO9000 C C ****************************************************** C ** STEP 26-- ** C ** TREAT THE HEWLETT-PACKARD PCL LANDSCAPE CASE ** C ** (HP LASER PRINTERS, E.G. LASER JET ** C ** USE HPBRES TO DRAW THE LINE WITH THE ** C ** BRESENHAM ALGORITHM. ** C ****************************************************** C 2600 CONTINUE JTHICK=3 ICOL='NULL' CALL HPBRES(IX1,IY1,IX2,IY2,ICOL,JTHICK) GOTO9000 C C *************************************************** C ** STEP 31-- ** C ** TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE ** C *************************************************** C 3100 CONTINUE CCCCC WRITE(IGUNIT,3111)PX1,PY1 C3111 FORMAT('MOVE TO ',F10.5,2X,F10.5) ICSTR(1:8)='MOVE TO ' NCSTR=8 NCHTOT=10 NCHDEC=5 CALL GRTRRE(PX1,NCHTOT,NCHDEC,ICSTR,NCSTR) ICSTR(19:20)=' ' NCSTR=20 CALL GRTRRE(PY1,NCHTOT,NCHDEC,ICSTR,NCSTR) CALL GRWRST(ICSTR,NCSTR,ISUBN0) CCCCC WRITE(IGUNIT,3121)PX2,PY2 C3121 FORMAT('DRAW TO ',F10.5,2X,F10.5) ICSTR(1:8)='DRAW TO ' NCSTR=8 NCHTOT=10 NCHDEC=5 CALL GRTRRE(PX2,NCHTOT,NCHDEC,ICSTR,NCSTR) ICSTR(19:20)=' ' NCSTR=20 CALL GRTRRE(PY2,NCHTOT,NCHDEC,ICSTR,NCSTR) CALL GRWRST(ICSTR,NCSTR,ISUBN0) GOTO9000 C C *************************************************************** C ** STEP 32-- ** C ** TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE ** C *************************************************************** C C DECEMBER 1997. FOR GUI, CONVERT COORDINATES TO INTEGER (BY C MULTIPLYING BY 100). DO NOT PRINT OUT SUCCESSIV POINTS IF THEY C ARE IDENTICAL. C 3200 CONTINUE IF(IMODE2.EQ.'PACK'.OR.IMODE2.EQ.'GUI')GOTO3250 ICSTR(1:5)='MOTO ' NCSTR=5 NCHTOT=10 NCHDEC=5 CALL GRTRRE(PX1,NCHTOT,NCHDEC,ICSTR,NCSTR) ICSTR(16:17)=' ' NCSTR=17 CALL GRTRRE(PY1,NCHTOT,NCHDEC,ICSTR,NCSTR) CALL GRWRST(ICSTR,NCSTR,ISUBN0) ICSTR(1:5)='DRTO ' NCSTR=5 NCHTOT=10 NCHDEC=5 CALL GRTRRE(PX2,NCHTOT,NCHDEC,ICSTR,NCSTR) ICSTR(16:17)=' ' NCSTR=17 CALL GRTRRE(PY2,NCHTOT,NCHDEC,ICSTR,NCSTR) CALL GRWRST(ICSTR,NCSTR,ISUBN0) GOTO3290 C 3250 CONTINUE ICSTR(1:2)='M ' NCSTR=2 NCHTOT=IGENFA+3 IPX1=INT(PX1*10.**IGENFA+0.5) IPY1=INT(PY1*10.**IGENFA+0.5) CALL GRTRIN(IPX1,NCHTOT,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=' ' CALL GRTRIN(IPY1,NCHTOT,ICSTR,NCSTR) CALL GRWRST(ICSTR,NCSTR,ISUBN0) ICSTR(1:2)='D ' NCSTR=2 NCHTOT=IGENFA+3 IPX2=INT(PX2*10.**IGENFA+0.5) IPY2=INT(PY2*10.**IGENFA+0.5) CALL GRTRIN(IPX2,NCHTOT,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=' ' CALL GRTRIN(IPY2,NCHTOT,ICSTR,NCSTR) CALL GRWRST(ICSTR,NCSTR,ISUBN0) C 3290 CONTINUE GOTO9000 C C *************************************************************** C ** STEP 33-- ** C ** TREAT THE CGM GENERAL (DEVICE-INDEPENDENT) CASE ** C *************************************************************** C 3300 CONTINUE ICSTR(1:6)='LINE ' NCSTR=6 NCHTOT=10 NCHDEC=5 CALL GRTRSA(PX1,PY1,AX,AY,ISUBN0) CALL GRTRRE(AX,NCHTOT,NCHDEC,ICSTR,NCSTR) ICSTR(17:17)=',' NCSTR=17 CALL GRTRRE(AY,NCHTOT,NCHDEC,ICSTR,NCSTR) ICSTR(28:29)=', ' NCSTR=29 CALL GRTRSA(PX2,PY2,AX,AY,ISUBN0) CALL GRTRRE(AX,NCHTOT,NCHDEC,ICSTR,NCSTR) ICSTR(40:40)=',' NCSTR=40 CALL GRTRRE(AY,NCHTOT,NCHDEC,ICSTR,NCSTR) ICSTR(50:50)=';' NCSTR=50 CALL GRWRST(ICSTR,NCSTR,ISUBN0) GOTO9000 C C *************************************************** C ** STEP 34-- ** C ** TREAT THE CGM (BINARY) CASE ** C *************************************************** C 3400 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 41-- ** C ** TREAT THE CALCOMP XXXXXX CASE ** C ** WRITE OUT AN XXXXXXXXXX ** C ** REFERENCE--USE CALCOMP LIBRARY ROUTINES ** C ** XX ** C ** PAGES XX AND XX ** C ****************************************************** C 4100 CONTINUE CCCCC WRITE(IGUNIT,4111) C4111 FORMAT('FIX SUBROUTINE GRDRLI TO DRAW LINE CALCOMP DEVICE') CCCCC ICSTR(1:49)='FIX SUBROUTINE GRDRLI TO DRAW LINE CALCOMP DEVICE' CCCCC NCSTR=49 CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0) CALL CALCPT(PX1,PY1,AX1,AY1,ISUBN0) IPEN=3 CALL PLOT(AX1,AY1,IPEN) IPEN=2 CALL CALCPT(PX2,PY2,AX1,AY1,ISUBN0) CALL PLOT(AX1,AY1,IPEN) GOTO9000 C C ****************************************************** C ** STEP 46-- ** C ** TREAT THE LAHEY XXXXXX CASE ** C ** REFERENCE--Programmer's Reference, Revision C ** C ** Lahey Computer Systems, January, 1992** C ** PAGES 51 THRU 65 ** C ****************************************************** C 4600 CONTINUE CALL CALCPT(PX1,PY1,AX1,AY1,ISUBN0) IPEN=3 CALL PLOT(AX1,AY1,IPEN) IPEN=2 CALL CALCPT(PX2,PY2,AX1,AY1,ISUBN0) CALL PLOT(AX1,AY1,IPEN) GOTO9000 C C ****************************************************** C ** STEP 47-- ** C ** TREAT THE MICROSOFT QUICKWIN DRIVER ** C ** FOR WINDOWS 95 AND WINDOWS NT. ** C ****************************************************** C 4700 CONTINUE CCCCC PYTEMP=100.-PY1 PYTEMP=PY1 CALL GRTRSD(PX1,PYTEMP,IX1,IY1,ISUBN0) CQWVF CALL MOVETO(INT2(IX1),INT2(IY1),WXY) CCCCC PYTEMP=100.-PY1 PYTEMP=PY2 CALL GRTRSD(PX2,PYTEMP,IX2,IY2,ISUBN0) CQWVF ISTATUS=LINETO(INT2(IX2),INT2(IY2)) GOTO9000 C C ****************************************************** C ** STEP 48-- ** C ** TREAT THE OPEN-GL DRIVER ** C ** FOR WINDOWS 95 AND WINDOWS NT AND X11 ** C ****************************************************** C 4800 CONTINUE PXGKS(1)=PX1 PYGKS(1)=100.0 - PY1 PXGKS(2)=PX2 PYGKS(2)=100.0 - PY2 NPTS=2 CALL GLDRAW(PXGKS,PYGKS,NPTS) GOTO9000 C C ****************************************************** C ** STEP 49-- ** C ** TREAT THE LAHEY INTERACTOR CASE ** C ****************************************************** C 4900 CONTINUE CALL GRTRSD(PX1,PY1,IX1,IY1,ISUBN0) CINTE CALL IGrMoveTo(REAL(IX1),REAL(IY1)) CALL GRTRSD(PX2,PY2,IX2,IY2,ISUBN0) CINTE CALL IGrLineTo(REAL(IX2),REAL(IY2)) GOTO9000 C C ****************************************************** C ** STEP 49B- ** C ** TREAT THE LAHEY WINTERACTOR CASE ** C ****************************************************** C 4950 CONTINUE CWINT CALL IGrMoveTo(PX1,PY1) CWINT CALL IGrLineTo(PX2,PY2) GOTO9000 C C ****************************************************** C ** STEP 51-- ** C ** TREAT THE ZETA 3600SX AND 3653SX CASES ** C ** REFERENCE--USER MANUAL FOR DIGITAL PLOTTER ** C ** MODELS 3600SX AND 3653SX ** C ** PAGES B-0 AND B-1 ** C ** USE CALCOMP LIBRARY ROUTINES ** C ****************************************************** C 5100 CONTINUE CALL CALCPT(PX1,PY1,AX1,AY1,ISUBN0) IPEN=3 CALL PLOT(AX1,AY1,IPEN) IPEN=2 CCCCC THE FOLLOWING 2 LINES WERE COMMENTED OUT APRIL 1992 ALAN CCCCC IF(JPATT.GT.0)IPEN=13+JPATT CCCCC IF(IPEN.NE.2 .AND. (IPEN.LT.14.OR.IPEN.GT.19))IPEN=2 CALL CALCPT(PX2,PY2,AX1,AY1,ISUBN0) CALL PLOT(AX1,AY1,IPEN) GOTO9000 C C ****************************************************** C ** STEP 61-- ** C ** TREAT THE RAMTEK XXXXXX CASE ** C ** TO DRAW LINE-- ** C ** WRITE OUT AN XXXXXXXXXX ** C ** (NOT DONE) ** C ** REFERENCE--XX ** C ** XX ** C ** PAGES XX AND XX ** C ****************************************************** C 6100 CONTINUE CCCCC WRITE(IGUNIT,6111) C6111 FORMAT('FIX SUBROUTINE GRDRLI TO DRAW LINE RAMTEK DEVICE') ICSTR(1:48)='FIX SUBROUTINE GRDRLI TO DRAW LINE RAMTEK DEVICE' NCSTR=48 CALL GRWRST(ICSTR,NCSTR,ISUBN0) GOTO9000 C C ****************************************************** C ** STEP 66-- ** C ** TREAT THE SUN CASE - WRITTEN BY BILL ANDERSON ** C ****************************************************** C C 6600 CONTINUE IXSUN(1) = IX1 IXSUN(2) = IX2 IYSUN(1) = IY1 IYSUN(2) = IY2 CSUN CALL cfpolyline(IXSUN,IYSUN,2) GOTO 9000 C C ****************************************************** C ** STEP 71-- ** C ** TREAT THE XXXXXX XXXXXX CASE ** C ** TO DRAW LINE-- ** C ** WRITE OUT AN XXXXXXXXXX ** C ** (NOT DONE) ** C ** REFERENCE--XX ** C ** XX ** C ** PAGES XX AND XX ** C ****************************************************** C 7100 CONTINUE CCCCC WRITE(IGUNIT,7111) C7111 FORMAT('FIX SUBROUTINE GRDRLI TO DRAW LINE XXXXXX DEVICE') ICSTR(1:48)='FIX SUBROUTINE GRDRLI TO DRAW LINE XXXXXX DEVICE' NCSTR=48 CALL GRWRST(ICSTR,NCSTR,ISUBN0) GOTO9000 C C ****************************************************** C ** STEP 81-- ** C ** TREAT THE DEC REGIS CASE ** C ** TO XXX--- ** C ** WRITE OUT AN XX ** C ** REFERENCE--VT125 GRAPHICS TERMINAL USER GUIDE ** C ** PAGES 96 AND 145 ** C ****************************************************** C 8100 CONTINUE ICSTR(1:2)='P[' NCSTR=2 NCHTOT=5 CALL GRTRSD(PX1,PY1,IX1,IY1,ISUBN0) CALL GRTRIN(IX1,NCHTOT,ICSTR,NCSTR) ICSTR(8:8)=',' NCSTR=8 CALL GRTRIN(IY1,NCHTOT,ICSTR,NCSTR) ICSTR(14:14)=']' NCSTR=14 CALL GRWRST(ICSTR,NCSTR,ISUBN0) ICSTR(1:3)='V[]' NCSTR=3 CALL GRWRST(ICSTR,NCSTR,ISUBN0) C CALL GRTRSD(PX2,PY2,IX2,IY2,ISUBN0) ICSTR(1:2)='V[' NCSTR=2 NCHTOT=5 CALL GRTRIN(IX2,NCHTOT,ICSTR,NCSTR) ICSTR(8:8)=',' NCSTR=8 CALL GRTRIN(IY2,NCHTOT,ICSTR,NCSTR) ICSTR(14:14)=']' NCSTR=14 CALL GRWRST(ICSTR,NCSTR,ISUBN0) C GOTO9000 C C ****************************************************** C ** STEP 86-- ** C ** TREAT THE POSTSCRIPT CASE ** C ****************************************************** C 8600 CONTINUE ICSTR(1:8)='newpath ' NCSTR=8 CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0) NCHTOT=5 CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR) ICSTR(14:14)=' ' NCSTR=14 CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR) ICSTR(20:27)=' moveto ' NCSTR=27 CALL GRTRSD(PX2,PY2,IX,IY,ISUBN0) CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR) ICSTR(33:33)=' ' NCSTR=33 CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR) ICSTR(39:52)=' lineto stroke' NCSTR=52 CALL GRWRST(ICSTR,NCSTR,ISUBN0) GOTO9000 C C ****************************************************** C ** STEP 89-- ** C ** TREAT THE DISPLAY POSTSCRIPT DRIVER ** C ****************************************************** C 8900 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 91-- ** C ** TREAT THE QUIC LANDSCAPE CASE ** C ** IGV - ENABLE VECTOR GRAPHICS MODE ** C ** WTTTTTBBBBBLLLLLRRRRR - SET PAGE MARGINS** C ** NOTE: ENFORCE MARGIN WITH THE "OFFSET" AND NUMBER* C ** OF PICTURE POINTS. WE ONLY WANT TO CLIP ** C ** AT THE MARGIN, NOT FORCE A PAGE ERASE. ** C ** Tttttt - SET Y ORGIN FROM TOP OF PAGE** C ** Jjjjjj - SET X ORGIN FROM LEFT ** C ** PWnn - SET PEN WIDTH (3 CLOSEST TO ** C ** 0.1 DATAPLOT UNITS) ** C ** UXXXXX:YYYYY - MOVE ** C ** DXXXXX:YYYYY - DRAW ** C ** IGE - DISABLE VECTOR GRAPHICS MODE** C ** REFERENCE: QUIC PROGRAMMERS MANUAL - CHAPTER ON ** C ** VECTOR GRAPHICS ** C ****************************************************** C 9100 CONTINUE CALL DPCONA(94,ICARAT) ICSTR(1:1)=ICARAT ICSTR(2:4)='IGV' ICSTR(5:5)=ICARAT ICSTR(6:6)='W' C IF(IORNSW.EQ.'PORT')GOTO9110 CCCCC AXLEFT=IQUILM CCCCC AXRGHT=11.*QUIPPI-IQUIRM CCCCC AYTOP=IQUITM CCCCC AYBOT=8.5*QUIPPI-IQUIBM CCCCC AFACTH=11.*QUIPPI CCCCC AFACTV=8.5*QUIPPI IX2=11000 IY2=8500 GOTO9120 C 9110 CONTINUE C CCCCC AXLEFT=IQU2LM CCCCC AXRGHT=8.5*QUIPPI-IQU2RM CCCCC AYTOP=IQU2TM CCCCC AYBOT=11.*QUIPPI-IQU2BM CCCCC AFACTH=8.5*QUIPPI CCCCC AFACTV=11.*QUIPPI IX2=8500 IY2=11000 C 9120 CONTINUE C CCCCC IX=INT(1000.*AXLEFT/QUIPPI+0.5) CCCCC IX2=INT(1000.*AXRGHT/QUIPPI+0.5) CCCCC IY=INT(1000.*AYTOP/QUIPPI+0.5) CCCCC IY2=INT(1000.*AYBOT/QUIPPI+0.5) IX=0 IY=0 NCSTR=6 NCHTOT=-5 CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR) CALL GRTRIN(IY2,NCHTOT,ICSTR,NCSTR) CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR) CALL GRTRIN(IX2,NCHTOT,ICSTR,NCSTR) ICSTR(27:27)=ICARAT ICSTR(28:33)='T00000' ICSTR(34:34)=ICARAT ICSTR(35:40)='J00000' ICSTR(41:41)=ICARAT ICSTR(42:45)='PW03' NCSTR=45 CALL GRWRST(ICSTR,NCSTR,ISUBN0) ICSTR(1:1)=ICARAT ICSTR(2:2)='U' C NOTE: QUIC POSIOTIONS FROM TOP OF PAGE NOT THE BOTTOM, REVERSE Y PYTEMP=100.-PY1 CALL QUICPT(PX1,PYTEMP,IX1,IY1,ISUBN0) NCSTR=2 NCHTOT=-5 CALL GRTRIN(IX1,NCHTOT,ICSTR,NCSTR) ICSTR(8:8)=':' NCSTR=8 CCCCC THE FOLLOWING LINE WAS FIXED MAY 1991 CCCCC CALL GRTRIN(IY1,NCHTOT,ICSTR,ISUBNO) CALL GRTRIN(IY1,NCHTOT,ICSTR,NCSTR) ICSTR(14:14)=ICARAT ICSTR(15:15)='D' NCSTR=15 PYTEMP=100.-PY2 CALL QUICPT(PX2,PYTEMP,IX1,IY1,ISUBN0) CALL GRTRIN(IX1,NCHTOT,ICSTR,NCSTR) ICSTR(21:21)=ICARAT NCSTR=21 CCCCC THE FOLLOWING LINE WAS FIXED MAY 1991 CCCCC CALL GRTRIN(IY1,NCHTOT,ICSTR,ISUBN0) CALL GRTRIN(IY1,NCHTOT,ICSTR,NCSTR) ICSTR(27:27)=ICARAT ICSTR(28:30)='IGE' NCSTR=30 CALL GRWRST(ICSTR,NCSTR,ISUBN0) GOTO9000 C C ****************************************************** C ** STEP 96-- ** C ** TREAT THE X11 CASE ** C ****************************************************** C 9600 CONTINUE IF(IX11OF.EQ.'OFF')GOTO9000 NTEMP=2 CALL GRTRSD(PX1,PY1,IX1,IY1,ISUBN0) CALL GRTRSD(PX2,PY2,IX2,IY2,ISUBN0) IXSUN(1)=IX1 IYSUN(1)=IY1 CCCCC THE FOLLOWING LINE WAS CORRECTED MAY 24, 1991 (JJF) CCCCC IXSUN(2)=X2 IXSUN(2)=IX2 IYSUN(2)=IY2 CALL XDRAW(IXSUN,IYSUN,NTEMP) GOTO9000 C C ************************************************* C ** STEP 100-- ** C ** TREAT THE VGA VIA TURBO-C CASE ** C ************************************************* C 10000 CONTINUE IF(ITCST.EQ.'CLOS')GOTO9000 CALL TCDRLI(PX1,PY1,PX2,PY2) GOTO9000 C C ****************************************************** C ** STEP 110-- ** C ** TREAT THE GKS DRIVER ** C ****************************************************** C 11000 CONTINUE NP=2 PXGKS(1) = PX1 PXGKS(2) = PX2 PYGKS(1) = PY1 PYGKS(2) = PY2 CGKS CALL GPL(NP, PXGKS, PYGKS) GOTO9000 C C ****************************************************** C ** STEP 120-- ** C ** TREAT THE GD DRIVER ** C ** THIS LIBRARY PROVIDES SUPPORT FOR: ** C ** 1) JPEG ** C ** 2) PNG ** C ** 3) WINDOWS BMP (BLACK/WHITE ONLY) ** C ****************************************************** C 12000 CONTINUE NTEMP=2 CALL GRTRSD(PX1,PY1,IX1,IY1,ISUBN0) CALL GRTRSD(PX2,PY2,IX2,IY2,ISUBN0) JPATT=1 CCCCC JULY 2001. PASS JCOL AS ARGUMENT RATHER THAN HARD CODING IT. CCCCC JCOL=1 CALL GDDRAW(IX1,IY1,IX2,IY2,JCOL,JPATT) GOTO9000 C C ****************************************************** C ** STEP 130-- ** C ** TREAT THE MACINTOSH DRIVER ** C ** LIBRARY FROM ABSOFT COMPILER ** C ****************************************************** C 13000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 135-- ** C ** TREAT THE MAC OSX AQUATERM DRIVER ** C ****************************************************** C 13500 CONTINUE CALL GRTRSD(PX1,PY1,IX1,IY1,ISUBN0) AX1=REAL(IX1) AY1=REAL(IY1) CAQUA CALL aqtMoveTo(AX1,AY1) CALL GRTRSD(PX2,PY2,IX2,IY2,ISUBN0) AX2=REAL(IX2) AY2=REAL(IY2) CAQUA CALL aqtAddLineTo(AX2,AY2) GOTO9000 C C ****************************************************** C ** STEP 140-- ** C ** TREAT THE PC PRINTER DRIVER ** C ****************************************************** C 14000 CONTINUE GOTO9000 C 15000 CONTINUE ICSTR(1:1)=IBASLC ICSTR(2:13)='drawline[ 0]' NCSTR=13 C CALL GRTRSD(PX1,PY1,IX1,IY1,ISUBN0) CALL GRTRSD(PX2,PY2,IX2,IY2,ISUBN0) NCHTOT=5 NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='(' CALL GRTRIN(IX1,NCHTOT,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRIN(IY1,NCHTOT,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=')' NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='(' CALL GRTRIN(IX2,NCHTOT,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRIN(IY2,NCHTOT,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=')' C CALL GRWRST(ICSTR,NCSTR,ISUBN0) GOTO9000 C C ****************************************************** C ** STEP 160-- ** C ** TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER ** C ****************************************************** C 16000 CONTINUE C CALL DPCONA(34,IQUOTE) C ICSTR(1:8)=' XY - DO A MOVE ** C ** SET FONT FIRST IF NEEDED. ** C ** NO SPECIAL INSTRUCTION REQUIRED TO PUT IN TEXT MODE** C ** REFERENCE--HP LASERJET SERIES II TECHNICAL ** C ** REFERENCE MANUAL, ** C ********************************************************** C 2600 CONTINUE IF(IPCLFN.NE.IPCLFC)GOTO2605 IPCLFC=IPCLFN ICSTR(1:1)=IESCC C ICSTR(2:5)='(s3T' IF(IPCLFN.EQ.'COND')ICSTR(4:4)='0' ICSTR(6:6)=IESCC ICSTR(7:10)='(s0B' IF(IPCLFN.EQ.'CBOL')ICSTR(9:9)='3' NCSTR=10 CALL GRWRST(ICSTR,NCSTR,ISUBN0) C 2605 CONTINUE NCTEXT=1 ICTEXT(NCTEXT)=ISYMBL C DO2610I=1,NP C PX1P=PX(I)-PXINC PY1P=PY(I)-PYINC PY1P=100.-PY1P CALL GRTRSD(PX1P,PY1P,IX,IY,ISUBN0) ICSTR(1:1)=IESCC ICSTR(2:3)='*p' NCSTR=3 NCHTOT=4 CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR) ICSTR(8:8)='X' NCSTR=8 CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR) ICSTR(13:13)='Y' ICSTR(14:14)=ICTEXT(NCTEXT) NCSTR=14 CALL GRWRST(ICSTR,NCSTR,ISUBN0) 2610 CONTINUE C 2690 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 31-- ** C ** TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE ** C ****************************************************** C 3100 CONTINUE C IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')THEN WRITE(ICOUT,3102) CALL DPWRST('XXX','BUG ') C GOTO9000 ENDIF 3102 FORMAT('****** THE PIXEL CAPABILITY IS NOT YET SUPPORTED FOR ', 1'THE GENERAL DEVICE.') C NCTEXT=1 ICTEXT(NCTEXT)=ISYMBL C IF(IJUSSW.EQ.'ON')GOTO3150 C DO3110I=1,NP C PX1P=PX(I)-PXINC PY1P=PY(I)-PYINC CALL GRTRSA(PX1P,PY1P,AX1,AY1,ISUBN0) PX1P=AX1 PY1P=AY1 ICSTR(1:8)='MOVE TO ' NCSTR=8 NCHTOT=10 NCHDEC=5 CALL GRTRRE(PX1P,NCHTOT,NCHDEC,ICSTR,NCSTR) ICSTR(19:20)=' ' NCSTR=20 CALL GRTRRE(PY1P,NCHTOT,NCHDEC,ICSTR,NCSTR) CALL GRWRST(ICSTR,NCSTR,ISUBN0) ICSTR(1:11)='WRITE TEXT ' NCSTR=11 DO3112J=1,NCTEXT K=J+NCSTR ICSTR(K:K)=ICTEXT(J) 3112 CONTINUE NCSTR=K CALL GRWRST(ICSTR,NCSTR,ISUBN0) C 3110 CONTINUE C GOTO3190 C 3150 CONTINUE C DO3160I=1,NP C PX1P=PX(I) PY1P=PY(I) CALL GRTRSA(PX1P,PY1P,AX1,AY1,ISUBN0) PX1P=AX1 PY1P=AY1 ICSTR(1:8)='MOVE TO ' NCSTR=8 NCHTOT=10 NCHDEC=5 CALL GRTRRE(PX1P,NCHTOT,NCHDEC,ICSTR,NCSTR) ICSTR(19:20)=' ' NCSTR=20 CALL GRTRRE(PY1P,NCHTOT,NCHDEC,ICSTR,NCSTR) CALL GRWRST(ICSTR,NCSTR,ISUBN0) ICSTR(1:11)='WRITE TEXT ' NCSTR=11 DO3162J=1,NCTEXT K=J+NCSTR ICSTR(K:K)=ICTEXT(J) 3162 CONTINUE NCSTR=K CALL GRWRST(ICSTR,NCSTR,ISUBN0) C 3160 CONTINUE C 3190 CONTINUE GOTO9000 C C *************************************************************** C ** STEP 32-- ** C ** TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE ** C *************************************************************** C C DECEMBER 1997. CODE SLIGHTLY DIFFERENTLY FOR GUI 3200 CONTINUE IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')THEN WRITE(ICOUT,3262) CALL DPWRST('XXX','BUG ') C GOTO9000 ENDIF 3262 FORMAT('****** THE PIXEL CAPABILITY IS NOT YET SUPPORTED FOR ', 1'THE GENERAL DEVICE.') C NCTEXT=1 ICTEXT(NCTEXT)=ISYMBL C IF(IJUSSW.EQ.'ON')GOTO3250 C IF(IMODE2.EQ.'PACK'.OR.IMODE2.EQ.'GUI')GOTO3230 DO3210I=1,NP C PX1P=PX(I)-PXINC PY1P=PY(I)-PYINC CALL GRTRSA(PX1P,PY1P,AX1,AY1,ISUBN0) PX1P=AX1 PY1P=AY1 ICSTR(1:5)='MOTO ' NCSTR=5 NCHTOT=10 NCHDEC=5 CALL GRTRRE(PX1P,NCHTOT,NCHDEC,ICSTR,NCSTR) ICSTR(16:17)=' ' NCSTR=17 CALL GRTRRE(PY1P,NCHTOT,NCHDEC,ICSTR,NCSTR) CALL GRWRST(ICSTR,NCSTR,ISUBN0) ICSTR(1:5)='WRTE ' NCSTR=5 DO3212J=1,NCTEXT K=J+NCSTR ICSTR(K:K)=ICTEXT(J) 3212 CONTINUE NCSTR=K CALL GRWRST(ICSTR,NCSTR,ISUBN0) C 3210 CONTINUE GOTO3290 C 3230 CONTINUE DO3240I=1,NP C PX1P=PX(I)-PXINC PY1P=PY(I)-PYINC CALL GRTRSA(PX1P,PY1P,AX1,AY1,ISUBN0) IPXTMP=INT(AX1*10.**IGENFA+0.5) IPYTMP=INT(AY1*10.**IGENFA+0.5) ICSTR(1:2)='M ' NCSTR=2 NCHTOT=IGENFA+3 CALL GRTRIN(IPXTMP,NCHTOT,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=' ' CALL GRTRIN(IPYTMP,NCHTOT,ICSTR,NCSTR) CALL GRWRST(ICSTR,NCSTR,ISUBN0) ICSTR(1:5)='WRTE ' NCSTR=5 DO3242J=1,NCTEXT K=J+NCSTR ICSTR(K:K)=ICTEXT(J) 3242 CONTINUE NCSTR=K CALL GRWRST(ICSTR,NCSTR,ISUBN0) 3240 CONTINUE GOTO3290 C 3250 CONTINUE C IF(IMODE2.EQ.'PACK'.OR.IMODE2.EQ.'GUI')GOTO3270 DO3260I=1,NP C PX1P=PX(I) PY1P=PY(I) CALL GRTRSA(PX1P,PY1P,AX1,AY1,ISUBN0) PX1P=AX1 PY1P=AY1 ICSTR(1:5)='MOTO ' NCSTR=5 NCHTOT=10 NCHDEC=5 CALL GRTRRE(PX1P,NCHTOT,NCHDEC,ICSTR,NCSTR) ICSTR(16:17)=' ' NCSTR=17 CALL GRTRRE(PY1P,NCHTOT,NCHDEC,ICSTR,NCSTR) CALL GRWRST(ICSTR,NCSTR,ISUBN0) ICSTR(1:5)='WRTE ' NCSTR=5 DO3252J=1,NCTEXT K=J+NCSTR ICSTR(K:K)=ICTEXT(J) 3252 CONTINUE NCSTR=K CALL GRWRST(ICSTR,NCSTR,ISUBN0) C 3260 CONTINUE GOTO3290 C 3270 CONTINUE C DO3280I=1,NP C CALL GRTRSA(PX(I),PY(I),AX1,AY1,ISUBN0) IPXTMP=INT(AX1*10.**IGENFA+0.5) IPYTMP=INT(AY1*10.**IGENFA+0.5) ICSTR(1:2)='M ' NCSTR=2 NCHTOT=IGENFA+3 CALL GRTRIN(IPXTMP,NCHTOT,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=' ' CALL GRTRIN(IPYTMP,NCHTOT,ICSTR,NCSTR) CALL GRWRST(ICSTR,NCSTR,ISUBN0) ICSTR(1:5)='WRTE ' NCSTR=5 DO3282J=1,NCTEXT K=J+NCSTR ICSTR(K:K)=ICTEXT(J) 3282 CONTINUE NCSTR=K CALL GRWRST(ICSTR,NCSTR,ISUBN0) C 3280 CONTINUE 3290 CONTINUE GOTO9000 C C *************************************************************** C ** STEP 33-- ** C ** TREAT THE CGM GENERAL (DEVICE-INDEPENDENT) CASE ** C ** TEXT (XCOOR,YCOOR) FINAL ""; ** C *************************************************************** C 3300 CONTINUE C IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')THEN WRITE(ICOUT,3362) CALL DPWRST('XXX','BUG ') C GOTO9000 ENDIF 3362 FORMAT('****** THE PIXEL CAPABILITY IS NOT YET SUPPORTED FOR ', 1'THE CGM DEVICE.') NCTEXT=1 ICTEXT(NCTEXT)=ISYMBL NCHTOT=10 NCHDEC=5 C IF(IJUSSW.EQ.'ON')GOTO3350 C DO3310I=1,NP C PX1P=PX(I)-PXINC PY1P=PY(I)-PYINC CALL GRTRSA(PX1P,PY1P,AX,AY,ISUBN0) ICSTR(1:6)='TEXT (' NCSTR=6 NCHTOT=10 NCHDEC=5 CALL GRTRRE(AX,NCHTOT,NCHDEC,ICSTR,NCSTR) ICSTR(17:17)=',' NCSTR=17 CALL GRTRRE(AY,NCHTOT,NCHDEC,ICSTR,NCSTR) ICSTR(28:36)=') FINAL "' ICSTR(37:37)=ICTEXT(NCTEXT) ICSTR(38:39)='";' NCSTR=39 CALL GRWRST(ICSTR,NCSTR,ISUBN0) 3310 CONTINUE C GOTO3390 C 3350 CONTINUE C DO3360I=1,NP C PX1P=PX(I) PY1P=PY(I) CALL GRTRSA(PX1P,PY1P,AX,AY,ISUBN0) ICSTR(1:6)='TEXT (' NCSTR=6 NCHTOT=10 NCHDEC=5 CALL GRTRRE(AX,NCHTOT,NCHDEC,ICSTR,NCSTR) ICSTR(17:17)=',' NCSTR=17 CALL GRTRRE(AY,NCHTOT,NCHDEC,ICSTR,NCSTR) ICSTR(28:36)=') FINAL "' ICSTR(37:37)=ICTEXT(NCTEXT) ICSTR(38:39)='";' NCSTR=39 CALL GRWRST(ICSTR,NCSTR,ISUBN0) 3360 CONTINUE C 3390 CONTINUE C GOTO9000 C C *************************************************** C ** STEP 34-- ** C ** TREAT THE CGM (BINARY) CASE ** C *************************************************** C 3400 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 41-- ** C ** TREAT THE CALCOMP XXXXXX CASE ** C ** TO DRAW A HORIZONTAL POLYMARKER-- ** C ** WRITE OUT AN XXXXXXXXXX ** C ** (NOT DONE) ** C ** REFERENCE--XX ** C ** XX ** C ** PAGES XX AND XX ** C ** USE CALCOMP LIBRARY ** C ** SYMBOL - WRITES TEXT ** C ** CALCPT - DATAPLOT ROUTINE TO CONVERT FROM ** C ** PERCENT UNITS TO INCHES ** C ** CALCTR - DATAPLOT ROUTINE TO CONVERT ** C ** CHARACTER VARIABLE TO HOLLERITH ** C ** FORMAT (NOT NECCESARY ON ALL ** C ** SYSTEMS, BUT IS ON OTHERS. ** C ****************************************************** C 4100 CONTINUE CCCCC WRITE(IGUNIT,4111) C4111 FORMAT('FIX SUBROUTINE GRDRPH TO DRAW HOR POLYM CALCOMP DEV.') CCCCC ICSTR(1:52)='FIX SUBROUTINE GRDRPH TO DRAW HOR POLYM CALCOMP DEV.' CCCCC NCSTR=52 CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0) C IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')GOTO4160 C NCTEXT=1 ICTEXT(1)=ISYMBL C DO4110I=1,NP C PX1P=PX(I)-PXINC PY1P=PY(I)-PYINC CALL CALCPT(PX1P,PY1P,AX,AY,ISUBN0) ANGLE=0. AXTEMP=0. CALL CALCPT(AXTEMP,PHEIG2,AYTMP2,HEIGHT,ISUBN0) CALL CALCTR(ICTEXT,IHOLL,NCTEXT) CCCCC CALL SYMBOL(AX,AY,HEIGHT,IHOLL,ANGLE,NCTEXT) C 4110 CONTINUE GOTO4190 C 4160 CONTINUE WRITE(ICOUT,4162) 4162 FORMAT('****** THE PIXEL CAPABILITY IS NOT YET SUPPORTED FOR ', 1'THE CALCOMP DEVICE.') CALL DPWRST('XXX','BUG ') C 4190 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 46-- ** C ** TREAT THE LAHEY XXXXXX CASE ** C ** REFERENCE--Programmer's Reference, Revision C ** C ** Lahey Computer Systems, January, 1992** C ** PAGES 51 THRU 65 ** C ****************************************************** C 4600 CONTINUE C IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')GOTO4660 C NCTEXT=1 ICTEXT(1)=ISYMBL C CALL GRINFO(ILAHEY,RLAHEY,CLAHEY) DO4610I=1,NP C PX1P=PX(I) PY1P=PY(I) CALL CALCPT(PX1P,PY1P,AX,AY,ISUBN0) ICOLMN=INT(REAL(ILAHEY(8))*(AX*RLAHEY(1)/11.0)+0.5) IF(IJUSTH.EQ.'RIGH')THEN NSHIFT=NCTEXT ELSEIF(IJUSTH.EQ.'CENT')THEN NSHIFT=NCTEXT/2 ELSE NSHIFT=0 ENDIF ICOLMN=ICOLMN-NSHIFT IF(ICOLMN.LT.1)ICOLMN=1 IF(ICOLMN.GT.ILAHEY(8))ICOLMN=ILAHEY(8) ILINE=INT(REAL(ILAHEY(9))*(RLAHEY(1)*(8.5-AY)/8.5)+0.5) IF(IJUSTV.EQ.'TOP')THEN NSHIFT=1 ELSEIF(IJUSTV.EQ.'CENT')THEN NSHIFT=1 ELSE NSHIFT=0 ENDIF ILINE=ILINE-NSHIFT IF(ILINE.LT.1)ILINE=1 IF(ILINE.GT.ILAHEY(9))ILINE=ILAHEY(9) CALL GTEXT(ILINE,ICOLMN,ISYMBL) C 4610 CONTINUE GOTO4690 C 4660 CONTINUE C IFONTH=0 IFONTV=0 IF(IJUST.EQ.'LEFT')IFONTH=0 IF(IJUST.EQ.'CENT')IFONTH=1 IF(IJUST.EQ.'RIGH')IFONTH=2 IF(IJUST.EQ.'LJUS')IFONTH=0 IF(IJUST.EQ.'CJUS')IFONTH=1 IF(IJUST.EQ.'RJUS')IFONTH=2 IF(IJUST.EQ.'LEBO')IFONTH=0 IF(IJUST.EQ.'CEBO')IFONTH=1 IF(IJUST.EQ.'RIBO')IFONTH=2 IF(IJUST.EQ.'LECE')IFONTH=0 IF(IJUST.EQ.'CECE')IFONTH=1 IF(IJUST.EQ.'RICE')IFONTH=2 IF(IJUST.EQ.'LETO')IFONTH=0 IF(IJUST.EQ.'CETO')IFONTH=1 IF(IJUST.EQ.'RITO')IFONTH=2 IF(IJUST.EQ.'LEFT')IFONTV=1 IF(IJUST.EQ.'CENT')IFONTV=1 IF(IJUST.EQ.'RIGH')IFONTV=1 IF(IJUST.EQ.'LJUS')IFONTV=1 IF(IJUST.EQ.'CJUS')IFONTV=1 IF(IJUST.EQ.'RJUS')IFONTV=1 IF(IJUST.EQ.'LEBO')IFONTV=1 IF(IJUST.EQ.'CEBO')IFONTV=1 IF(IJUST.EQ.'RIBO')IFONTV=1 IF(IJUST.EQ.'LECE')IFONTV=0 IF(IJUST.EQ.'CECE')IFONTV=0 IF(IJUST.EQ.'RICE')IFONTV=0 IF(IJUST.EQ.'LETO')IFONTV=2 IF(IJUST.EQ.'CETO')IFONTV=2 IF(IJUST.EQ.'RITO')IFONTV=2 NCOL=INT(PHEIGH) IF(NCOL.LT.1)NCOL=1 IF(IFONTH.EQ.0)THEN IXINC=0 ELSEIF(IFONTH.EQ.1)THEN IXINC=NCOL/2 ELSE IXINC=NCOL ENDIF IF(IFONTV.EQ.0)THEN IYINC=0 ELSEIF(IFONTV.EQ.1)THEN IYINC=NCOL/2 ELSE IYINC=NCOL ENDIF CALL GRINFO(ILAHEY,RLAHEY,CLAHEY) IPEN=JCOL DO4670I=1,NP PX1=PX(I) PY1=PY(I) CALL CALCPT(PX1,PY1,AX,AY,ISUBN0) CALL SETPIX(AX,AY,IPEN) C DO4675IROW=IX,IX+NCOL-1 C DO4678ICOLZ=IY,IY+NCOL-1 C AX2=AX+REAL(IX-IROW) C AY2=AY+REAL(IY-ICOL) C CALL SETPIX(AX,AY,IPEN) C4678 CONTINUE C4675 CONTINUE 4670 CONTINUE C 4690 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 47-- ** C ** TREAT THE MICROSOFT QUICKWIN DRIVER ** C ** FOR WINDOWS 95 AND WINDOWS NT. ** C ****************************************************** C 4700 CONTINUE C IFONTH=0 IFONTV=0 IF(IJUST.EQ.'LEFT')IFONTH=0 IF(IJUST.EQ.'CENT')IFONTH=1 IF(IJUST.EQ.'RIGH')IFONTH=2 IF(IJUST.EQ.'LJUS')IFONTH=0 IF(IJUST.EQ.'CJUS')IFONTH=1 IF(IJUST.EQ.'RJUS')IFONTH=2 IF(IJUST.EQ.'LEBO')IFONTH=0 IF(IJUST.EQ.'CEBO')IFONTH=1 IF(IJUST.EQ.'RIBO')IFONTH=2 IF(IJUST.EQ.'LECE')IFONTH=0 IF(IJUST.EQ.'CECE')IFONTH=1 IF(IJUST.EQ.'RICE')IFONTH=2 IF(IJUST.EQ.'LETO')IFONTH=0 IF(IJUST.EQ.'CETO')IFONTH=1 IF(IJUST.EQ.'RITO')IFONTH=2 IF(IJUST.EQ.'LEFT')IFONTV=1 IF(IJUST.EQ.'CENT')IFONTV=1 IF(IJUST.EQ.'RIGH')IFONTV=1 IF(IJUST.EQ.'LJUS')IFONTV=1 IF(IJUST.EQ.'CJUS')IFONTV=1 IF(IJUST.EQ.'RJUS')IFONTV=1 IF(IJUST.EQ.'LEBO')IFONTV=1 IF(IJUST.EQ.'CEBO')IFONTV=1 IF(IJUST.EQ.'RIBO')IFONTV=1 IF(IJUST.EQ.'LECE')IFONTV=0 IF(IJUST.EQ.'CECE')IFONTV=0 IF(IJUST.EQ.'RICE')IFONTV=0 IF(IJUST.EQ.'LETO')IFONTV=2 IF(IJUST.EQ.'CETO')IFONTV=2 IF(IJUST.EQ.'RITO')IFONTV=2 C IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')GOTO4760 C NCTEXT=1 ICTEXT(1)=ISYMBL C IWIDTH=0 CQWVF IWIDTH=GETGTEXTEXTENT(ISYMBL(1:1)) IF(IFONTH.EQ.0)THEN IXINC=0 ELSEIF(IFONTH.EQ.1)THEN IXINC=IWIDTH/2 ELSE IXINC=IWIDTH ENDIF IF(IFONTV.EQ.0)THEN IYINC=0 ELSEIF(IFONTV.EQ.1)THEN IYINC=PHEIG2/2 ELSE IYINC=PHEIG2 ENDIF C DO4710I=1,NP PX1P=PX(I) CCCCC PY1P=100.-PY(I) PY1P=PY(I) CALL GRTRSD(PX1P,PY1P,IX,IY,ISUBN0) CQWVF CALL MOVETO(INT2(IX-IXINC),INT2(IY-IYINC),WXY) CQWVF CALL OUTGTEXT(ISYMBL) 4710 CONTINUE GOTO4790 C CCCCC NOTE: QWIN DRIVER CURRENTLY SET TO USE 0 TO 100 COORDINATES. CCCCC THIS DOESN'T WORK SO WELL IF SETTING MULTIPLE PIXELS, CCCCC DOING IMAGE STUFF, ETC. NEED TO UPDATE ALGORITHM BELOW CCCCC TO CONVERT PERCENTAGES TO ACTUAL PIXELS. CURRENTLY, LIMIT CCCCC TO DRAWING A SINGLE PIXEL. 4760 CONTINUE C NCOL=INT(PHEIGH) IF(NCOL.LT.1)NCOL=1 IF(IFONTH.EQ.0)THEN IXINC=0 ELSEIF(IFONTH.EQ.1)THEN IXINC=NCOL/2 ELSE IXINC=NCOL ENDIF IF(IFONTV.EQ.0)THEN IYINC=0 ELSEIF(IFONTV.EQ.1)THEN IYINC=NCOL/2 ELSE IYINC=NCOL ENDIF DO4770I=1,NP PX1=PX(I) CCCCC PY1=100.-PY(I) PY1=PY(I) CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0) DO4775IROW=IX,IX+NCOL-1 DO4778ICOLZ=IY,IY+NCOL-1 IXTEMP=IROW-IXINC IYTEMP=ICOLZ-IYINC CQWVF IRESLT=SETPIXEL(INT2(IXTEMP),INT2(IYTEMP)) 4778 CONTINUE 4775 CONTINUE 4770 CONTINUE C 4790 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 48-- ** C ** TREAT THE OPEN-GL DRIVER ** C ** FOR WINDOWS 95 AND WINDOWS NT AND X11 ** C ****************************************************** C 4800 CONTINUE IF(IOPGOF.EQ.'OFF')GOTO9000 C IFONTH=0 IFONTV=0 IF(IJUST.EQ.'LEFT')IFONTH=0 IF(IJUST.EQ.'CENT')IFONTH=1 IF(IJUST.EQ.'RIGH')IFONTH=2 IF(IJUST.EQ.'LJUS')IFONTH=0 IF(IJUST.EQ.'CJUS')IFONTH=1 IF(IJUST.EQ.'RJUS')IFONTH=2 IF(IJUST.EQ.'LEBO')IFONTH=0 IF(IJUST.EQ.'CEBO')IFONTH=1 IF(IJUST.EQ.'RIBO')IFONTH=2 IF(IJUST.EQ.'LECE')IFONTH=0 IF(IJUST.EQ.'CECE')IFONTH=1 IF(IJUST.EQ.'RICE')IFONTH=2 IF(IJUST.EQ.'LETO')IFONTH=0 IF(IJUST.EQ.'CETO')IFONTH=1 IF(IJUST.EQ.'RITO')IFONTH=2 IF(IJUST.EQ.'LEFT')IFONTV=1 IF(IJUST.EQ.'CENT')IFONTV=1 IF(IJUST.EQ.'RIGH')IFONTV=1 IF(IJUST.EQ.'LJUS')IFONTV=1 IF(IJUST.EQ.'CJUS')IFONTV=1 IF(IJUST.EQ.'RJUS')IFONTV=1 IF(IJUST.EQ.'LEBO')IFONTV=1 IF(IJUST.EQ.'CEBO')IFONTV=1 IF(IJUST.EQ.'RIBO')IFONTV=1 IF(IJUST.EQ.'LECE')IFONTV=0 IF(IJUST.EQ.'CECE')IFONTV=0 IF(IJUST.EQ.'RICE')IFONTV=0 IF(IJUST.EQ.'LETO')IFONTV=2 IF(IJUST.EQ.'CETO')IFONTV=2 IF(IJUST.EQ.'RITO')IFONTV=2 C IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')GOTO4860 C CALL DPCOAN(ISYMBL(1:1),IJUNK) STRING(1)=IJUNK STRING(2)=0 C ILAST=80 DO4810I=80,1,-1 ILAST=I IF(IX11FN(I:I).NE.' ')GOTO4819 4810 CONTINUE 4819 CONTINUE DO4820I=1,ILAST CALL DPCOAN(IX11FN(I:I),IJUNK) IADE(I)=IJUNK 4820 CONTINUE IADE(ILAST+1)=0 C CALL GLTATT(IADE,IGLERR) IF(IGLERR.EQ.1) THEN WRITE(ICOUT,4821) CALL DPWRST('XXX','BUG ') ELSEIF(IGLERR.EQ.2)THEN WRITE(ICOUT,4822) CALL DPWRST('XXX','BUG ') END IF 4821 FORMAT(1X,'WARNING: X11 FONT NAME FOR OPEN-GL NOT FOUND. USE ', 1'CURRENT FONT.') 4822 FORMAT(1X,'WARNING: X11 FONT NAME FOR OPEN-GL NOT FOUND. USE ', 1'DEFAULT FONT.') C IGLERR=0 C DO4850I=1,NP PX1=PX(I) PY1=PY(I) CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0) CALL GLTEXH(STRING,IX,IY,IFONTH,IFONTV,IGLERR) IF(IGLERR.GT.0)THEN WRITE(ICOUT,4852) CALL DPWRST('XXX','BUG ') ENDIF 4852 FORMAT(1X,'ERROR: OPEN-GL PLOT SYMBOL RETURNED AN ERROR.') 4850 CONTINUE GOTO4899 C 4860 CONTINUE NCOL=INT(PHEIGH) IF(NCOL.LT.1)NCOL=1 IF(IFONTH.EQ.0)THEN IXINC=0 ELSEIF(IFONTH.EQ.1)THEN IXINC=NCOL/2 ELSE IXINC=NCOL ENDIF IF(IFONTV.EQ.0)THEN IYINC=0 ELSEIF(IFONTV.EQ.1)THEN IYINC=NCOL/2 ELSE IYINC=NCOL ENDIF DO4870I=1,NP PX1=PX(I) PY1=PY(I) CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0) DO4875IROW=IX,IX+NCOL-1 DO4878ICOLZ=IY,IY-NCOL+1,-1 IXTEMP=IROW-IXINC IYTEMP=ICOLZ+IYINC CALL GLPOIN(IXTEMP,IYTEMP,NCOL) 4878 CONTINUE 4875 CONTINUE 4870 CONTINUE C 4899 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 49-- ** C ** TREAT THE LAHEY INTERACTOR CASE ** C ****************************************************** C 4900 CONTINUE C IFONTH=0 IFONTV=0 IF(IJUST.EQ.'LEFT')IFONTH=0 IF(IJUST.EQ.'CENT')IFONTH=1 IF(IJUST.EQ.'RIGH')IFONTH=2 IF(IJUST.EQ.'LJUS')IFONTH=0 IF(IJUST.EQ.'CJUS')IFONTH=1 IF(IJUST.EQ.'RJUS')IFONTH=2 IF(IJUST.EQ.'LEBO')IFONTH=0 IF(IJUST.EQ.'CEBO')IFONTH=1 IF(IJUST.EQ.'RIBO')IFONTH=2 IF(IJUST.EQ.'LECE')IFONTH=0 IF(IJUST.EQ.'CECE')IFONTH=1 IF(IJUST.EQ.'RICE')IFONTH=2 IF(IJUST.EQ.'LETO')IFONTH=0 IF(IJUST.EQ.'CETO')IFONTH=1 IF(IJUST.EQ.'RITO')IFONTH=2 IF(IJUST.EQ.'LEFT')IFONTV=1 IF(IJUST.EQ.'CENT')IFONTV=1 IF(IJUST.EQ.'RIGH')IFONTV=1 IF(IJUST.EQ.'LJUS')IFONTV=1 IF(IJUST.EQ.'CJUS')IFONTV=1 IF(IJUST.EQ.'RJUS')IFONTV=1 IF(IJUST.EQ.'LEBO')IFONTV=1 IF(IJUST.EQ.'CEBO')IFONTV=1 IF(IJUST.EQ.'RIBO')IFONTV=1 IF(IJUST.EQ.'LECE')IFONTV=0 IF(IJUST.EQ.'CECE')IFONTV=0 IF(IJUST.EQ.'RICE')IFONTV=0 IF(IJUST.EQ.'LETO')IFONTV=2 IF(IJUST.EQ.'CETO')IFONTV=2 IF(IJUST.EQ.'RITO')IFONTV=2 C IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')GOTO4930 GOTO4949 C 4930 CONTINUE NCOL=INT(PHEIGH) IF(NCOL.LT.1)NCOL=1 IF(IFONTH.EQ.0)THEN IXINC=0 ELSEIF(IFONTH.EQ.1)THEN IXINC=NCOL/2 ELSE IXINC=NCOL ENDIF IF(IFONTV.EQ.0)THEN IYINC=0 ELSEIF(IFONTV.EQ.1)THEN IYINC=NCOL/2 ELSE IYINC=NCOL ENDIF DO4938I=1,NP CINTE CALL IGrPoint(PX(I),PY(I)) 4938 CONTINUE GOTO4999 C 4949 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 49B- ** C ** TREAT THE LAHEY WINTERACTOR CASE ** C ****************************************************** C 4950 CONTINUE C IFONTH=0 IFONTV=0 IF(IJUST.EQ.'LEFT')IFONTH=0 IF(IJUST.EQ.'CENT')IFONTH=1 IF(IJUST.EQ.'RIGH')IFONTH=2 IF(IJUST.EQ.'LJUS')IFONTH=0 IF(IJUST.EQ.'CJUS')IFONTH=1 IF(IJUST.EQ.'RJUS')IFONTH=2 IF(IJUST.EQ.'LEBO')IFONTH=0 IF(IJUST.EQ.'CEBO')IFONTH=1 IF(IJUST.EQ.'RIBO')IFONTH=2 IF(IJUST.EQ.'LECE')IFONTH=0 IF(IJUST.EQ.'CECE')IFONTH=1 IF(IJUST.EQ.'RICE')IFONTH=2 IF(IJUST.EQ.'LETO')IFONTH=0 IF(IJUST.EQ.'CETO')IFONTH=1 IF(IJUST.EQ.'RITO')IFONTH=2 IF(IJUST.EQ.'LEFT')IFONTV=1 IF(IJUST.EQ.'CENT')IFONTV=1 IF(IJUST.EQ.'RIGH')IFONTV=1 IF(IJUST.EQ.'LJUS')IFONTV=1 IF(IJUST.EQ.'CJUS')IFONTV=1 IF(IJUST.EQ.'RJUS')IFONTV=1 IF(IJUST.EQ.'LEBO')IFONTV=1 IF(IJUST.EQ.'CEBO')IFONTV=1 IF(IJUST.EQ.'RIBO')IFONTV=1 IF(IJUST.EQ.'LECE')IFONTV=0 IF(IJUST.EQ.'CECE')IFONTV=0 IF(IJUST.EQ.'RICE')IFONTV=0 IF(IJUST.EQ.'LETO')IFONTV=2 IF(IJUST.EQ.'CETO')IFONTV=2 IF(IJUST.EQ.'RITO')IFONTV=2 C IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')GOTO4980 GOTO4999 C 4980 CONTINUE NCOL=INT(PHEIGH) IF(NCOL.LT.1)NCOL=1 IF(IFONTH.EQ.0)THEN IXINC=0 ELSEIF(IFONTH.EQ.1)THEN IXINC=NCOL/2 ELSE IXINC=NCOL ENDIF IF(IFONTV.EQ.0)THEN IYINC=0 ELSEIF(IFONTV.EQ.1)THEN IYINC=NCOL/2 ELSE IYINC=NCOL ENDIF DO4988I=1,NP CWINT CALL IGrPoint(PX(I),PY(I)) 4988 CONTINUE GOTO4999 C 4999 CONTINUE GOTO9000 C C C ****************************************************** C ** STEP 41-- ** C ** TREAT THE CALCOMP XXXXXX CASE ** C ** TO DRAW A HORIZONTAL POLYMARKER-- ** C ** WRITE OUT AN XXXXXXXXXX ** C ** (NOT DONE) ** C ** REFERENCE--XX ** C ** XX ** C ** PAGES XX AND XX ** C ** USE CALCOMP LIBRARY ** C ** SYMBOL - WRITES TEXT ** C ** CALCPT - DATAPLOT ROUTINE TO CONVERT FROM ** C ** PERCENT UNITS TO INCHES ** C ** CALCTR - DATAPLOT ROUTINE TO CONVERT ** C ** CHARACTER VARIABLE TO HOLLERITH ** C ** FORMAT (NOT NECCESARY ON ALL ** C ** SYSTEMS, BUT IS ON OTHERS. ** C ****************************************************** C 5100 CONTINUE CCCCC IC4=ISYMBL CCCCC IC=IC4(1:4) CCCCC CALL ZETRCH(IC,IC1,IC2) C CCCCC DO5110I=1,NP C CCCCC ICSTR(1:1)='1' CCCCC NCSTR=1 C CCCCC PX1P=PX(I)-PXINC CCCCC PY1P=PY(I)-PYINC CCCCC CALL GRTRSD(PX1P,PY1P,IX,IY,ISUBN0) CCCCC CALL ZETRPT(IX,IY,ICSTR,NCSTR,ISUBN0) C CCCCC NCSTR=NCSTR+1 CCCCC ICSTR(NCSTR:NCSTR)='3' C CCCCC PXDEL=PWIDT2+PHOGA2 CCCCC PYDEL=PHEIG2+PVEGA2 CCCCC CALL GRTRSD(PXDEL,PYDEL,IXW,IYH,ISUBN0) CCCCC CALL ZETRPT(IXW,IYH,ICSTR,NCSTR,ISUBN0) C CCCCC NCSTR=NCSTR+1 CCCCC ICSTR(NCSTR:NCSTR)='0' CCCCC NCSTR=NCSTR+1 CCCCC ICSTR(NCSTR:NCSTR)='1' C CCCCC NCSTR=NCSTR+1 CCCCC ICSTR(NCSTR:NCSTR)=IC1 CCCCC NCSTR=NCSTR+1 CCCCC ICSTR(NCSTR:NCSTR)=IC2 C CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0) C C5110 CONTINUE C C5190 CONTINUE C IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')GOTO5160 C NCTEXT=1 ICTEXT(1)=ISYMBL C DO5110I=1,NP C PX1P=PX(I)-PXINC PY1P=PY(I)-PYINC CALL CALCPT(PX1P,PY1P,AX,AY,ISUBN0) ANGLE=0. AXTEMP=0. CALL CALCPT(AXTEMP,PHEIG2,AYTMP2,HEIGHT,ISUBN0) CALL CALCTR(ICTEXT,IHOLL,NCTEXT) CCCCC CALL SYMBOL(AX,AY,HEIGHT,IHOLL,ANGLE,NCTEXT) C 5110 CONTINUE C GOTO5190 C 5160 CONTINUE WRITE(ICOUT,5162) 5162 FORMAT('****** THE PIXEL CAPABILITY IS NOT YET SUPPORTED FOR ', 1'THE ZETA DEVICE.') CALL DPWRST('XXX','BUG ') C 5190 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 61-- ** C ** TREAT THE RAMTEK XXXXXX CASE ** C ** TO DRAW A HORIZONTAL POLYMARKER-- ** C ** WRITE OUT AN XXXXXXXXXX ** C ** (NOT DONE) ** C ** REFERENCE--XX ** C ** XX ** C ** PAGES XX AND XX ** C ****************************************************** C 6100 CONTINUE CCCCC WRITE(IGUNIT,6111) C6111 FORMAT('FIX SUBROUTINE GRDRPH TO DRAW HOR POLYM RAMTEK DEV.') ICSTR(1:51)='FIX SUBROUTINE GRDRPH TO DRAW HOR POLYM RAMTEK DEV.' NCSTR=51 CALL GRWRST(ICSTR,NCSTR,ISUBN0) GOTO9000 C C ****************************************************** C ** STEP 66-- ** C ** TREAT THE SUN CASE ** C ** WRITTEN BY BILL ANDERSON ** C ****************************************************** C 6600 CONTINUE C IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')GOTO6660 C ICSTR(1:1)=ISYMBL(1:1) ITEMP=0 CALL DPCONA(ITEMP,ICSTR(2:2)) C DO6610I=1,NP C PX1P = PX(I)-PXINC PY1P = PY(I)-PYINC CALL GRTRSD(PX1P,PY1P,IX1P,IY1P,ISUBN0) CSUN CALL cftext(IX1P,IY1P,ICSTR(1:2)) 6610 CONTINUE C GOTO6690 C 6660 CONTINUE IFONTH=0 IFONTV=0 IF(IJUST.EQ.'LEFT')IFONTH=0 IF(IJUST.EQ.'CENT')IFONTH=1 IF(IJUST.EQ.'RIGH')IFONTH=2 IF(IJUST.EQ.'LJUS')IFONTH=0 IF(IJUST.EQ.'CJUS')IFONTH=1 IF(IJUST.EQ.'RJUS')IFONTH=2 IF(IJUST.EQ.'LEBO')IFONTH=0 IF(IJUST.EQ.'CEBO')IFONTH=1 IF(IJUST.EQ.'RIBO')IFONTH=2 IF(IJUST.EQ.'LECE')IFONTH=0 IF(IJUST.EQ.'CECE')IFONTH=1 IF(IJUST.EQ.'RICE')IFONTH=2 IF(IJUST.EQ.'LETO')IFONTH=0 IF(IJUST.EQ.'CETO')IFONTH=1 IF(IJUST.EQ.'RITO')IFONTH=2 IF(IJUST.EQ.'LEFT')IFONTV=1 IF(IJUST.EQ.'CENT')IFONTV=1 IF(IJUST.EQ.'RIGH')IFONTV=1 IF(IJUST.EQ.'LJUS')IFONTV=1 IF(IJUST.EQ.'CJUS')IFONTV=1 IF(IJUST.EQ.'RJUS')IFONTV=1 IF(IJUST.EQ.'LEBO')IFONTV=1 IF(IJUST.EQ.'CEBO')IFONTV=1 IF(IJUST.EQ.'RIBO')IFONTV=1 IF(IJUST.EQ.'LECE')IFONTV=0 IF(IJUST.EQ.'CECE')IFONTV=0 IF(IJUST.EQ.'RICE')IFONTV=0 IF(IJUST.EQ.'LETO')IFONTV=2 IF(IJUST.EQ.'CETO')IFONTV=2 IF(IJUST.EQ.'RITO')IFONTV=2 NCOL=INT(PHEIGH) IF(NCOL.LT.1)NCOL=1 IF(IFONTH.EQ.0)THEN IXINC=0 ELSEIF(IFONTH.EQ.1)THEN IXINC=NCOL/2 ELSE IXINC=NCOL ENDIF IF(IFONTV.EQ.0)THEN IYINC=0 ELSEIF(IFONTV.EQ.1)THEN IYINC=NCOL/2 ELSE IYINC=NCOL ENDIF DO6670I=1,NP PX1=PX(I) PY1=PY(I) CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0) IX2=IX+NCOL-1 IY2=IY+NCOL-1 CSUN CALL cfrectangle(IX,IY,IX2,IY2) 6670 CONTINUE C 6690 CONTINUE C GOTO9000 C C ****************************************************** C ** STEP 71-- ** C ** TREAT THE XXXXXX XXXXXX CASE ** C ** TO DRAW A HORIZONTAL POLYMARKER-- ** C ** WRITE OUT AN XXXXXXXXXX ** C ** (NOT DONE) ** C ** REFERENCE--XX ** C ** XX ** C ** PAGES XX AND XX ** C ****************************************************** C 7100 CONTINUE CCCCC WRITE(IGUNIT,7111) C7111 FORMAT('FIX SUBROUTINE GRDRPH TO DRAW HOR POLYM XXXXXX DEV.') ICSTR(1:52)='FIX SUBROUTINE GRDRPH TO DRAW HOR POLYM XXXXXX DEV.' NCSTR=52 CALL GRWRST(ICSTR,NCSTR,ISUBN0) GOTO9000 C C ****************************************************** C ** STEP 81-- ** C ** TREAT THE DEC REGIS CASE ** C ** TO DRAW A HORIZONTAL POLYMARKER-- ** C ** USE THE P [ X, Y ] (= POSITION) INSTRUCTION ** C ** WITH INTEGER COORDINATES, ** C ** AND THE T ' STRING ' (= TEXT) INSTRUCTION ** C ** WITH THE DESIRED TEXT STRING, ** C ** REFERENCE--VT125 GRAPHICS TERMINAL USER GUIDE ** C ** PAGES 100 AND 118 ** C ****************************************************** C C MARCH, 1991. PACK REGIS OUTPUT. ALSO, REGIS DRAWS CHARACTER BELOW C RATHER THAN ABOVE THE CURSUR POSITION (AS DATAPLOT ASSUMES), SO ADJUST C Y COORDINATE BY ONE CHARACTER POSITION. C CCCCC SEPTEMBER 1995. ADD "PIXEL" CAPABILITY. DO A MOVE, THEN A V[] CCCCC INSTRUCTION. 8100 CONTINUE C IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')GOTO8160 C NCTEXT=1 ICTEXT(NCTEXT)=ISYMBL NCTEP1=NCTEXT+1 ICTEXT(NCTEP1)='''' C NCSTR=0 NCHTOT=5 MAXREG=130 ISIZE=16+NCTEP1 DO8110I=1,NP C IF(NCSTR.GT.MAXREG-ISIZE)THEN CALL GRWRST(ICSTR,NCSTR,ISUBN0) NCSTR=0 END IF C PX1P=PX(I)-PXINC PY1P=PY(I)-PYINC PY1P=PY1P+PHEIG2 CALL GRTRSD(PX1P,PY1P,IX,IY,ISUBN0) NCSTR=NCSTR+1 NCSTR2=NCSTR+1 ICSTR(NCSTR:NCSTR2)='P[' NCSTR=NCSTR2 CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=']' C NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='T' NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='''' DO8112J=1,NCTEP1 K=J+NCSTR ICSTR(K:K)=ICTEXT(J) 8112 CONTINUE NCSTR=K C 8110 CONTINUE IF(NCSTR.GT.0)CALL GRWRST(ICSTR,NCSTR,ISUBN0) C GOTO8190 C 8160 CONTINUE IFONTH=0 IFONTV=0 IF(IJUST.EQ.'LEFT')IFONTH=0 IF(IJUST.EQ.'CENT')IFONTH=1 IF(IJUST.EQ.'RIGH')IFONTH=2 IF(IJUST.EQ.'LJUS')IFONTH=0 IF(IJUST.EQ.'CJUS')IFONTH=1 IF(IJUST.EQ.'RJUS')IFONTH=2 IF(IJUST.EQ.'LEBO')IFONTH=0 IF(IJUST.EQ.'CEBO')IFONTH=1 IF(IJUST.EQ.'RIBO')IFONTH=2 IF(IJUST.EQ.'LECE')IFONTH=0 IF(IJUST.EQ.'CECE')IFONTH=1 IF(IJUST.EQ.'RICE')IFONTH=2 IF(IJUST.EQ.'LETO')IFONTH=0 IF(IJUST.EQ.'CETO')IFONTH=1 IF(IJUST.EQ.'RITO')IFONTH=2 IF(IJUST.EQ.'LEFT')IFONTV=1 IF(IJUST.EQ.'CENT')IFONTV=1 IF(IJUST.EQ.'RIGH')IFONTV=1 IF(IJUST.EQ.'LJUS')IFONTV=1 IF(IJUST.EQ.'CJUS')IFONTV=1 IF(IJUST.EQ.'RJUS')IFONTV=1 IF(IJUST.EQ.'LEBO')IFONTV=1 IF(IJUST.EQ.'CEBO')IFONTV=1 IF(IJUST.EQ.'RIBO')IFONTV=1 IF(IJUST.EQ.'LECE')IFONTV=0 IF(IJUST.EQ.'CECE')IFONTV=0 IF(IJUST.EQ.'RICE')IFONTV=0 IF(IJUST.EQ.'LETO')IFONTV=2 IF(IJUST.EQ.'CETO')IFONTV=2 IF(IJUST.EQ.'RITO')IFONTV=2 NCOL=INT(PHEIGH) IF(NCOL.LT.1)NCOL=1 IF(IFONTH.EQ.0)THEN IXINC=0 ELSEIF(IFONTH.EQ.1)THEN IXINC=NCOL/2 ELSE IXINC=NCOL ENDIF IF(IFONTV.EQ.0)THEN IYINC=0 ELSEIF(IFONTV.EQ.1)THEN IYINC=NCOL/2 ELSE IYINC=NCOL ENDIF DO8170I=1,NP PX1=PX(I) PY1=PY(I) CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0) DO8175IROW=IX,IX+NCOL-1 DO8178ICOLZ=IY,IY-NCOL+1,-1 IXTEMP=IROW-IXINC IYTEMP=ICOLZ+IYINC C ICSTR(1:2)='P[' NCSTR=2 NCHTOT=5 CALL GRTRIN(IXTEMP,NCHTOT,ICSTR,NCSTR) ICSTR(8:8)=',' NCSTR=8 CALL GRTRIN(IYTEMP,NCHTOT,ICSTR,NCSTR) ICSTR(14:14)=']' ICSTR(15:17)='V[]' NCSTR=17 CALL GRWRST(ICSTR,NCSTR,ISUBN0) C 8178 CONTINUE 8175 CONTINUE 8170 CONTINUE C 8190 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 86-- ** C ** TREAT THE POSTSCRIPT CASE ** C ** XCOOR YCOOR MOVETO (USE UNADJUSTED COORD.) ** C ** (ISYMBL) SHOW ** C ** RIGHTSHOW AND CENTSHOW ARE DATAPLOT DEFINED ** C ** PROCEDURES FOR PRINTING RIGHT AND CENTER ** C ** JUSTIFIED STRINGS RESPECTIVELY ** C ** REFERENCE--POSTSCRIPT LANGUAGE TUTORIAL AND ** C ** COOKBOOOK, ADOBE SYSTEMS ** C ** PAGE--37 ** C ** CHECK FOR "(", ")", AND BACKSLASH. IF FOUND, ** C ** PRECEDE WITH A BACKSLASH ** C ****************************************************** CCCCC OCTOBER 1991. MAKE POSTSCRIPT FONTS TABLE DRIVEN. CCCCC SEPTEMBER 1995. ADD PIXEL CAPABILITY. C 8600 CONTINUE C IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')GOTO8660 C PHEIPP=ANUMVP*PHEIG2/100. IPSTPS=INT(PHEIPP+0.5) IF(IPSTFN.EQ.IPSTFC.AND.IPSTPC.EQ.IPSTPS)GOTO8605 C FOLLOWING CODE MODIFIED OCTOBER 1991. IJUNK=7 DO8695I=1,IPSTMF IF(IPSTFN.NE.IPSTT1(I))GOTO8695 IJUNK=I GOTO8697 8695 CONTINUE 8697 CONTINUE ICSTR(1:1)='/' ICSTR(2:41)=IPSTT2(IJUNK)(1:40) ICSTR(42:51)=' findfont ' NCHTOT=5 NCSTR=51 CALL GRTRIN(IPSTPS,NCHTOT,ICSTR,NCSTR) NCSTR=NCSTR+1 NCSTR2=NCSTR+17 ICSTR(NCSTR:NCSTR2)=' scalefont setfont' NCSTR=NCSTR2 CALL GRWRST(ICSTR,NCSTR,ISUBN0) CCCCC ICSTR(1:33)='/Times-Roman findfont ' CCCCC IF(IPSTFN.EQ.'TBOL') CCCCC1ICSTR(1:23)='/Times-Bold ' CCCCC IF(IPSTFN.EQ.'TITA') CCCCC1ICSTR(1:23)='/Times-Italic ' CCCCC IF(IPSTFN.EQ.'TBIT') CCCCC1ICSTR(1:23)='/Times-BoldItalic ' CCCCC IF(IPSTFN.EQ.'HELV') CCCCC1ICSTR(1:23)='/Helvetica ' CCCCC IF(IPSTFN.EQ.'HELB') CCCCC1ICSTR(1:23)='/Helvetica-Bold ' CCCCC IF(IPSTFN.EQ.'HELO') CCCCC1ICSTR(1:23)='/Helvetica-Oblique ' CCCCC IF(IPSTFN.EQ.'HEBO') CCCCC1ICSTR(1:23)='/Helvetica-BoldOblique ' CCCCC IF(IPSTFN.EQ.'COUR') CCCCC1ICSTR(1:23)='/Courier ' CCCCC IF(IPSTFN.EQ.'CBOL') CCCCC1ICSTR(1:23)='/Courier-Bold ' CCCCC IF(IPSTFN.EQ.'COBL') CCCCC1ICSTR(1:23)='/Courier-Oblique ' CCCCC IF(IPSTFN.EQ.'CBOB') CCCCC1ICSTR(1:23)='/Courier-BoldOblique ' CCCCC NCSTR=33 CCCCC NCHTOT=5 CCCCC CALL GRTRIN(IPSTPS,NCHTOT,ICSTR,NCSTR) CCCCC ICSTR(39:56)=' scalefont setfont' CCCCC NCSTR=56 CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0) C C END OF CHANGE IPSTFC=IPSTFN IPSTPC=IPSTPS C 8605 CONTINUE CCCCC THE FOLLOWING 2 LINES WERE FIXED (SOFT-CODE BACKSLASH) APRIL 1989 IF(ISYMBL.NE.'('.AND.ISYMBL.NE.')'.AND.ISYMBL.NE.IBASLC)GOTO8608 ICTEXT(1)=IBASLC NCTEXT=2 ICTEXT(NCTEXT)=ISYMBL GOTO8609 8608 CONTINUE NCTEXT=1 ICTEXT(NCTEXT)=ISYMBL 8609 CONTINUE C DO8610I=1,NP C CCCCC 6 LINES IN THE FOLLOWING SECTION WERE FIXED MAY 1991 (ALAN) PX1P=PX(I) PY1P=PY(I)-PYINC CCCCC ICSTR(1:3)='/IX ' ICSTR(1:4)='/IX ' CCCCC NCSTR=3 NCSTR=4 CALL GRTRSD(PX1P,PY1P,IX,IY,ISUBN0) NCHTOT=5 CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR) CCCCC ICSTR(9:17)=' def /IY ' ICSTR(10:18)=' def /IY ' CCCCC NCSTR=17 NCSTR=18 CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR) CCCCC ICSTR(23:28)=' def (' ICSTR(24:29)=' def (' CCCCC NCSTR=28 NCSTR=29 DO8620J=1,NCTEXT NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=ICTEXT(J) 8620 CONTINUE NCSTR=NCSTR+1 NCSTR2=NCSTR+1 ICSTR(NCSTR:NCSTR2)=') ' NCSTR=NCSTR2+1 NCSTR2=NCSTR+8 IF(IJUST(1:1).EQ.'L')ICSTR(NCSTR:NCSTR2)='leftshow ' IF(IJUST(1:1).EQ.'C')ICSTR(NCSTR:NCSTR2)='centshow ' IF(IJUST(1:1).EQ.'R')ICSTR(NCSTR:NCSTR2)='rightshow' NCSTR=NCSTR2 CALL GRWRST(ICSTR,NCSTR,ISUBN0) C 8610 CONTINUE GOTO8690 C 8660 CONTINUE IFONTH=0 IFONTV=0 IF(IJUST.EQ.'LEFT')IFONTH=0 IF(IJUST.EQ.'CENT')IFONTH=1 IF(IJUST.EQ.'RIGH')IFONTH=2 IF(IJUST.EQ.'LJUS')IFONTH=0 IF(IJUST.EQ.'CJUS')IFONTH=1 IF(IJUST.EQ.'RJUS')IFONTH=2 IF(IJUST.EQ.'LEBO')IFONTH=0 IF(IJUST.EQ.'CEBO')IFONTH=1 IF(IJUST.EQ.'RIBO')IFONTH=2 IF(IJUST.EQ.'LECE')IFONTH=0 IF(IJUST.EQ.'CECE')IFONTH=1 IF(IJUST.EQ.'RICE')IFONTH=2 IF(IJUST.EQ.'LETO')IFONTH=0 IF(IJUST.EQ.'CETO')IFONTH=1 IF(IJUST.EQ.'RITO')IFONTH=2 IF(IJUST.EQ.'LEFT')IFONTV=1 IF(IJUST.EQ.'CENT')IFONTV=1 IF(IJUST.EQ.'RIGH')IFONTV=1 IF(IJUST.EQ.'LJUS')IFONTV=1 IF(IJUST.EQ.'CJUS')IFONTV=1 IF(IJUST.EQ.'RJUS')IFONTV=1 IF(IJUST.EQ.'LEBO')IFONTV=1 IF(IJUST.EQ.'CEBO')IFONTV=1 IF(IJUST.EQ.'RIBO')IFONTV=1 IF(IJUST.EQ.'LECE')IFONTV=0 IF(IJUST.EQ.'CECE')IFONTV=0 IF(IJUST.EQ.'RICE')IFONTV=0 IF(IJUST.EQ.'LETO')IFONTV=2 IF(IJUST.EQ.'CETO')IFONTV=2 IF(IJUST.EQ.'RITO')IFONTV=2 NCOL=INT(PHEIGH) IF(NCOL.LT.1)NCOL=1 IF(IFONTH.EQ.0)THEN IXINC=0 ELSEIF(IFONTH.EQ.1)THEN IXINC=NCOL/2 ELSE IXINC=NCOL ENDIF IF(IFONTV.EQ.0)THEN IYINC=0 ELSEIF(IFONTV.EQ.1)THEN IYINC=NCOL/2 ELSE IYINC=NCOL ENDIF ICSTR(1:14)='1 setlinewidth' NCSTR=14 CALL GRWRST(ICSTR,NCSTR,ISUBN0) DO8670I=1,NP PX1=PX(I) PY1=PY(I) CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0) IX=IX-IXINC IY=IY-IYINC IX2=IX+NCOL-1 IY2=IY+NCOL-1 DO8680ICOLZ=IY,IY2 ICSTR(1:8)='newpath ' NCSTR=8 NCHTOT=5 CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR) ICSTR(14:14)=' ' NCSTR=14 CALL GRTRIN(ICOLZ,NCHTOT,ICSTR,NCSTR) ICSTR(20:27)=' moveto ' NCSTR=27 CALL GRTRIN(IX2,NCHTOT,ICSTR,NCSTR) ICSTR(33:33)=' ' NCSTR=33 CALL GRTRIN(ICOLZ,NCHTOT,ICSTR,NCSTR) ICSTR(39:52)=' lineto stroke' NCSTR=52 CALL GRWRST(ICSTR,NCSTR,ISUBN0) 8680 CONTINUE 8670 CONTINUE C 8690 CONTINUE C GOTO9000 C C ****************************************************** C ** STEP 89-- ** C ** TREAT THE DISPLAY POSTSCRIPT DRIVER ** C ****************************************************** C 8900 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 91-- ** C ** TREAT THE QUIC LANDSCAPE AND PORTRAIT CASE ** C ** IVvvvvv - VERTICAL POSITION ** C ** IHhhhhh - HORIZONTAL POSITION ** C ** REFERENCE: QUIC PROGRAMMERS MANUAL - ** C ** ** C ****************************************************** C 9100 CONTINUE C IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')THEN WRITE(ICOUT,9162) CALL DPWRST('XXX','BUG ') C GOTO9000 ENDIF 9162 FORMAT('****** THE PIXEL CAPABILITY IS NOT YET SUPPORTED FOR ', 1'THE QMS DEVICE.') C CALL DPCONA(94,ICARAT) C IFONTT=IQUIFN IF(IORNSW.EQ.'PORT'.AND.( 1IFONTT.EQ.521.OR. 1IFONTT.EQ.522.OR. 1IFONTT.EQ.523.OR. 1IFONTT.EQ.524))IFONTT=10 IF(IORNSW.NE.'PORT'.AND.( 1IFONTT.EQ.124.OR. 1IFONTT.EQ.144.OR. 1IFONTT.EQ.16.OR. 1IFONTT.EQ.328.OR. 1IFONTT.EQ.998.OR. 1IFONTT.EQ.404.OR. 1IFONTT.EQ.444.OR. 1IFONTT.EQ.532))IFONTT=10 IF(IFONTT.EQ.IQUIFC)GOTO9105 ICSTR(1:1)=ICARAT ICSTR(2:3)='IS' IQUIFC=IFONTT KFONT=IFONTT NCHTOT=-5 NCSTR=3 CALL GRTRIN(KFONT,NCHTOT,ICSTR,NCSTR) NCSTR=8 CALL GRWRST(ICSTR,NCSTR,ISUBN0) C 9105 CONTINUE NCTEXT=1 ICTEXT(NCTEXT)=ISYMBL NCSTR=0 ANUMPP=ANUMHP IF(IJUST(1:1).EQ.'L')GOTO9109 PXINC=PWIDT2 IF(IFONTT.EQ.10)GOTO9108 IF(IFONTT.EQ.404)GOTO9108 IF(IFONTT.EQ.444)GOTO9108 IF(IFONTT.EQ.521)GOTO9108 IF(IFONTT.EQ.522)GOTO9108 IF(IFONTT.EQ.523)GOTO9108 IF(IFONTT.EQ.524)GOTO9108 IF(IFONTT.EQ.532)GOTO9108 IF(IFONTT.EQ.904)GOTO9108 IF(IFONTT.EQ.924)GOTO9108 IF(IFONTT.EQ.536)GOTO9108 IF(IFONTT.EQ.517)GOTO9108 IF(IFONTT.EQ.104)CALL QUICH1(ICTEXT,NCTEXT,PXLEC,PXLECG,ANUMPP) IF(IFONTT.EQ.124)CALL QUICH2(ICTEXT,NCTEXT,PXLEC,PXLECG,ANUMPP) IF(IFONTT.EQ.144)CALL QUICH3(ICTEXT,NCTEXT,PXLEC,PXLECG,ANUMPP) IF(IFONTT.EQ.16) CALL QUICH4(ICTEXT,NCTEXT,PXLEC,PXLECG,ANUMPP) IF(IFONTT.EQ.204)CALL QUICH5(ICTEXT,NCTEXT,PXLEC,PXLECG,ANUMPP) IF(IFONTT.EQ.328)CALL QUICH6(ICTEXT,NCTEXT,PXLEC,PXLECG,ANUMPP) IF(IFONTT.EQ.998)CALL QUICH7(ICTEXT,NCTEXT,PXLEC,PXLECG,ANUMPP) IF(IFONTT.EQ.664)CALL QUICH8(ICTEXT,NCTEXT,PXLEC,PXLECG,ANUMPP) PXINC=PXLECG C 9108 CONTINUE IF(IJUST(1:1).EQ.'C')PXINC=PXINC/2. 9109 CONTINUE C NCHTOT=-5 DO9110I=1,NP C PX1P=PX(I)-PXINC PY1P=PY(I)-PYINC PY1P=100.-PY1P CALL QUICPT(PX1P,PY1P,IX,IY,ISUBN0) ICSTR(6:6)=ICARAT ICSTR(7:8)='IH' NCSTR=8 CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR) ICSTR(14:14)=ICARAT ICSTR(15:16)='IV' NCSTR=16 CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR) ICSTR(22:22)=ICTEXT(NCTEXT) NCSTR=22 CALL GRWRST(ICSTR,NCSTR,ISUBN0) C 9110 CONTINUE C 9190 CONTINUE C GOTO9000 C C ****************************************************** C ** STEP 95-- ** C ** TREAT THE X11 CASE ** C ****************************************************** C CCCCC SEPTEMBER 1995. ADD "PIXEL" SYMBOL. THIS IS A SPECIAL CASE CCCCC TO TURN ON A SINGLE PIXEL. IN THIS CASE, THE PHEIGH VARIABLE CCCCC IS INTERPRETED AS AN INTEGER SCALE FACTOR, I.E. CHARACTER SIZE CCCCC 6 WILL DRAW A PIXEL BOX 6 WIDE AND 6 HIGH. THIS CAPABILITY BEING CCCCC ADDED FOR FUTURE PLANNED IMPLEMENTATIONS, FOR EXAMPLE TO DO CCCCC SOME IMAGE PROCESSING. 9600 CONTINUE C IF(IX11OF.EQ.'OFF')GOTO9000 C IFONTH=0 IFONTV=0 IF(IJUST.EQ.'LEFT')IFONTH=0 IF(IJUST.EQ.'CENT')IFONTH=1 IF(IJUST.EQ.'RIGH')IFONTH=2 IF(IJUST.EQ.'LJUS')IFONTH=0 IF(IJUST.EQ.'CJUS')IFONTH=1 IF(IJUST.EQ.'RJUS')IFONTH=2 IF(IJUST.EQ.'LEBO')IFONTH=0 IF(IJUST.EQ.'CEBO')IFONTH=1 IF(IJUST.EQ.'RIBO')IFONTH=2 IF(IJUST.EQ.'LECE')IFONTH=0 IF(IJUST.EQ.'CECE')IFONTH=1 IF(IJUST.EQ.'RICE')IFONTH=2 IF(IJUST.EQ.'LETO')IFONTH=0 IF(IJUST.EQ.'CETO')IFONTH=1 IF(IJUST.EQ.'RITO')IFONTH=2 IF(IJUST.EQ.'LEFT')IFONTV=1 IF(IJUST.EQ.'CENT')IFONTV=1 IF(IJUST.EQ.'RIGH')IFONTV=1 IF(IJUST.EQ.'LJUS')IFONTV=1 IF(IJUST.EQ.'CJUS')IFONTV=1 IF(IJUST.EQ.'RJUS')IFONTV=1 IF(IJUST.EQ.'LEBO')IFONTV=1 IF(IJUST.EQ.'CEBO')IFONTV=1 IF(IJUST.EQ.'RIBO')IFONTV=1 IF(IJUST.EQ.'LECE')IFONTV=0 IF(IJUST.EQ.'CECE')IFONTV=0 IF(IJUST.EQ.'RICE')IFONTV=0 IF(IJUST.EQ.'LETO')IFONTV=2 IF(IJUST.EQ.'CETO')IFONTV=2 IF(IJUST.EQ.'RITO')IFONTV=2 C IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')GOTO9660 C CALL DPCOAN(ISYMBL(1:1),IJUNK) STRING(1)=IJUNK STRING(2)=0 C ILAST=80 DO9610I=80,1,-1 ILAST=I IF(IX11FN(I:I).NE.' ')GOTO9619 9610 CONTINUE 9619 CONTINUE DO9620I=1,ILAST CALL DPCOAN(IX11FN(I:I),IJUNK) IADE(I)=IJUNK 9620 CONTINUE IADE(ILAST+1)=0 C CALL XTATTR(IADE,IXERR) IF(IXERR.EQ.1) THEN WRITE(ICOUT,9621) CALL DPWRST('XXX','BUG ') ELSEIF(IXERR.EQ.2)THEN WRITE(ICOUT,9622) CALL DPWRST('XXX','BUG ') END IF 9621 FORMAT(1X,'WARNING: X11 FONT NAME NOT FOUND. USE CURRENT FONT.') 9622 FORMAT(1X,'WARNING: X11 FONT NAME NOT FOUND. USE DEFAULT FONT.') C IXERR=0 C DO9650I=1,NP PX1=PX(I) PY1=PY(I) CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0) CALL XTEXTH(STRING,IX,IY,IFONTH,IFONTV,IXERR) 9650 CONTINUE GOTO9699 C 9660 CONTINUE NCOL=INT(PHEIGH) IF(NCOL.LT.1)NCOL=1 IF(IFONTH.EQ.0)THEN IXINC=0 ELSEIF(IFONTH.EQ.1)THEN IXINC=NCOL/2 ELSE IXINC=NCOL ENDIF IF(IFONTV.EQ.0)THEN IYINC=0 ELSEIF(IFONTV.EQ.1)THEN IYINC=NCOL/2 ELSE IYINC=NCOL ENDIF DO9670I=1,NP PX1=PX(I) PY1=PY(I) CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0) DO9675IROW=IX,IX+NCOL-1 DO9678ICOLZ=IY,IY-NCOL+1,-1 IXTEMP=IROW-IXINC IYTEMP=ICOLZ+IYINC CALL XPOINT(IXTEMP,IYTEMP) 9678 CONTINUE 9675 CONTINUE 9670 CONTINUE C 9699 CONTINUE GOTO9000 C C ************************************************* C ** STEP 100-- ** C ** TREAT THE VGA VIA TURBO-C CASE ** C ** REFERENCE--TURBO C 1.5 ADDITIONS & ** C ** ENHANCEMENTS, PAGE 124, 113. ** C ** REFERENCE--TURBO C 2.0 REFERENCE GUIDE, ** C ** PAGE 324-325, 256. ** C ** REFERENCE--WEISKAMP, POWER GRAPHICS ** C ** USING TURBO C, PAGE 59-60, 54-55** C ************************************************* C 10000 CONTINUE C IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')THEN WRITE(ICOUT,10162) CALL DPWRST('XXX','BUG ') C GOTO9000 ENDIF 10162 FORMAT('****** THE PIXEL CAPABILITY IS NOT YET SUPPORTED FOR ', 1'THE VGA DEVICE.') C CCCCC THE FOLLOWING SECTION WAS REWRITTEN SEPTEMBER 1995 IF(ITCST.EQ.'CLOS')GOTO10099 C NCTEXT=1 ICTEXT(NCTEXT)=ISYMBL C IC4='CECE' CALL TCSEJU(IC4) DO10100I=1,NP PX1P=PX(I) PY1P=PY(I) CALL GRTRSA(PX1P,PY1P,AX1,AY1,ISUBN0) PX1P=AX1 PY1P=AY1 CALL TCMOTO(PX1P,PY1P) CALL TCWRTE(ICTEXT,NCTEXT) 10100 CONTINUE 10099 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 110-- ** C ** TREAT THE GKS DRIVER ** C ****************************************************** C 11000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 120-- ** C ** TREAT THE GD DRIVER ** C ** THIS LIBRARY PROVIDES SUPPORT FOR: ** C ** 1) JPEG ** C ** 2) PNG ** C ** 3) WINDOWS BMP (BLACK/WHITE ONLY) ** C ****************************************************** C 12000 CONTINUE C IFONTH=0 IFONTV=0 IF(IJUST.EQ.'LEFT')IFONTH=0 IF(IJUST.EQ.'CENT')IFONTH=1 IF(IJUST.EQ.'RIGH')IFONTH=2 IF(IJUST.EQ.'LJUS')IFONTH=0 IF(IJUST.EQ.'CJUS')IFONTH=1 IF(IJUST.EQ.'RJUS')IFONTH=2 IF(IJUST.EQ.'LEBO')IFONTH=0 IF(IJUST.EQ.'CEBO')IFONTH=1 IF(IJUST.EQ.'RIBO')IFONTH=2 IF(IJUST.EQ.'LECE')IFONTH=0 IF(IJUST.EQ.'CECE')IFONTH=1 IF(IJUST.EQ.'RICE')IFONTH=2 IF(IJUST.EQ.'LETO')IFONTH=0 IF(IJUST.EQ.'CETO')IFONTH=1 IF(IJUST.EQ.'RITO')IFONTH=2 IF(IJUST.EQ.'LEFT')IFONTV=1 IF(IJUST.EQ.'CENT')IFONTV=1 IF(IJUST.EQ.'RIGH')IFONTV=1 IF(IJUST.EQ.'LJUS')IFONTV=1 IF(IJUST.EQ.'CJUS')IFONTV=1 IF(IJUST.EQ.'RJUS')IFONTV=1 IF(IJUST.EQ.'LEBO')IFONTV=1 IF(IJUST.EQ.'CEBO')IFONTV=1 IF(IJUST.EQ.'RIBO')IFONTV=1 IF(IJUST.EQ.'LECE')IFONTV=0 IF(IJUST.EQ.'CECE')IFONTV=0 IF(IJUST.EQ.'RICE')IFONTV=0 IF(IJUST.EQ.'LETO')IFONTV=2 IF(IJUST.EQ.'CETO')IFONTV=2 IF(IJUST.EQ.'RITO')IFONTV=2 C IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')GOTO12660 C CALL DPCOAN(ISYMBL(1:1),IJUNK) STRING(1)=IJUNK STRING(2)=0 C DO12650I=1,NP PX1=PX(I) PY1=PY(I) CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0) CALL GDTXTH(STRING,IX,IY,IFONTH,IFONTV,IXERR) 12650 CONTINUE GOTO12699 C 12660 CONTINUE NCOL=INT(PHEIGH) IF(NCOL.LT.1)NCOL=1 IF(IFONTH.EQ.0)THEN IXINC=0 ELSEIF(IFONTH.EQ.1)THEN IXINC=NCOL/2 ELSE IXINC=NCOL ENDIF IF(IFONTV.EQ.0)THEN IYINC=0 ELSEIF(IFONTV.EQ.1)THEN IYINC=NCOL/2 ELSE IYINC=NCOL ENDIF DO12670I=1,NP PX1=PX(I) PY1=PY(I) CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0) DO12675IROW=IX,IX+NCOL-1 DO12678ICOLZ=IY,IY-NCOL+1,-1 IXTEMP=IROW-IXINC IYTEMP=ICOLZ+IYINC CALL GDPOIN(IXTEMP,IYTEMP,JCOL) 12678 CONTINUE 12675 CONTINUE 12670 CONTINUE C 12699 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 130-- ** C ** TREAT THE MACINTOSH DRIVER ** C ** LIBRARY FROM ABSOFT COMPILER ** C ****************************************************** C 13000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 135-- ** C ** TREAT THE MAC OSX AQUATERM DRIVER ** C ****************************************************** C 13500 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 140-- ** C ** TREAT THE PC PRINTER DRIVER ** C ****************************************************** C 14000 CONTINUE GOTO9000 C C C ****************************************************** C ** STEP 150-- ** C ** TREAT THE LATEX (USING EEPIC) DRIVER ** C ****************************************************** C 15000 CONTINUE C IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')GOTO15660 C IF(IJUST.EQ.'LEFT')THEN ICJUNK='bl' ELSEIF(IJUST.EQ.'CENT')THEN ICJUNK='bc' ELSEIF(IJUST.EQ.'RIGH')THEN ICJUNK='br' ELSEIF(IJUST.EQ.'LJUS')THEN ICJUNK='bl' ELSEIF(IJUST.EQ.'CJUS')THEN ICJUNK='bc' ELSEIF(IJUST.EQ.'RJUS')THEN ICJUNK='br' ELSEIF(IJUST.EQ.'LEBO')THEN ICJUNK='bl' ELSEIF(IJUST.EQ.'CEBO')THEN ICJUNK='bc' ELSEIF(IJUST.EQ.'RIBO')THEN ICJUNK='br' ELSEIF(IJUST.EQ.'LECE')THEN ICJUNK='cl' ELSEIF(IJUST.EQ.'CECE')THEN ICJUNK='cc' ELSEIF(IJUST.EQ.'RICE')THEN ICJUNK='cr' ELSEIF(IJUST.EQ.'LETO')THEN ICJUNK='tl' ELSEIF(IJUST.EQ.'CETO')THEN ICJUNK='tc' ELSEIF(IJUST.EQ.'RITO')THEN ICJUNK='tr' ELSE ICJUNK='cc' ENDIF C DO15650I=1,NP C PX1=PX(I) PY1=PY(I) CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:5)='put(' NCSTR=5 NCHTOT=5 CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR+15)='){ makebox(0,0)[' ICSTR(NCSTR+2:NCSTR+2)=IBASLC NCSTR=NCSTR+15 ICSTR(NCSTR+1:NCSTR+2)=ICJUNK(1:2) NCSTR=NCSTR+2 C NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=']' C NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='{' NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=ISYMBL(1:1) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR+1)='}}' NCSTR=NCSTR+1 CALL GRWRST(ICSTR,NCSTR,ISUBN0) C 15650 CONTINUE GOTO15699 C C FOR LATEX DRIVER, "PIXEL" MODE NOT CURRENTLY SUPPORTED C 15660 CONTINUE GOTO15699 C 15699 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 160-- ** C ** TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER ** C ****************************************************** C 16000 CONTINUE C CALL DPCONA(34,IQUOTE) C IF(ISYMBL.EQ.'PIXE'.OR.ISYMBL.EQ.'pixe')GOTO16060 C JHEIG2=(ANUMVP/100.0)*PHEIG2 + 0.5 DO16010I=1,NP C PX1P=PX(I) PY1P=PY(I)-PYINC CALL GRTRSD(PX1P,PY1P,IX,IY,ISUBN0) C ICSTR(1:11)=' IGV - ENABLE VECTOR GRAPHICS MODE ** C ** Wtttttbbbbblllllrrrrr - SET PAGE MARGINS** C ** NOTE: ENFORCE MARGIN WITH THE "OFFSET" AND NUMBER* C ** OF PICTURE POINTS. WE ONLY WANT TO CLIP ** C ** AT THE MARGIN, NOT FORCE A PAGE ERASE. ** C ** Tttttt - SET Y ORGIN FROM TOP OF PAGE** C ** Jjjjjj - SET X ORGIN FROM LEFT ** C ** PWnn - SET PEN WIDTH (3 CLOSEST TO ** C ** 0.1 DATAPLOT UNITS) ** C ** Vp - SELECT LINE PATTERN ** C ** UXXXXX:YYYYY - MOVE ** C ** DXXXXX:YYYYY - DRAW ** C ** REFERENCE: QUIC PROGRAMMERS MANUAL - CHAPTER 14 ** C ** ON VECTOR GRAPHICS ** C ****************************************************** C 9100 CONTINUE IF(NP.LE.0)GOTO9190 CCCCC ADD FOLLOWING LINE OCTOBER 1996. IF(JPATT.EQ.-1)GOTO9000 I=1 C CALL DPCONA(94,ICARAT) ICSTR(1:1)=ICARAT ICSTR(2:4)='IGV' ICSTR(5:5)=ICARAT ICSTR(6:6)='W' C IF(IORNSW.EQ.'PORT')GOTO9110 CCCCC AXLEFT=IQUILM CCCCC AXRGHT=11.*QUIPPI-IQUIRM CCCCC AYTOP=IQUITM CCCCC AYBOT=8.5*QUIPPI-IQUIBM CCCCC AFACTH=11.*QUIPPI CCCCC AFACTV=8.5*QUIPPI IX2=11000 IY2=8500 GOTO9120 C 9110 CONTINUE C CCCCC AXLEFT=IQU2LM CCCCC AXRGHT=8.5*QUIPPI-IQU2RM CCCCC AYTOP=IQU2TM CCCCC AYBOT=11.*QUIPPI-IQU2BM CCCCC AFACTH=8.5*QUIPPI CCCCC AFACTV=11.*QUIPPI IX2=8500 IY2=11000 C 9120 CONTINUE C CCCCC IX=INT(1000.*AXLEFT/QUIPPI+0.5) CCCCC IX2=INT(1000.*AXRGHT/QUIPPI+0.5) CCCCC IY=INT(1000.*AYTOP/QUIPPI+0.5) CCCCC IY2=INT(1000.*AYBOT/QUIPPI+0.5) IX=0 IY=0 NCSTR=6 NCHTOT=-5 CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR) CALL GRTRIN(IY2,NCHTOT,ICSTR,NCSTR) CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR) CALL GRTRIN(IX2,NCHTOT,ICSTR,NCSTR) ICSTR(27:27)=ICARAT ICSTR(28:33)='T00000' ICSTR(34:34)=ICARAT ICSTR(35:40)='J00000' ICSTR(41:41)=ICARAT ICSTR(42:43)='PW' NCSTR=43 NCHTOT=-2 IJUNK=INT(PTHIC2+0.5) CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR) NCSTR=45 ICSTR(46:46)=ICARAT ICSTR(47:47)='V' NCSTR=47 NCHTOT=-1 CALL GRTRIN(JPATT,NCHTOT,ICSTR,NCSTR) ICSTR(49:49)=ICARAT ICSTR(50:50)='U' NCSTR=50 C NOTE: QUIC POSIOTIONS FROM TOP OF PAGE NOT THE BOTTOM, REVERSE Y PYTEMP=100.-PY(I) CALL QUICPT(PX(I),PYTEMP,IX,IY,ISUBN0) NCHTOT=-5 CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR) ICSTR(56:56)=':' NCSTR=56 CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR) CALL GRWRST(ICSTR,NCSTR,ISUBN0) IF(NP.LE.1)GOTO9190 C NCSTR=0 NCHTOT=-5 DO9130I=2,NP C IF(NCSTR.LT.110)GOTO9140 CALL GRWRST(ICSTR,NCSTR,ISUBN0) NCSTR=0 9140 CONTINUE C NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=ICARAT NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='D' PYTEMP=100.-PY(I) CALL QUICPT(PX(I),PYTEMP,IX,IY,ISUBN0) CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=':' CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR) 9130 CONTINUE C NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=ICARAT NCTMP1=NCSTR+1 NCSTR=NCSTR+3 ICSTR(NCTMP1:NCSTR)='IGE' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C 9190 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 96-- ** C ** TREAT THE X11 CASE ** C ****************************************************** C 9600 CONTINUE IF(IX11OF.EQ.'OFF')GOTO9000 IF(NP.EQ.1)GOTO9000 CCCCC ADD FOLLOWING LINE OCTOBER 1996. IF(JPATT.EQ.-1)GOTO9000 DO9610IDUMMY=1,NP I = IDUMMY CALL GRTRSD(PX(I),PY(I),IX,IY,ISUBN0) IPX(IDUMMY) = IX IPY(IDUMMY) = IY 9610 CONTINUE CALL XDRAW(IPX,IPY,NP) GOTO9000 C C ************************************************* C ** STEP 100-- ** C ** TREAT THE VGA VIA TURBO-C CASE ** C ** REFERENCE--TURBO C 1.5 ADDITIONS & ** C ** ENHANCEMENTS, PAGE 69. ** C ** REFERENCE--TURBO C 2.0 REFERENCE GUIDE, ** C ** PAGE 98. ** C ** REFERENCE--WEISKAMP, POWER GRAPHICS ** C ** USING TURBO C, PAGE 32-33. ** C ************************************************* C 10000 CONTINUE IF(ITCST.EQ.'CLOS')GOTO9000 IF(NP.EQ.1)GOTO9000 CCCCC ADD FOLLOWING LINE OCTOBER 1996. IF(JPATT.EQ.-1)GOTO9000 CCCCC THE FOLLOWING LOOP WAS ADDED SEPTEMBER 1995 DO10100I=1,NP PX1P=PX(I) PY1P=PY(I) CALL GRTRSA(PX1P,PY1P,AX,AY,ISUBN0) PXP(I)=AX PYP(I)=AY 10100 CONTINUE CALL TCDRPL(PXP,PYP,NP) GOTO9000 C C ****************************************************** C ** STEP 110-- ** C ** TREAT THE GKS DRIVER ** C ****************************************************** C 11000 CONTINUE IF(JPATT.EQ.-1)GOTO9000 CGKS CALL GPL(NP, PS, PY) GOTO9000 C C ****************************************************** C ** STEP 120-- ** C ** TREAT THE GD DRIVER ** C ** THIS LIBRARY PROVIDES SUPPORT FOR: ** C ** 1) JPEG ** C ** 2) PNG ** C ** 3) WINDOWS BMP (BLACK/WHITE ONLY) ** C ****************************************************** C 12000 CONTINUE IF(NP.LE.1)GOTO9000 IF(JPATT.EQ.-1)GOTO9000 C DO12010I=2,NP CALL GRTRSD(PX(I-1),PY(I-1),IX1,IY1,ISUBN0) CALL GRTRSD(PX(I),PY(I),IX2,IY2,ISUBN0) CALL GDDRAW(IX1,IY1,IX2,IY2,JCOL,JPATT) 12010 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 130-- ** C ** TREAT THE MACINTOSH DRIVER ** C ** LIBRARY FROM ABSOFT COMPILER ** C ****************************************************** C 13000 CONTINUE IF(NP.LE.1)GOTO9000 IF(JPATT.EQ.-1)GOTO9000 C CMACI CALL MovePen(PX(1),PY(1)) DO13010I=2,NP CMACI CALL MoveDraw(PX(I),PY(I)) 13010 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 135-- ** C ** TREAT THE MAC OSX AQUATERM DRIVER ** C ****************************************************** C 13500 CONTINUE IF(NP.LE.1)GOTO9000 IF(JPATT.EQ.-1)GOTO9000 C DO13510I=1,NP CALL GRTRSD(PX(I),PY(I),IX1,IY1,ISUBN0) PXP(I)=REAL(IX1) PYP(I)=REAL(IY1) 13510 CONTINUE CAQUA CALL aqtAddPolylineTo(PXP,PYP,NP) GOTO9000 C C ****************************************************** C ** STEP 140-- ** C ** TREAT THE PC PRINTER DRIVER ** C ****************************************************** C 14000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 150-- ** C ** TREAT THE LATEX (USING EEPIC) DRIVER ** C ****************************************************** C 15000 CONTINUE IF(NP.LE.1)GOTO9000 IF(JPATT.EQ.-1)THEN GOTO9000 ELSEIF(JPATT.EQ.1)THEN ICSTR(1:1)=IBASLC ICSTR(2:13)='drawline[ 0]' NCSTR=13 ELSEIF(JPATT.EQ.3)THEN ICSTR(1:1)=IBASLC ICSTR(2:15)='dottedline{12}' NCSTR=15 ELSEIF(JPATT.EQ.2)THEN ICSTR(1:1)=IBASLC ICSTR(2:13)='dashline{24}' NCSTR=13 ELSEIF(JPATT.EQ.4)THEN ICSTR(1:1)=IBASLC ICSTR(2:18)='dashline[-30]{12}' NCSTR=18 ELSEIF(JPATT.EQ.5)THEN ICSTR(1:1)=IBASLC ICSTR(2:18)='dashline[-30]{24}' NCSTR=18 ELSEIF(JPATT.EQ.6)THEN ICSTR(1:1)=IBASLC ICSTR(2:18)='dashline[+30]{12}' NCSTR=18 ELSEIF(JPATT.EQ.7)THEN ICSTR(1:1)=IBASLC ICSTR(2:18)='dashline[+30]{24}' NCSTR=18 ELSE ICSTR(1:1)=IBASLC ICSTR(2:13)='drawline[ 0]' NCSTR=13 ENDIF C IPTS=0 NCHTOT=5 DO15010I=1,NP IPTS=IPTS+1 CALL GRTRSD(PX(I),PY(I),IX1,IY1,ISUBN0) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='(' CALL GRTRIN(IX1,NCHTOT,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRIN(IY1,NCHTOT,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=')' IF(NCSTR.GT.80)THEN CALL GRWRST(ICSTR,NCSTR,ISUBN0) NCSTR=0 IF(JPATT.EQ.1)THEN ICSTR(1:1)=IBASLC ICSTR(2:13)='drawline[ 0]' NCSTR=13 ELSEIF(JPATT.EQ.3)THEN ICSTR(1:1)=IBASLC ICSTR(2:15)='dottedline{12}' NCSTR=15 ELSEIF(JPATT.EQ.2)THEN ICSTR(1:1)=IBASLC ICSTR(2:13)='dashline{24}' NCSTR=13 ELSEIF(JPATT.EQ.4)THEN ICSTR(1:1)=IBASLC ICSTR(2:18)='dashline[-30]{12}' NCSTR=18 ELSEIF(JPATT.EQ.5)THEN ICSTR(1:1)=IBASLC ICSTR(2:18)='dashline[-30]{24}' NCSTR=18 ELSEIF(JPATT.EQ.6)THEN ICSTR(1:1)=IBASLC ICSTR(2:18)='dashline[+30]{12}' NCSTR=18 ELSEIF(JPATT.EQ.7)THEN ICSTR(1:1)=IBASLC ICSTR(2:18)='dashline[+30]{24}' NCSTR=18 ELSE ICSTR(1:1)=IBASLC ICSTR(2:13)='drawline[ 0]' NCSTR=13 ENDIF IPTS=0 IPTS=IPTS+1 CALL GRTRSD(PX(I),PY(I),IX1,IY1,ISUBN0) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='(' CALL GRTRIN(IX1,NCHTOT,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRIN(IY1,NCHTOT,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=')' ENDIF 15010 CONTINUE IF(IPTS.GE.2)CALL GRWRST(ICSTR,NCSTR,ISUBN0) C GOTO9000 C C ****************************************************** C ** STEP 160-- ** C ** TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER ** C ****************************************************** C 16000 CONTINUE IF(NP.LE.0)GOTO16090 IF(JPATT.LE.0)GOTO16090 CALL DPCONA(34,IQUOTE) C ICSTR(1:12)=' SETGREY - SET GREY SCALE FOR SOLID FILL ** C ** FILL ** C ** REFERENCE--POSTSCRIPT LANGUAGE COOKBOOK AND ** C ** TUTORIAL FROM ADOBE SYSTEMS ** C ** PAGES XX AND XX ** C ** MODIFIED JANUARY, 1990 TO SUPPORT COLOR. IF ** C ** COLOR TURNED ON, COLOR FOR REGIONS SET IN ** C ** GRSECO, IF NOT THEN USE GREY SCALE FOR SOLID ** C ** FILL REGIONS. ** C ****************************************************** C 8600 CONTINUE CCCCC IF(IFLAG.EQ.'NONS')GOTO8620 CCCCC JUNE 1994. ADD FOLLOWING LINE IF(IPSTFS.EQ.'OFF'.AND.IFIG.NE.'BOX')GOTO8630 IF(IPATT.EQ.'EMPT')GOTO8690 IF(IPATT.EQ.'BLAN')GOTO8690 IF(IPATT.EQ.' ')GOTO8690 IF(IPATT.EQ.'NONE')GOTO8690 IF(IPATT.EQ.'SOLI')GOTO8610 IF(IPATT.EQ.'FILL')GOTO8610 GOTO8620 C 8610 CONTINUE IF(NP.LE.3)GOTO8619 C JANUARY, 1990. COLOR TABLES CHANGED WHEN ADDED SUPPORT FOR COLOR. CCCCC AINC=1./7. CCCCC AGREY=REAL(JCOLF)*AINC CCCCC IF(AGREY.LT.0.)AGREY=0. CCCCC IF(AGREY.GT.1.)AGREY=1. C C AUGUST 1992. COLOR AND GRAY SCALE NOW HANDLED IN A MORE DEVICE C INDEPENDENT MANNER IN GRTRCO, GRSECO. COMMENT OUT FOLLOWING C BLOCK OF CODE. ALSO, SINCE NOW A WAY TO SPECIFICALLY ASK FOR C GRAY SCALE, DO NOT MAP COLORS TO GRAY SCALE ON BLACK AND WHITE C DEVICES. C CCCCC IF(IGCOLO.EQ.'ON')GOTO8615 CCCCC AGREY=0. CCCCC IF(JCOLF.EQ.0)AGREY=0. CCCCC IF(JCOLF.EQ.1)AGREY=0.4 CCCCC IF(JCOLF.EQ.2)AGREY=0.5 CCCCC IF(JCOLF.EQ.3)AGREY=0.8 CCCCC IF(JCOLF.EQ.4)AGREY=0.3 CCCCC IF(JCOLF.EQ.5)AGREY=0.1 CCCCC IF(JCOLF.EQ.6)AGREY=0.6 CCCCC IF(JCOLF.EQ.7)AGREY=1.0 CCCCC IF(JCOLF.EQ.8)AGREY=0.7 CCCCC IF(JCOLF.EQ.9)AGREY=0.5 CCCCC IF(JCOLF.EQ.10)AGREY=0.3 CCCCC IF(JCOLF.EQ.11)AGREY=0.3 CCCCC IF(JCOLF.EQ.12)AGREY=0.1 CCCCC IF(JCOLF.EQ.13)AGREY=0.1 CCCCC IF(JCOLF.EQ.14)AGREY=0.2 CCCCC IF(JCOLF.EQ.15)AGREY=0.9 CCCCC NCSTR=0 CCCCC NCHTOT=10 CCCCC NCHDEC=5 CCCCC CALL GRTRRE(AGREY,NCHTOT,NCHDEC,ICSTR,NCSTR) CCCCC ICSTR(11:26)=' setgray newpath' CCCCC NCSTR=26 CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0) C8615 CONTINUE NCHTOT=5 NCSTR=0 CALL GRTRSD(PX(1),PY(1),IX,IY,ISUBN0) CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR) ICSTR(6:6)=' ' NCSTR=6 CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR) ICSTR(12:13)=' m' NCSTR=13 CALL GRWRST(ICSTR,NCSTR,ISUBN0) DO8611I=2,NP NCSTR=0 CALL GRTRSD(PX(I),PY(I),IX,IY,ISUBN0) CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR) ICSTR(6:6)=' ' NCSTR=6 CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR) ICSTR(12:13)=' l' NCSTR=13 CALL GRWRST(ICSTR,NCSTR,ISUBN0) 8611 CONTINUE C JANUARY, 1990. FOLLOWING 2 LINES CHANGED. DEPENDS ON WHETHER ASSUMING C COLOR OR BLACK AND WHITE. CCCCC ICSTR(1:25)='closepath fill 0. setgray' CCCCC NCSTR=25 IF(IGCOLO.EQ.'ON')THEN ICSTR(1:35)='closepath fill 0. 0. 0. setrgbcolor' NCSTR=35 ELSE ICSTR(1:25)='closepath fill 0. setgray' NCSTR=25 ENDIF CALL GRWRST(ICSTR,NCSTR,ISUBN0) 8619 CONTINUE GOTO8690 C 8620 CONTINUE IFACTO=-999 IF(IFIG.EQ.'BOX')CALL GRDRBP(PX,PY,NP,PXSPA2,PYSPA2,IFACTO, 1IHORPA,IVERPA,IDUPPA,IDDOPA, 1IPATT2,PTHICK,ICOL) CCCCC IF(IFIG.NE.'BOX')CALL GRFIR2(PX,PY,NP,PXSPA2,PYSPA2,IFACTO, CCCCC1IHORPA,IVERPA,IDUPPA,IDDOPA) IF(IFIG.NE.'BOX')THEN CALL GRFIR3(PX,PY,NP,PXSPA2,PYSPA2,IFACTO, 1 IHORPA,IVERPA,IDUPPA,IDDOPA,IPATT2,PTHICK,ICOL) ENDIF GOTO8690 C 8630 CONTINUE IF(IFLAG.EQ.'SOLI')THEN CALL GRFIR2(PX,PY,NP,PXSPA2,PYSPA2,IFACTO, 1 IHORPA,IVERPA,IDUPPA,IDDOPA,JCOLF) ELSE CALL GRFIR3(PX,PY,NP,PXSPA2,PYSPA2,IFACTO, 1 IHORPA,IVERPA,IDUPPA,IDDOPA,IPATT2,PTHICK,ICOL) ENDIF C 8690 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 89-- ** C ** TREAT THE DISPLAY POSTSCRIPT DRIVER ** C ****************************************************** C 8900 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 91-- ** C ** TREAT THE QUIC CASE ** C ** TO FILL REG-- ** C ** WRITE OUT AN ^LAFhhhhhvvvvv20^G ** C ** IF PICK POINT IN MIDDLE OF REGION, WILL HARDWARE** C ** FILL TO LINES FORMING REGION AROUND THAT POINT. ** C ** NOTE THAT FOR DATAPLOT, THE REGION BORDER MAY ** C ** BE BLANK, WHICH CAN CAUSE DISASTOROUS RESULTS, ** C ** ALSO DEPENDS ON BORDER BEING DRAW FIRST, WHICH ** C ** IS NOT GARUNTEED IN DATAPLOT ** C ** THERFORE DO A SOFTWARE REGION FILL ** C ** REFERENCE--QUIC PROGRAMMERS MANUAL, ** C ** CHAPTER 8 ** C ****************************************************** C 9100 CONTINUE IF(IPATT.EQ.'EMPT')GOTO9190 IF(IPATT.EQ.'BLAN')GOTO9190 IF(IPATT.EQ.' ')GOTO9190 IF(IPATT.EQ.'NONE')GOTO9190 IF(IPATT.EQ.'SOLI')GOTO9120 IF(IPATT.EQ.'FILL')GOTO9120 GOTO9120 C C9110 CONTINUE CCCCC IF(NP.LE.0)GOTO9119 CCCCC DO9111I=1,NP CCCCC CALL QUICPT(PX(I),PY(I),IX(I),IY(I),ISUBN0) CCCCC IY(I)=100.-IY(I) C9111 CONTINUE CCCCC ICSTR(1:1)=ICARAT CCCCC ICSTR(2:4)='LAF' CCCCC NCSTR=4 CCCCC NCHTOT=5 CCCCC CALL GRTRIN(IX(1),NCHTOT,ICSTR,NCSTR) CCCCC CALL GRTRIN(IY(1),NCHTOT,ICSTR,NCSTR) CCCCC ICSTR(15:16)='20' CCCCC NCSTR=NCSTR+1 CCCCC ICSTR(NCST:NCSTR)=ICARAT CCCCC NCSTR=NCSTR+1 CCCCC ICSTR(NCSTR:NCSTR)='G' CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0) C9119 CONTINUE CCCCC GOTO9190 C 9120 CONTINUE IFACTO=-999 IF(IFIG.EQ.'BOX')CALL GRDRBP(PX,PY,NP,PXSPA2,PYSPA2,IFACTO, 1IHORPA,IVERPA,IDUPPA,IDDOPA, 1IPATT2,PTHICK,ICOL) CCCCC IF(IFIG.NE.'BOX')CALL GRFIR2(PX,PY,NP,PXSPA2,PYSPA2,IFACTO, CCCCC1IHORPA,IVERPA,IDUPPA,IDDOPA) IF(IFIG.NE.'BOX')THEN IF(IFLAG.EQ.'SOLI')THEN CALL GRFIR2(PX,PY,NP,PXSPA2,PYSPA2,IFACTO, 1 IHORPA,IVERPA,IDUPPA,IDDOPA,JCOLF) ELSE CALL GRFIR3(PX,PY,NP,PXSPA2,PYSPA2,IFACTO, 1 IHORPA,IVERPA,IDUPPA,IDDOPA,IPATT2,PTHICK,ICOL) ENDIF ENDIF GOTO9190 C 9190 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 96-- ** C ** TREAT THE X11 CASE ** C ** SOLID FILLS DONE BY XLIB, PATTERNED FILLS WITH ** C ** SOFTWARE ** C ****************************************************** C 9600 CONTINUE CCCCC JUNE 1994. FOLLOWING LINE ADDED IF(IX11FS.EQ.'OFF'.AND.IFIG.NE.'BOX')GOTO9630 IF(IFLAG.EQ.'NONS')GOTO9620 IF(IPATT.EQ.'EMPT')GOTO9690 IF(IPATT.EQ.'BLAN')GOTO9690 IF(IPATT.EQ.' ')GOTO9690 IF(IPATT.EQ.'NONE')GOTO9690 IF(IPATT.EQ.'SOLI')GOTO9610 IF(IPATT.EQ.'FILL')GOTO9610 GOTO9620 C 9610 CONTINUE IF(NP.LE.3)GOTO9619 CALL GRTRSD(PX(1),PY(1),IX(1),IY(1),ISUBN0) IF(IFIG.EQ.'BOX')THEN CALL GRTRSD(PX(3),PY(3),IX(2),IY(2),ISUBN0) NTEMP=2 ELSE DO9611I=2,NP CALL GRTRSD(PX(I),PY(I),IX(I),IY(I),ISUBN0) 9611 CONTINUE NTEMP=NP END IF CALL XREGFL(IX,IY,NTEMP) 9619 CONTINUE GOTO9000 C 9620 CONTINUE IFACTO=-999 IF(IFIG.EQ.'BOX')CALL GRDRBP(PX,PY,NP,PXSPA2,PYSPA2,IFACTO, 1IHORPA,IVERPA,IDUPPA,IDDOPA, 1IPATT2,PTHICK,ICOL) CCCCC IF(IFIG.NE.'BOX')CALL GRFIR2(PX,PY,NP,PXSPA2,PYSPA2,IFACTO, CCCCC1IHORPA,IVERPA,IDUPPA,IDDOPA) IF(IFIG.NE.'BOX')THEN CALL GRFIR3(PX,PY,NP,PXSPA2,PYSPA2,IFACTO, 1 IHORPA,IVERPA,IDUPPA,IDDOPA,IPATT2,PTHICK,ICOL) ENDIF GOTO9000 C 9630 CONTINUE IF(IFLAG.EQ.'SOLI')THEN CALL GRFIR2(PX,PY,NP,PXSPA2,PYSPA2,IFACTO, 1 IHORPA,IVERPA,IDUPPA,IDDOPA,JCOLF) ELSE CALL GRFIR3(PX,PY,NP,PXSPA2,PYSPA2,IFACTO, 1 IHORPA,IVERPA,IDUPPA,IDDOPA,IPATT2,PTHICK,ICOL) ENDIF C 9690 CONTINUE C GOTO9000 C CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1991 (JJF) C ************************************************* C ** STEP 100-- ** C ** TREAT THE VGA VIA TURBO-C CASE ** C ** REFERENCE--TURBO C 1.5 ADDITIONS & ** C ** ENHANCEMENTS, PAGE 71. ** C ** REFERENCE--TURBO C 2.0 REFERENCE GUIDE, ** C ** PAGE 122. ** C ** REFERENCE--WEISKAMP, POWER GRAPHICS ** C ** USING TURBO C, PAGE 13-16, 39-50** C ************************************************* C 10000 CONTINUE IF(IFLAG.EQ.'NONS')GOTO10620 IF(IPATT.EQ.'EMPT')GOTO10690 IF(IPATT.EQ.'BLAN')GOTO10690 IF(IPATT.EQ.' ')GOTO10690 IF(IPATT.EQ.'NONE')GOTO10690 IF(IPATT.EQ.'SOLI')GOTO10610 IF(IPATT.EQ.'FILL')GOTO10610 GOTO10620 C 10610 CONTINUE IF(NP.LE.3)GOTO10619 CALL GRTRSD(PX(1),PY(1),IX(1),IY(1),ISUBN0) IF(IFIG.EQ.'BOX')THEN CALL GRTRSD(PX(3),PY(3),IX(2),IY(2),ISUBN0) NTEMP=2 ELSE DO10611I=2,NP CALL GRTRSD(PX(I),PY(I),IX(I),IY(I),ISUBN0) 10611 CONTINUE NTEMP=NP END IF CALL TCFIRE(IX,IY,NTEMP) 10619 CONTINUE GOTO9000 C 10620 CONTINUE IFACTO=-999 IF(IFIG.EQ.'BOX')CALL GRDRBP(PX,PY,NP,PXSPA2,PYSPA2,IFACTO, 1IHORPA,IVERPA,IDUPPA,IDDOPA, 1IPATT2,PTHICK,ICOL) CCCCC IF(IFIG.NE.'BOX')CALL GRFIR2(PX,PY,NP,PXSPA2,PYSPA2,IFACTO, CCCCC1IHORPA,IVERPA,IDUPPA,IDDOPA) IF(IFIG.NE.'BOX')THEN CALL GRFIR3(PX,PY,NP,PXSPA2,PYSPA2,IFACTO, 1 IHORPA,IVERPA,IDUPPA,IDDOPA,IPATT2,PTHICK,ICOL) ENDIF GOTO9000 C 10690 CONTINUE C GOTO9000 C C ****************************************************** C ** STEP 110-- ** C ** TREAT THE GKS DRIVER ** C ****************************************************** C 11000 CONTINUE IF(IFLAG.EQ.'NONS')GOTO11620 IF(IPATT.EQ.'EMPT')GOTO11690 IF(IPATT.EQ.'BLAN')GOTO11690 IF(IPATT.EQ.' ')GOTO11690 IF(IPATT.EQ.'NONE')GOTO11690 IF(IPATT.EQ.'SOLI')GOTO11610 IF(IPATT.EQ.'FILL')GOTO11610 GOTO11620 C 11610 CONTINUE IF(NP.LE.3)GOTO11619 CGKS CALL GFA(PX,PY,NTEMP) 11619 CONTINUE GOTO9000 C 11620 CONTINUE IFACTO=-999 IF(IFIG.EQ.'BOX')CALL GRDRBP(PX,PY,NP,PXSPA2,PYSPA2,IFACTO, 1IHORPA,IVERPA,IDUPPA,IDDOPA, 1IPATT2,PTHICK,ICOL) IF(IFIG.NE.'BOX')THEN CALL GRFIR3(PX,PY,NP,PXSPA2,PYSPA2,IFACTO, 1 IHORPA,IVERPA,IDUPPA,IDDOPA,IPATT2,PTHICK,ICOL) ENDIF GOTO9000 C 11690 CONTINUE C GOTO9000 C C ****************************************************** C ** STEP 120-- ** C ** TREAT THE GD DRIVER ** C ** THIS LIBRARY PROVIDES SUPPORT FOR: ** C ** 1) JPEG ** C ** 2) PNG ** C ** 3) WINDOWS BMP (BLACK/WHITE ONLY) ** C ****************************************************** C 12000 CONTINUE CCCCC GD SOLID FILL FOR NON-RECTANGULAR REGIONS BLOWS UP FOR CCCCC PIE CHARTS (MAYBE OTHERS). MAKE SWITCHABLE, BUT FOR NOW CCCCC SIMPLY DO NON-RECTANGULAR SOLID FILLS IN SOFTWARE. CCCCC IF(IGDFS.EQ.'OFF'.AND.IFIG.NE.'BOX')GOTO12030 IF(IFIG.NE.'BOX')GOTO12030 C IF(IFLAG.EQ.'NONS')GOTO12020 IF(IPATT.EQ.'EMPT')GOTO12090 IF(IPATT.EQ.'BLAN')GOTO12090 IF(IPATT.EQ.' ')GOTO12090 IF(IPATT.EQ.'NONE')GOTO12090 IF(IPATT.EQ.'SOLI')GOTO12010 IF(IPATT.EQ.'FILL')GOTO12010 GOTO12020 C 12010 CONTINUE IF(NP.LE.3)GOTO12019 CALL GRTRSD(PX(1),PY(1),IX(1),IY(1),ISUBN0) IF(IFIG.EQ.'BOX')THEN CALL GRTRSD(PX(3),PY(3),IX(2),IY(2),ISUBN0) NTEMP=2 ELSE DO12011I=2,MAX(100,NP) CALL GRTRSD(PX(I),PY(I),IX(I),IY(I),ISUBN0) 12011 CONTINUE NTEMP=NP END IF CALL GDRGFL(IX,IY,NTEMP,JCOLF) 12019 CONTINUE GOTO9000 C 12020 CONTINUE IFACTO=-999 IF(IFIG.EQ.'BOX')CALL GRDRBP(PX,PY,NP,PXSPA2,PYSPA2,IFACTO, 1IHORPA,IVERPA,IDUPPA,IDDOPA, 1IPATT2,PTHICK,ICOL) IF(IFIG.NE.'BOX')THEN CALL GRFIR3(PX,PY,NP,PXSPA2,PYSPA2,IFACTO, 1 IHORPA,IVERPA,IDUPPA,IDDOPA,IPATT2,PTHICK,ICOL) ENDIF GOTO9000 C 12030 CONTINUE IF(IFLAG.EQ.'SOLI')THEN CALL GRFIR2(PX,PY,NP,PXSPA2,PYSPA2,IFACTO, 1 IHORPA,IVERPA,IDUPPA,IDDOPA,JCOLF) ELSE CALL GRFIR3(PX,PY,NP,PXSPA2,PYSPA2,IFACTO, 1 IHORPA,IVERPA,IDUPPA,IDDOPA,IPATT2,PTHICK,ICOL) ENDIF C 12090 CONTINUE C GOTO9000 C C ****************************************************** C ** STEP 130-- ** C ** TREAT THE MACINTOSH DRIVER ** C ** LIBRARY FROM ABSOFT COMPILER ** C ****************************************************** C 13000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 135-- ** C ** TREAT THE MAC OSX AQUATERM DRIVER ** C ****************************************************** C 13500 CONTINUE C CCCCC IF(IAQUFS.EQ.'OFF'.AND.IFIG.NE.'BOX')GOTO13530 IF(IFIG.NE.'BOX')GOTO13530 C IF(IFLAG.EQ.'NONS')GOTO13520 IF(IPATT.EQ.'EMPT')GOTO13590 IF(IPATT.EQ.'BLAN')GOTO13590 IF(IPATT.EQ.' ')GOTO13590 IF(IPATT.EQ.'NONE')GOTO13590 CCCCC IF(IPATT.EQ.'SOLI')GOTO13510 CCCCC IF(IPATT.EQ.'FILL')GOTO13510 IF(IPATT.EQ.'SOLI')GOTO13510 IF(IPATT.EQ.'FILL')GOTO13510 GOTO13520 C 13510 CONTINUE IF(NP.LE.3)GOTO13519 CALL GRTRSD(PX(1),PY(1),IX(1),IY(1),ISUBN0) IF(IFIG.EQ.'BOX')THEN CALL GRTRSD(PX(3),PY(3),IX(2),IY(2),ISUBN0) NTEMP=2 ELSE DO13511I=2,MAX(100,NP) CALL GRTRSD(PX(I),PY(I),IX(I),IY(I),ISUBN0) 13511 CONTINUE NTEMP=NP END IF CCCCC CALL aqtAddFilledRect(AX1,AX2,AY1,AY2) 13519 CONTINUE GOTO9000 C 13520 CONTINUE IFACTO=-999 IF(IFIG.EQ.'BOX')CALL GRDRBP(PX,PY,NP,PXSPA2,PYSPA2,IFACTO, 1IHORPA,IVERPA,IDUPPA,IDDOPA, 1IPATT2,PTHICK,ICOL) IF(IFIG.NE.'BOX')THEN CALL GRFIR3(PX,PY,NP,PXSPA2,PYSPA2,IFACTO, 1 IHORPA,IVERPA,IDUPPA,IDDOPA,IPATT2,PTHICK,ICOL) ENDIF GOTO9000 C 13530 CONTINUE IF(IFLAG.EQ.'SOLI')THEN CALL GRFIR2(PX,PY,NP,PXSPA2,PYSPA2,IFACTO, 1 IHORPA,IVERPA,IDUPPA,IDDOPA,JCOLF) ELSE CALL GRFIR3(PX,PY,NP,PXSPA2,PYSPA2,IFACTO, 1 IHORPA,IVERPA,IDUPPA,IDDOPA,IPATT2,PTHICK,ICOL) ENDIF C 13590 CONTINUE C GOTO9000 C C ****************************************************** C ** STEP 140-- ** C ** TREAT THE PC PRINTER DRIVER ** C ****************************************************** C 14000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 150-- ** C ** TREAT THE LATEX (USING EEPIC) DRIVER ** C ****************************************************** C 15000 CONTINUE C IF(IPATT.EQ.'EMPT')GOTO15090 IF(IPATT.EQ.'BLAN')GOTO15090 IF(IPATT.EQ.'NONE')GOTO15090 IF(IPATT.EQ.' ')GOTO15090 C IF(IFIG.NE.'BOX')THEN IF(IFLAG.EQ.'SOLI')THEN CALL GRFIR2(PX,PY,NP,PXSPA2,PYSPA2,IFACTO, 1 IHORPA,IVERPA,IDUPPA,IDDOPA,JCOLF) ELSE CALL GRFIR3(PX,PY,NP,PXSPA2,PYSPA2,IFACTO, 1 IHORPA,IVERPA,IDUPPA,IDDOPA,IPATT2,PTHICK,ICOL) ENDIF ELSE C C NOTE: THE METHOD FOR A SOLID FILLED BOX CODED BELOW DOESN'T QUITE C WORK. THE colorbox BY ITSELF DOES NOT ALLOW EXPLICIT C SPECIFICATION OF WIDTH AND HEIGHT. COMBINING IT WITH A C MAKEBOX RESULTS IN A FILL THAT EXTENDS PAST THE BORDERS OF C THE BOX. SO COMMENT OUT FOR NOW AND PERFORM ALL FILLS IN C SOFTWARE. C IF(IPATT.EQ.'SOLI' .OR. IPATT.EQ.'FILL')THEN CCCCC IF(ILATFS.EQ.'ON')THEN CCCCC IF(NP.LT.3)GOTO15090 CCCCC CALL GRTRSD(PX(1),PY(1),IX1,IY1,ISUBN0) CCCCC CALL GRTRSD(PX(3),PY(3),IX2,IY2,ISUBN0) CCCCC IWID=IX2-IX1 CCCCC IHT=IY2-IY1 CCCCC ICSTR(1:1)=IBASLC CCCCC ICSTR(2:5)='put(' CCCCC NCSTR=5 CCCCC NCHTOT=5 CCCCC CALL GRTRIN(IX1,NCHTOT,ICSTR,NCSTR) CCCCC NCSTR=NCSTR+1 CCCCC ICSTR(NCSTR:NCSTR)=',' CCCCC CALL GRTRIN(IY1,NCHTOT,ICSTR,NCSTR) CCCCC NCSTR=NCSTR+1 CCCCC ICSTR(NCSTR:NCSTR+2)='){' CCCCC NCSTR=NCSTR+3 CCCCC ICSTR(NCSTR:NCSTR)=IBASLC CCCCC NCSTR=NCSTR+1 CCCCC ICSTR(NCSTR:NCSTR+7)='colorbox' CCCCC NCSTR=NCSTR+8 CCCCC ICSTR(NCSTR:NCSTR+6)='{ }{' CCCCC ICSTR(NCSTR+1:NCSTR+4)=ICOLF(1:4) CCCCC NCSTR=NCSTR+7 CCCCC ICSTR(NCSTR:NCSTR)=IBASLC CCCCC NCSTR=NCSTR+1 CCCCC ICSTR(NCSTR:NCSTR+7)='makebox(' CCCCC NCSTR=NCSTR+7 CCCCC CALL GRTRIN(IWID,NCHTOT,ICSTR,NCSTR) CCCCC NCSTR=NCSTR+1 CCCCC ICSTR(NCSTR:NCSTR)=',' CCCCC CALL GRTRIN(IHT,NCHTOT,ICSTR,NCSTR) CCCCC NCSTR=NCSTR+1 CCCCC ICSTR(NCSTR:NCSTR+5)='){ }}}' CCCCC NCSTR=NCSTR+5 CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0) CCCCC ELSE IFACTO=-999 CALL GRDRBP(PX,PY,NP,PXSPA2,PYSPA2,IFACTO, 1 IHORPA,IVERPA,IDUPPA,IDDOPA, 1 IPATT2,PTHICK,ICOL) CCCCC ENDIF ELSE IFACTO=-999 CALL GRDRBP(PX,PY,NP,PXSPA2,PYSPA2,IFACTO, 1 IHORPA,IVERPA,IDUPPA,IDDOPA, 1 IPATT2,PTHICK,ICOL) ENDIF ENDIF C 15090 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 160-- ** C ** TREAT THE SVG (SCALABE VECTOR GRAPHICS) DRIVER ** C ****************************************************** C 16000 CONTINUE C CALL DPCONA(34,IQUOTE) C IF(ISVGFS.EQ.'OFF'.AND.IFIG.NE.'BOX')GOTO16030 IF(IFLAG.EQ.'NONS')GOTO16020 IF(IPATT.EQ.'EMPT')GOTO16090 IF(IPATT.EQ.'BLAN')GOTO16090 IF(IPATT.EQ.' ')GOTO16090 IF(IPATT.EQ.'NONE')GOTO16090 IF(IPATT.EQ.'SOLI')GOTO16010 IF(IPATT.EQ.'FILL')GOTO16010 GOTO16020 C 16010 CONTINUE IF(NP.LE.3)GOTO16019 CALL GRTRSD(PX(1),PY(1),IX(1),IY(1),ISUBN0) IF(IFIG.EQ.'BOX')THEN CALL GRTRSD(PX(3),PY(3),IX(2),IY(2),ISUBN0) IF(IX(1).LE.IX(2))THEN IXSTRT=IX(1) IXSTOP=IX(2) ELSE IXSTRT=IX(2) IXSTOP=IX(1) ENDIF IF(IY(1).LE.IY(2))THEN IYSTRT=IY(1) IYSTOP=IY(2) ELSE IYSTRT=IY(2) IYSTOP=IY(1) ENDIF IWID=IXSTOP-IXSTRT+1 IHEIG=IYSTOP-IYSTRT+1 C ICSTR(1:11)=' COMMAND. ** C *************************************************************** C C MAY,1989, ALAN HECKERT. BE SURE TO DEFINE THE DEFAULT PAGE SCALING, C TRANSLATION AND ORIENTATION (WAS A BUG WITH DIAGRAMMATIC GRAPHICS C IF AN ERASE WAS NOT DONE FIRST). C FOLLOWING CODE MODIFIED OCTOBER 1991. MAKE FONT TABLE DRIVEN APOINT=ANUMVP*2.0/100. IPOINT=INT(APOINT) C IJUNK=7 DO8695I=1,IPSTMF IF(IPSTFN.NE.IPSTT1(I))GOTO8695 IJUNK=I GOTO8697 8695 CONTINUE 8697 CONTINUE ICSTR(1:1)='/' ICSTR(2:41)=IPSTT2(IJUNK)(1:40) ICSTR(42:51)=' findfont ' NCHTOT=3 NCSTR=51 CALL GRTRIN(IPOINT,NCHTOT,ICSTR,NCSTR) NCSTR=NCSTR+1 NCSTR2=NCSTR+17 ICSTR(NCSTR:NCSTR2)=' scalefont setfont' NCSTR=NCSTR2 CALL GRWRST(ICSTR,NCSTR,ISUBN0) CCCCC ICSTR(1:33)='/Times-Roman findfont ' CCCCC IF(IPSTFN.EQ.'TBOL') CCCCC1ICSTR(1:23)='/Times-Bold ' CCCCC IF(IPSTFN.EQ.'TITA') CCCCC1ICSTR(1:23)='/Times-Italic ' CCCCC IF(IPSTFN.EQ.'TBIT') CCCCC1ICSTR(1:23)='/Times-BoldItalic ' CCCCC IF(IPSTFN.EQ.'HELV') CCCCC1ICSTR(1:23)='/Helvetica ' CCCCC IF(IPSTFN.EQ.'HELB') CCCCC1ICSTR(1:23)='/Helvetica-Bold ' CCCCC IF(IPSTFN.EQ.'HELO') CCCCC1ICSTR(1:23)='/Helvetica-Oblique ' CCCCC IF(IPSTFN.EQ.'HEBO') CCCCC1ICSTR(1:23)='/Helvetica-BoldOblique ' CCCCC IF(IPSTFN.EQ.'COUR') CCCCC1ICSTR(1:23)='/Courier ' CCCCC IF(IPSTFN.EQ.'CBOL') CCCCC1ICSTR(1:23)='/Courier-Bold ' CCCCC IF(IPSTFN.EQ.'COBL') CCCCC1ICSTR(1:23)='/Courier-Oblique ' CCCCC IF(IPSTFN.EQ.'CBOB') CCCCC1ICSTR(1:23)='/Courier-BoldOblique ' CCCCC NCSTR=33 CCCCC NCSTR=33 CCCCC NCHTOT=3 CCCCC CALL GRTRIN(IPOINT,NCHTOT,ICSTR,NCSTR) CCCCC ICSTR(37:54)=' scalefont setfont' CCCCC NCSTR=54 CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0) C C END CHANGE IPSTFC=IPSTFN IPSTPS=IPOINT IPSTPC=IPOINT IPSTPO=IPOINT C JUNE, 1989. A NEW PAGE RESETS THE FONT TO WHAT IS SET IN GRINDE. C ADDED IPSTFO TO DPCODV AND MODIFIED GRERSC. IPSTFO=IPSTFN C ICSTR(1:41)='gsave % SAVE INITIAL GRAPHICS STATE' NCSTR=41 CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ADD FOLLOWING LINES JANUARY, 1990. C JANUARY 1993. LEADING SPACE FOR "%%" LINES ICSTR(1:11)='%%EndProlog' NCSTR=11 IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR CALL GRWRST(ICSTR,NCSTR,ISUBN0) CCCCC JANUARY 1993. ONLY INCREMENT FOR DEVICE 2! IF(IMODE3.NE.'DEV3')THEN IPSTPN=1 ENDIF ICSTR(1:11)='%%Page: 1 1' NCSTR=11 IF(IPSTSP.EQ.'OFF')NCSTR=-NCSTR CALL GRWRST(ICSTR,NCSTR,ISUBN0) C END ADDITIONS ICSTR(1:11)='0 0 moveto ' NCSTR=11 XPPI=PSTPPI YPPI=PSTPPI XSCALE=72./XPPI YSCALE=72./YPPI NCSTR=11 NCHTOT=10 NCHDEC=5 CALL GRTRRE(XSCALE,NCHTOT,NCHDEC,ICSTR,NCSTR) ICSTR(22:22)=' ' NCSTR=22 CALL GRTRRE(YSCALE,NCHTOT,NCHDEC,ICSTR,NCSTR) ICSTR(33:39)=' scale ' NCSTR=39 C IF(IORNSW.EQ.'LAND')THEN IVTEMP=IPSTBM IHTEMP=IPSTLM ELSEIF(IORNSW.EQ.'LAN2')THEN IVTEMP=IPS2BM IHTEMP=IPS2LM ELSEIF(IORNSW.EQ.'PORT')THEN IVTEMP=IPS2BM IHTEMP=IPS2LM ELSEIF(IORNSW.EQ.'SQUA')THEN IVTEMP=IPS2BM IHTEMP=IPS2LM ELSE IVTEMP=IPSTBM IHTEMP=IPSTLM END IF IXTR=IHTEMP IYTR=IVTEMP IF(IORNSW.NE.'PORT' .AND. IORNSW.NE.'LAN2' .AND. IORNSW.NE.'SQUA') 1IXTR=IHTEMP+ANUMVP+0.5 NCHTOT=5 CALL GRTRIN(IXTR,NCHTOT,ICSTR,NCSTR) ICSTR(45:45)=' ' NCSTR=45 CALL GRTRIN(IYTR,NCHTOT,ICSTR,NCSTR) ICSTR(51:61)=' translate ' C ICSTR(62:63)=' 0' IF(IORNSW.NE.'PORT' .AND. IORNSW.NE.'LAN2' .AND. IORNSW.NE.'SQUA') 1ICSTR(62:63)='90' ICSTR(64:71)=' rotate ' NCSTR=71 CALL GRWRST(ICSTR,NCSTR,ISUBN0) C IF(IMODE3.NE.'DEV3')IPSTNW='ON' GOTO9000 C C ****************************************************** C ** STEP 89-- ** C ** TREAT THE DISPLAY POSTSCRIPT DRIVER ** C ****************************************************** C 8900 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 90-- ** C ** TREAT THE QUIC CASE ** C ** 1) TURN QUIC ON - "^PY^-" ON LINE BY ITSELF ** C ** 2) SET DEFAULT COMMAND SYNTAX - "^ISYNTAX00000" ** C ** 3) SET DEFAULT FONT - "^ISxxxxx ** C ** REFERENCE--QUIC PROGRAMMING MANUAL ** C ****************************************************** C 9100 CONTINUE CALL DPCONA(94,ICARAT) ICSTR(1:1)=ICARAT ICSTR(2:3)='PY' ICSTR(4:4)=ICARAT ICSTR(5:5)='-' NCSTR=-5 CALL GRWRST(ICSTR,NCSTR,ISUBN0) ICSTR(1:1)=ICARAT ICSTR(2:13)='ISYNTAX00000' NCSTR=13 KFONT=IQUIFN ICSTR(14:14)=ICARAT ICSTR(15:16)='IS' NCHTOT=-5 NCSTR=16 CALL GRTRIN(KFONT,NCHTOT,ICSTR,NCSTR) CALL GRWRST(ICSTR,NCSTR,ISUBN0) IQUIFC=IQUIFN GOTO9000 C C ****************************************************** C ** STEP 95-- ** C ** TREAT THE X11 CASE ** C ** USE A C LIBRARY WRITTEN BY ALAN HECKERT ** C ****************************************************** C 9600 CONTINUE IF(IORNSW.EQ.'LAND')THEN IORIEN=0 ELSE IF(IORNSW.EQ.'PORT')THEN IORIEN=1 ELSE IF(IORNSW.EQ.'SQUA')THEN IORIEN=3 ELSE IORIEN=2 END IF C DO9610I=20,1,-1 ILAST=I IF(IX11DN(I:I).NE.' ')GOTO9619 9610 CONTINUE 9619 CONTINUE DO9620I=1,ILAST CALL DPCOAN(IX11DN(I:I),IJUNK) IADE(I)=IJUNK 9620 CONTINUE IADE(ILAST+1)=0 C DO9629I=1,8 IWIND(I)=-1 9629 CONTINUE ICOUNT=0 IF(IMODEL.EQ.' '.AND.IMODE2.EQ.' ')GOTO9639 CTEMP(1:4)=IMODEL(1:4) CTEMP(5:8)=IMODE2(1:4) ICOUNT=0 DO9630I=8,1,-1 IA=CTEMP(I:I) IF(IA.EQ.' ')GOTO9630 ICOUNT=ICOUNT+1 CALL DPCOAN(IA,IVALUE) IF(IVALUE.GE.48.AND.IVALUE.LE.57)THEN IWIND(ICOUNT)=IVALUE-48 ELSEIF(IVALUE.GE.65.AND.IVALUE.LE.70)THEN IWIND(ICOUNT)=IVALUE-55 ELSEIF(IVALUE.GE.97.AND.IVALUE.LE.102)THEN IWIND(ICOUNT)=IVALUE-87 ELSE ICOUNT=1 WRITE(ICOUT,9633) GOTO9639 ENDIF 9630 CONTINUE 9633 FORMAT('***** WARNING--INVALID WINDOW ID FROM FRONT-END. ', 1'A SEPARATE GRAPHICS WINDOW WILL BE OPENED.') 9639 CONTINUE CALL XINIT(IXTEMP,IYTEMP,IORIEN,IXPIX,IYPIX,IADE,IWIND,ICOUNT, 1IERRNO) IF(IERRNO.EQ.1) THEN WRITE(ICOUT,9651) 9651 FORMAT('CANNOT OPEN X11 WINDOW.') CALL DPWRST('XXX','BUG ') IX11OF='OFF' ELSE IX11OF='ON' ANUMHP=REAL(IXPIX) ANUMVP=REAL(IYPIX) ENDIF GOTO9000 C CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1991 (JJF) C ************************************************* C ** STEP 100-- ** C ** TREAT THE VGA VIA TURBO-C CASE ** C ** USE A C DRIVER WRITTEN BY JJF ** C ************************************************* C 10000 CONTINUE CALL TCINDE GOTO9000 C C ****************************************************** C ** STEP 110-- ** C ** TREAT THE GKS DRIVER ** C ****************************************************** C 11000 CONTINUE CGKS CALL GOPKS(IGKSNU, IWRKSP) CCKS CALL GOPWK(IGKSID, IGKSCN, IGKSWK) GOTO9000 C C ****************************************************** C ** STEP 120-- ** C ** TREAT THE GD DRIVER ** C ** THIS LIBRARY PROVIDES SUPPORT FOR: ** C ** 1) JPEG ** C ** 2) PNG ** C ** 3) WINDOWS BMP (BLACK/WHITE ONLY) ** C ** TREAT THE PBM (PORTABLE BIT MAP) DRIVER ** C ****************************************************** C 12000 CONTINUE C 12010 CONTINUE ITYPE=1 GOTO12090 C 12020 CONTINUE ITYPE=2 GOTO12090 C 12030 CONTINUE ITYPE=3 GOTO12090 C 12040 CONTINUE ITYPE=4 GOTO12090 C 12090 CONTINUE C CALL GDINIT(ITYPE) GOTO9000 C C ****************************************************** C ** STEP 130-- ** C ** TREAT THE MACINTOSH DRIVER ** C ** LIBRARY FROM ABSOFT COMPILER ** C ****************************************************** C 13000 CONTINUE XPIXMN=100.0 XPIXMX=700.0 YPIXMN=100.0 YPIXMX=550.0 CMACI CALL MIGSetup(XPIXMN,XPIXMX,YPIXMN,YPIXMX,ACOORD) AXMN=0.0 AXMX=100.0 AYMN=0.0 AYMX=100.0 IDISP=0 CMACI CALL DefineCoord(AXMN,AYMN,AXMX,AYMX,IDISP,BCOORD) GOTO9000 C C ****************************************************** C ** STEP 135-- ** C ** TREAT THE MAC OSX AQUATERM DRIVER ** C ****************************************************** C C STEP 1: INITIALIZE DEVICE C STEP 2: DEFINE COLOR MAP C 13500 CONTINUE CAQUA CALL aqtInit() C DO13510I=1,MAXCLR IVAL1=IRED(I) VAL1=REAL(IVAL1)/255.0 IVAL2=IGREEN(I) VAL2=REAL(IVAL2)/255.0 IVAL3=IBLUE(I) VAL3=REAL(IVAL3)/255.0 IENTRY=I-1 CAQUA CALL aqtSetColormapEntry(IENTRY,VAL1,VAL2,VAL3) 13510 CONTINUE C GOTO9000 C C ****************************************************** C ** STEP 140-- ** C ** TREAT THE PC PRINTER DRIVER ** C ****************************************************** C 14000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 150-- ** C ** TREAT THE LATEX (USING EEPIC) DRIVER ** C ** TWO CASES: ** C ** 1) DEVICE xxx LATEX INDEPENDENT ** C ** TREAT THE LATEX GRAPH AS AN INDEPENDENT. ** C ** PREAMBLE. ** C ** 2) DEVICE xxx LATEX ** C ** TREAT THE LATEX GRAPH AS SOMETHING TO BE ** C ** INCORPORATED INTO LARGER LATEX DOCUMENT. ** C ** IN THIS CASE, DO NOTHING. ** C ****************************************************** C 15000 CONTINUE C IF(IMODEL.EQ.'STAN')THEN C ICSTR=' ' IF(ILATHE.EQ.'NULL')THEN C ICSTR(1:1)=IBASLC ICSTR(2:29)='documentclass[12pt]{article}' NCSTR=29 CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=' ' NCSTR=1 CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:99)='usepackage{epsfig}' NCSTR=19 CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:23)='usepackage{epic,eepic}' NCSTR=23 CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:27)='usepackage{graphics,color}' NCSTR=27 CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=' ' NCSTR=1 CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:30)='setlength{ textwidth}{6.25in}' ICSTR(12:12)=IBASLC NCSTR=30 CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:28)='setlength{ textheight}{9in}' ICSTR(12:12)=IBASLC NCSTR=28 CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:34)='setlength{ oddsidemargin}{0.25in}' ICSTR(12:12)=IBASLC NCSTR=34 CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:32)='setlength{ evensidemargin}{0in}' ICSTR(12:12)=IBASLC NCSTR=32 CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:30)='setlength{ headheight}{0.5in}' ICSTR(12:12)=IBASLC NCSTR=30 CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:28)='setlength{ headsep}{0.5in}' ICSTR(12:12)=IBASLC NCSTR=28 CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:28)='setlength{ topmargin}{-1in}' ICSTR(12:12)=IBASLC NCSTR=28 CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:27)='setlength{ parindent}{0in}' ICSTR(12:12)=IBASLC NCSTR=27 CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:26)='setlength{ parskip}{10pt}' ICSTR(12:12)=IBASLC NCSTR=26 CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:30)='setlength{ textfloatsep}{4ex}' ICSTR(12:12)=IBASLC NCSTR=30 CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:31)='addtolength{ footskip}{0.25in}' ICSTR(14:14)=IBASLC NCSTR=31 CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:17)='overfullrule=0pt' NCSTR=17 CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:18)='baselineskip=12pt' NCSTR=18 CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=' ' NCSTR=1 CALL GRWRST(ICSTR,NCSTR,ISUBN0) C CCCCC PGRAPHIC AND LGRAPHIC FOR IMPORTING EXTERNAL CCCCC POSTSCRIPT FILES. NOT RELEVANT IN THIS CONTEXT, CCCCC SO COMMENT OUT FOR NOW. C CCCCC ICSTR(1:1)=IBASLC CCCCC ICSTR(2:12)='newcommand{' CCCCC ICSTR(13:13)=IBASLC CCCCC ICSTR(14:26)='PGRAPHIC}[1]{' CCCCC ICSTR(27:27)=IBASLC CCCCC ICSTR(28:43)='begin{figure}[h]' CCCCC NCSTR=43 CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0) C CCCCC ICSTR(1:1)=IBASLC CCCCC ICSTR(2:28)='epsfig{file=#1,width=6.0in}' CCCCC NCSTR=28 CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0) C CCCCC ICSTR(1:1)=IBASLC CCCCC ICSTR(2:13)='end{figure}}' CCCCC NCSTR=13 CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0) C CCCCC ICSTR(1:1)=IBASLC CCCCC ICSTR(2:12)='newcommand{' CCCCC ICSTR(13:13)=IBASLC CCCCC ICSTR(14:26)='LGRAPHIC}[1]{' CCCCC ICSTR(27:27)=IBASLC CCCCC ICSTR(28:43)='begin{figure}[h]' CCCCC NCSTR=43 CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0) C CCCCC ICSTR(1:1)=IBASLC CCCCC ICSTR(2:38)='epsfig{file=#1,angle=-90,width=6.0in}' CCCCC NCSTR=38 CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0) C CCCCC ICSTR(1:1)=IBASLC CCCCC ICSTR(2:13)='end{figure}}' CCCCC NCSTR=13 CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0) C CCCCC ICSTR(1:1)=' ' CCCCC NCSTR=1 CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0) C CCCCC ICSTR(1:1)=IBASLC CCCCC ICSTR(2:16)='begin{verbatim}' CCCCC NCSTR=16 CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0) C CCCCC ICSTR(1:1)=' ' CCCCC NCSTR=1 CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ELSE IOUNI1=IST1NU IFILE1=ILATHE ISTAT1='OLD' IFORM1='FORMATTED' IACCE1='SEQUENTIAL' IPROT1='READONLY' ICURS1='CLOSED' ISUBN0='CAPT' IERRF1='NO' C IREWI1='ON' CALL DPOPFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1, 1 IPROT1,ICURS1, 1 IREWI1,ISUBN0,IERRF1,IBUGS2,ISUBRO,IERROR) IF(IERRF1.EQ.'YES')GOTO9000 C C NOW LOOP THROUGH FILE (ASSUME MAXIMUM OF 1,000 LINES). C DO15301I=1,1000 IATEMP=' ' READ(IOUNI2,15392,END=15399,ERR=15399)IATEMP 15392 FORMAT(A240) ILAST=1 DO15410J=240,1,-1 IF(IATEMP(J:J).NE.' ')THEN ILAST=J GOTO15419 ENDIF 15410 CONTINUE 15419 CONTINUE ICSTR(1:ILAST)=IATEMP(1:ILAST) NCSTR=ILAST CALL GRWRST(ICSTR,NCSTR,ISUBN0) 15301 CONTINUE 15399 CONTINUE IENDF1='OFF' IREWI1='ON' CALL DPCLFI(IOUNI1,IFILE1,ISTAT1,IFORM1,IACCE1, 1 IPROT1,ICURS1,IENDF1,IREWI1, 1 ISUBN0,IERRF1,IBUGS2,ISUBRO,IERROR) IF(IERRF1.EQ.'YES')GOTO9000 ENDIF C ICSTR(1:1)=IBASLC ICSTR(2:16)='begin{document}' NCSTR=16 CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=' ' NCSTR=1 CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ELSE ICSTR(1:1)=IBASLC ICSTR(2:14)='end{verbatim}' NCSTR=14 CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ENDIF C C DEFINE GRAY SCALE COLORS C IF(ILATCO.EQ.'ON')THEN NCHTOT=5 NCHDEC=3 DO15110I=0,9 ICSTR(1:1)=IBASLC ICSTR(2:25)='definecolor{G }{gray}{' NCSTR=25 WRITE(ICSTR(15:15),'(I1)')I ACOL=REAL(I)/100.0 CALL GRTRRE(ACOL,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) 15110 CONTINUE DO15120I=10,99 ICSTR(1:1)=IBASLC ICSTR(2:25)='definecolor{G }{gray}{' NCSTR=25 WRITE(ICSTR(15:16),'(I2)')I ACOL=REAL(I)/100.0 CALL GRTRRE(ACOL,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) 15120 CONTINUE ICSTR(1:1)=IBASLC ICSTR(2:29)='definecolor{G100}{gray}{1.0}' NCSTR=29 CALL GRWRST(ICSTR,NCSTR,ISUBN0) C C IF COLOR SWITCH ON, DEFINE COLORS BASED ON RGB VALUES C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='WHIT' ARED=1.0 AGREEN=1.0 ABLUE=1.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='BLAC' ARED=0.0 AGREEN=0.0 ABLUE=0.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='RED ' ARED=1.0 AGREEN=0.0 ABLUE=0.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='BLUE' ARED=0.0 AGREEN=0.0 ABLUE=1.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='GREE' ARED=0.0 AGREEN=1.0 ABLUE=0.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='MAGE' ARED=1.0 AGREEN=0.0 ABLUE=1.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='ORAN' ARED=1.0 AGREEN=165.0/255.0 ABLUE=0.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='CYAN' ARED=0.0 AGREEN=1.0 ABLUE=1.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='YELL' ARED=1.0 AGREEN=1.0 ABLUE=0.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='YGRE' ARED=154.0/255.0 AGREEN=205.0/255.0 ABLUE=50.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='DGRE' ARED=0.0/255.0 AGREEN=100.0/255.0 ABLUE=0.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='LBLU' ARED=173.0/255.0 AGREEN=216.0/255.0 ABLUE=230.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='VBLU' ARED=138.0/255.0 AGREEN=43.0/255.0 ABLUE=226.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='VRED' ARED=208.0/255.0 AGREEN=32.0/255.0 ABLUE=144.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='DGRE' ARED=47.0/255.0 AGREEN=79.0/255.0 ABLUE=79.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='LGRE' ARED=211.0/255.0 AGREEN=211.0/255.0 ABLUE=211.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='AQUA' ARED=127.0/255.0 AGREEN=255.0/255.0 ABLUE=212.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='BROW' ARED=165.0/255.0 AGREEN=42.0/255.0 ABLUE=42.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='CABL' ARED=95.0/255.0 AGREEN=158.0/255.0 ABLUE=160.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='CORA' ARED=255.0/255.0 AGREEN=127.0/255.0 ABLUE=80.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='CBLU' ARED=100.0/255.0 AGREEN=149.0/255.0 ABLUE=237.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='DOGR' ARED=85.0/255.0 AGREEN=107.0/255.0 ABLUE=47.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='DORC' ARED=153.0/255.0 AGREEN=50.0/255.0 ABLUE=204.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='DSBL' ARED=72.0/255.0 AGREEN=61.0/255.0 ABLUE=139.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='DTUR' ARED=0.0/255.0 AGREEN=206.0/255.0 ABLUE=209.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='FIRE' ARED=178.0/255.0 AGREEN=34.0/255.0 ABLUE=34.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='FGRE' ARED=34.0/255.0 AGREEN=139.0/255.0 ABLUE=34.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='GOLD' ARED=255.0/255.0 AGREEN=215.0/255.0 ABLUE=0.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='GLDR' ARED=218.0/255.0 AGREEN=165.0/255.0 ABLUE=32.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='GRAY' ARED=192.0/255.0 AGREEN=192.0/255.0 ABLUE=192.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='IRED' ARED=205.0/255.0 AGREEN=92.0/255.0 ABLUE=92.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='KHAK' ARED=240.0/255.0 AGREEN=230.0/255.0 ABLUE=140.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='DMGR' ARED=105.0/255.0 AGREEN=105.0/255.0 ABLUE=105.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='LSBL' ARED=176.0/255.0 AGREEN=196.0/255.0 ABLUE=222.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='LGRE' ARED=50.0/255.0 AGREEN=205.0/255.0 ABLUE=50.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='MARO' ARED=176.0/255.0 AGREEN=48.0/255.0 ABLUE=96.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='MAQU' ARED=102.0/255.0 AGREEN=205.0/255.0 ABLUE=170.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='MBLU' ARED=0.0/255.0 AGREEN=0.0/255.0 ABLUE=205.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='MFGR' ARED=107.0/255.0 AGREEN=142.0/255.0 ABLUE=35.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='MGLD' ARED=250.0/255.0 AGREEN=250.0/255.0 ABLUE=210.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='MORC' ARED=186.0/255.0 AGREEN=85.0/255.0 ABLUE=211.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='MSGR' ARED=60.0/255.0 AGREEN=179.0/255.0 ABLUE=113.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='MSBL' ARED=123.0/255.0 AGREEN=104.0/255.0 ABLUE=238.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='MSPG' ARED=0.0/255.0 AGREEN=250.0/255.0 ABLUE=154.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='MTUR' ARED=72.0/255.0 AGREEN=209.0/255.0 ABLUE=204.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='MVRD' ARED=199.0/255.0 AGREEN=21.0/255.0 ABLUE=133.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='MDBL' ARED=25.0/255.0 AGREEN=25.0/255.0 ABLUE=112.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='NAVY' ARED=0.0/255.0 AGREEN=0.0/255.0 ABLUE=128.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='ORED' ARED=255.0/255.0 AGREEN=69.0/255.0 ABLUE=0.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='ORCH' ARED=218.0/255.0 AGREEN=112.0/255.0 ABLUE=214.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='PGRE' ARED=152.0/255.0 AGREEN=251.0/255.0 ABLUE=152.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='PINK' ARED=255.0/255.0 AGREEN=192.0/255.0 ABLUE=203.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='PLUM' ARED=221.0/255.0 AGREEN=160.0/255.0 ABLUE=221.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='PURP' ARED=160.0/255.0 AGREEN=32.0/255.0 ABLUE=240.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='SALM' ARED=250.0/255.0 AGREEN=128.0/255.0 ABLUE=114.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='SGRE' ARED=46.0/255.0 AGREEN=139.0/255.0 ABLUE=87.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='SIEN' ARED=160.0/255.0 AGREEN=82.0/255.0 ABLUE=45.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='SKBL' ARED=135.0/255.0 AGREEN=206.0/255.0 ABLUE=235.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='SBLU' ARED=106.0/255.0 AGREEN=90.0/255.0 ABLUE=205.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='SPGR' ARED=0.0/255.0 AGREEN=255.0/255.0 ABLUE=127.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='STBL' ARED=70.0/255.0 AGREEN=130.0/255.0 ABLUE=180.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='TAN ' ARED=210.0/255.0 AGREEN=180.0/255.0 ABLUE=140.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='THIS' ARED=216.0/255.0 AGREEN=191.0/255.0 ABLUE=216.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='TURQ' ARED=64.0/255.0 AGREEN=224.0/255.0 ABLUE=208.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='VIOL' ARED=238.0/255.0 AGREEN=130.0/255.0 ABLUE=238.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='WHEA' ARED=245.0/255.0 AGREEN=222.0/255.0 ABLUE=179.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='GYEL' ARED=173.0/255.0 AGREEN=255.0/255.0 ABLUE=47.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='LCYA' ARED=224.0/255.0 AGREEN=255.0/255.0 ABLUE=255.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='BLU2' ARED=0.0/255.0 AGREEN=0.0/255.0 ABLUE=238.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='BLU3' ARED=0.0/255.0 AGREEN=0.0/255.0 ABLUE=205.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='BLU4' ARED=0.0/255.0 AGREEN=0.0/255.0 ABLUE=139.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='CYA2' ARED=0.0/255.0 AGREEN=238.0/255.0 ABLUE=238.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='CYA3' ARED=0.0/255.0 AGREEN=205.0/255.0 ABLUE=205.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='CYA4' ARED=0.0/255.0 AGREEN=139.0/255.0 ABLUE=139.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='GRE2' ARED=0.0/255.0 AGREEN=238.0/255.0 ABLUE=0.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='GRE3' ARED=0.0/255.0 AGREEN=205.0/255.0 ABLUE=0.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='GRE4' ARED=0.0/255.0 AGREEN=139.0/255.0 ABLUE=0.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='YEL2' ARED=238.0/255.0 AGREEN=238.0/255.0 ABLUE=0.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='YEL3' ARED=205.0/255.0 AGREEN=205.0/255.0 ABLUE=0.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='YEL4' ARED=139.0/255.0 AGREEN=139.0/255.0 ABLUE=0.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='ORA2' ARED=238.0/255.0 AGREEN=154.0/255.0 ABLUE=0.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='ORA3' ARED=205.0/255.0 AGREEN=133.0/255.0 ABLUE=0.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='ORA4' ARED=139.0/255.0 AGREEN=90.0/255.0 ABLUE=0.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='RED2' ARED=238.0/255.0 AGREEN=0.0/255.0 ABLUE=0.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='RED3' ARED=205.0/255.0 AGREEN=0.0/255.0 ABLUE=0.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='RED4' ARED=139.0/255.0 AGREEN=0.0/255.0 ABLUE=0.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='MAG2' ARED=238.0/255.0 AGREEN=0.0/255.0 ABLUE=238.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='MAG3' ARED=205.0/255.0 AGREEN=0.0/255.0 ABLUE=205.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)=IBASLC ICSTR(2:24)='definecolor{ }{rgb}{' NCSTR=24 ICSTR(14:17)='MAG4' ARED=139.0/255.0 AGREEN=0.0/255.0 ABLUE=139.0/255.0 CALL GRTRRE(ARED,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(AGREEN,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRRE(ABLUE,NCHTOT,NCHDEC,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ENDIF C GOTO9000 C C ****************************************************** C ** STEP 160-- ** C ** TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER ** C ****************************************************** C 16000 CONTINUE C CALL DPCONA(34,IQUOTE) ISVGOS='ON' ISVGCN=0 C ICSTR(1:14)='' NCSTR=-37 CALL GRWRST(ICSTR,NCSTR,ISUBN0) C IF(ISVGSS(1:3).EQ.'EXT')THEN NCSTR=22 ICSTR(1:NCSTR)='' NCSTR=-(NCSTR+1) CALL GRWRST(ICSTR,NCSTR,ISUBN0) ENDIF C ICSTR(1:21)='' NCSTR=-64 CALL GRWRST(ICSTR,NCSTR,ISUBN0) C NCHTOT=6 IXTEMP=ANUMHP IYTEMP=ANUMVP C ICSTR(1:11)=' ...] SETDASH ** C ** THE FOLLOWING PATTERNS ARE USED, BUT THEY ARE ** C ** SCALED TO THE DOTS PER INCH (PATTERNS ARE FOR ** C ** 72 DOTS PER INCH) ** C ** [ 0 4 ] 0 ** C ** [ ] 0 ** C ** [ 2 4 ] 0 ** C ** [ 4 4 ] 0 ** C ** [ 4 2 ] 0 ** C ** [ 6 4 2 4 ] 0 ** C ** [ 6 4 4 4 ] 0 ** C ** [ 6 4 4 4 2 4 ] 0 ** C ** REFERENCE--POSTSCRIPT LANGUAGE, TUTORIAL AND ** C ** COOKBOOK, ADOBE SYSTEMS ** C ****************************************************** CCCCC JUNE, 1990. BUG FIX. POSTSCRIPT DOES NOT SUPPORT A "NULL" LINE CCCCC PATTERN. SET TO SOLID, BUT IN GRDRPL, IF PATTERN IS ZERO, SKIP CCCCC THE LINE. C 8600 CONTINUE ASCALE=PSTPPI/72. IF(ICASE.EQ.'LINE')GOTO8610 IF(ICASE.EQ.'REGI')GOTO8620 IF(ICASE.EQ.'MARK')GOTO8630 IF(ICASE.EQ.'TEXT')GOTO8640 GOTO8610 C 8610 CONTINUE IF(JPATTT.EQ.0)GOTO8611 IF(JPATTT.EQ.1)GOTO8612 IF(JPATTT.EQ.2)GOTO8613 IF(JPATTT.EQ.3)GOTO8614 IF(JPATTT.EQ.4)GOTO8615 IF(JPATTT.EQ.5)GOTO8616 IF(JPATTT.EQ.6)GOTO8617 IF(JPATTT.EQ.7)GOTO8618 GOTO8611 C 8611 CONTINUE CCCCC ICSTR(1:4)='[ 0 ' CCCCC NCHTOT=5 CCCCC NCSTR=4 CCCCC IJUNK=INT(4.*ASCALE+0.5) CCCCC IF(IJUNK.LE.1)IJUNK=4 CCCCC CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR) CCCCC ICSTR(10:21)=' ] 0 setdash' CCCCC NCSTR=21 ICSTR(1:13)='[ ] 0 setdash' NCSTR=13 GOTO8619 C 8612 CONTINUE ICSTR(1:13)='[ ] 0 setdash' NCSTR=13 GOTO8619 C 8613 CONTINUE ICSTR(1:2)='[ ' NCHTOT=5 NCSTR=2 IJUNK=INT(2.*ASCALE+0.5) IF(IJUNK.LE.1)IJUNK=2 CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR) ICSTR(8:8)=' ' NCSTR=8 IJUNK=INT(4.*ASCALE+0.5) IF(IJUNK.LE.1)IJUNK=4 CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR) ICSTR(14:25)=' ] 0 setdash' NCSTR=25 GOTO8619 C 8614 CONTINUE ICSTR(1:2)='[ ' NCHTOT=5 NCSTR=2 IJUNK=INT(4.*ASCALE+0.5) IF(IJUNK.LE.1)IJUNK=4 CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR) ICSTR(8:8)=' ' NCSTR=8 IJUNK=INT(4.*ASCALE+0.5) IF(IJUNK.LE.1)IJUNK=4 CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR) ICSTR(14:25)=' ] 0 setdash' NCSTR=25 GOTO8619 C 8615 CONTINUE ICSTR(1:2)='[ ' NCHTOT=5 NCSTR=2 IJUNK=INT(4.*ASCALE+0.5) IF(IJUNK.LE.1)IJUNK=4 CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR) ICSTR(8:8)=' ' NCSTR=8 IJUNK=INT(2.*ASCALE+0.5) IF(IJUNK.LE.1)IJUNK=2 CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR) ICSTR(14:25)=' ] 0 setdash' NCSTR=25 GOTO8619 C 8616 CONTINUE ICSTR(1:2)='[ ' NCHTOT=5 NCSTR=2 IJUNK=INT(6.*ASCALE+0.5) IF(IJUNK.LE.1)IJUNK=6 CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR) ICSTR(8:8)=' ' NCSTR=8 IJUNK=INT(4.*ASCALE+0.5) IF(IJUNK.LE.1)IJUNK=4 CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR) ICSTR(14:14)=' ' NCSTR=14 IJUNK=INT(2.*ASCALE+0.5) IF(IJUNK.LE.1)IJUNK=2 CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR) ICSTR(20:20)=' ' NCSTR=20 IJUNK=INT(4.*ASCALE+0.5) IF(IJUNK.LE.1)IJUNK=4 CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR) ICSTR(26:37)=' ] 0 setdash' NCSTR=37 GOTO8619 C 8617 CONTINUE ICSTR(1:2)='[ ' NCHTOT=5 NCSTR=2 IJUNK=INT(6.*ASCALE+0.5) IF(IJUNK.LE.1)IJUNK=6 CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR) ICSTR(8:8)=' ' NCSTR=8 IJUNK=INT(4.*ASCALE+0.5) IF(IJUNK.LE.1)IJUNK=4 CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR) ICSTR(14:14)=' ' NCSTR=14 IJUNK=INT(6.*ASCALE+0.5) IF(IJUNK.LE.1)IJUNK=6 CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR) ICSTR(20:20)=' ' NCSTR=20 IJUNK=INT(4.*ASCALE+0.5) IF(IJUNK.LE.1)IJUNK=4 CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR) ICSTR(26:37)=' ] 0 setdash' NCSTR=37 GOTO8619 C 8618 CONTINUE ICSTR(1:2)='[ ' NCHTOT=5 NCSTR=2 IJUNK=INT(6.*ASCALE+0.5) IF(IJUNK.LE.1)IJUNK=6 CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR) ICSTR(8:8)=' ' NCSTR=8 IJUNK=INT(4.*ASCALE+0.5) IF(IJUNK.LE.1)IJUNK=4 CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR) ICSTR(14:14)=' ' NCSTR=14 IJUNK=INT(4.*ASCALE+0.5) IF(IJUNK.LE.1)IJUNK=4 CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR) ICSTR(20:20)=' ' NCSTR=20 IJUNK=INT(4.*ASCALE+0.5) IF(IJUNK.LE.1)IJUNK=4 CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR) ICSTR(26:26)=' ' NCSTR=26 IJUNK=INT(2.*ASCALE+0.5) IF(IJUNK.LE.1)IJUNK=2 CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR) ICSTR(32:32)=' ' NCSTR=32 IJUNK=INT(4.*ASCALE+0.5) IF(IJUNK.LE.1)IJUNK=4 CALL GRTRIN(IJUNK,NCHTOT,ICSTR,NCSTR) ICSTR(38:49)=' ] 0 setdash' NCSTR=49 GOTO8619 C 8619 CONTINUE CALL GRWRST(ICSTR,NCSTR,ISUBN0) GOTO9000 C 8620 CONTINUE GOTO9000 C 8630 CONTINUE GOTO9000 C 8640 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 89-- ** C ** TREAT THE DISPLAY POSTSCRIPT DRIVER ** C ****************************************************** C 8900 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 91-- ** C ** TREAT THE QUIC CASE ** C ** TO SET (LINE) PATTERN-- ** C ** WRITE OUT A ^V(PATTERN NUMBER) ** C ** HOWEVER, SET WHEN ACTUALLY DRAW LINE ** C ** WHERE PATTERN NUMBER IS 0 TO 9, A-F ** C ** REFERENCE--QUIC PROGRAMMERS MANUAL, FROM QMS ** C ** CHAPTER 14 ** C ****************************************************** C 9100 CONTINUE IF(ICASE.EQ.'LINE')GOTO9110 IF(ICASE.EQ.'REGI')GOTO9120 IF(ICASE.EQ.'MARK')GOTO9130 IF(ICASE.EQ.'TEXT')GOTO9140 GOTO9110 C 9110 CONTINUE GOTO9000 C 9120 CONTINUE GOTO9000 C 9130 CONTINUE GOTO9000 C 9140 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 96-- ** C ** TREAT THE X11 CASE ** C ****************************************************** C 9600 CONTINUE IF(IX11OF.EQ.'OFF')GOTO9000 IF(ICASE.EQ.'LINE')GOTO9610 IF(ICASE.EQ.'REGI')GOTO9620 IF(ICASE.EQ.'MARK')GOTO9630 IF(ICASE.EQ.'TEXT')GOTO9640 GOTO9610 C 9610 CONTINUE CCCCC ADD FOLLOWING LINE OCTOBER 1996 IF(JPATTT.EQ.-1)GOTO9000 ICODE=3 INDEX=0 IF(IX11CS.EQ.'ROUND')INDEX=1 IF(IX11CS.EQ.'NOTLAST')INDEX=2 IF(IX11CS.EQ.'PROJECT')INDEX=3 CALL XLATTR(INDEX,ICODE) ICODE=4 INDEX=0 IF(IX11JS.EQ.'ROUND')INDEX=1 IF(IX11JS.EQ.'BEVEL')INDEX=2 CALL XLATTR(INDEX,ICODE) ICODE=2 INDEX=0 CALL XLATTR(JPATTT,ICODE) GOTO9000 C 9620 CONTINUE GOTO9000 C 9630 CONTINUE GOTO9000 C 9640 CONTINUE GOTO9000 C C ************************************************* C ** STEP 100-- ** C ** TREAT THE VGA VIA TURBO-C CASE ** C ** REFERENCE--TURBO C 1.5 ADDITIONS & ** C ** ENHANCEMENTS, PAGE 74. ** C ** REFERENCE--TURBO C 2.0 REFERENCE GUIDE, ** C ** PAGE 310. ** C ** REFERENCE--WEISKAMP, POWER GRAPHICS ** C ** USING TURBO C, PAGE 29. ** C ************************************************* C 10000 CONTINUE IF(ITCST.EQ.'CLOS')GOTO9000 CCCCC ADD FOLLOWING LINE OCTOBER 1996 IF(JPATTT.EQ.-1)GOTO9000 CALL TCSEPA(ICASE,IPATTT) GOTO9000 C C ****************************************************** C ** STEP 110-- ** C ** TREAT THE GKS DRIVER ** C ****************************************************** C 11000 CONTINUE IF(ICASE.EQ.'LINE')GOTO11010 IF(ICASE.EQ.'REGI')GOTO11020 IF(ICASE.EQ.'MARK')GOTO11030 IF(ICASE.EQ.'TEXT')GOTO11040 GOTO11010 C 11010 CONTINUE CCCCC ADD FOLLOWING LINE OCTOBER 1996 IF(JPATTT.EQ.-1)GOTO9000 CGKS CALL GSLN(JPATTT) GOTO9000 C 11020 CONTINUE GOTO9000 C 11030 CONTINUE GOTO9000 C 11040 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 120-- ** C ** TREAT THE GD DRIVER ** C ** THIS LIBRARY PROVIDES SUPPORT FOR: ** C ** 1) JPEG ** C ** 2) PNG ** C ** 3) WINDOWS BMP (BLACK/WHITE ONLY) ** C ****************************************************** C 12000 CONTINUE IF(ICASE.EQ.'LINE')GOTO12010 IF(ICASE.EQ.'REGI')GOTO12020 IF(ICASE.EQ.'MARK')GOTO12030 IF(ICASE.EQ.'TEXT')GOTO12040 GOTO12010 C 12010 CONTINUE CCCCC CALL GDSEPA(JPATTT) GOTO9000 C 12020 CONTINUE GOTO9000 C 12030 CONTINUE GOTO9000 C 12040 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 130-- ** C ** TREAT THE MACINTOSH DRIVER ** C ** LIBRARY FROM ABSOFT COMPILER ** C ****************************************************** C 13000 CONTINUE IF(ICASE.EQ.'LINE')GOTO13010 IF(ICASE.EQ.'REGI')GOTO13020 IF(ICASE.EQ.'MARK')GOTO13030 IF(ICASE.EQ.'TEXT')GOTO13040 GOTO13010 C 13010 CONTINUE IF(JPATTT.EQ.-1)GOTO9000 GOTO9000 C 13020 CONTINUE GOTO9000 C 13030 CONTINUE GOTO9000 C 13040 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 135-- ** C ** TREAT THE MAC OSX AQUATERM DRIVER ** C ****************************************************** C 13500 CONTINUE IF(ICASE.EQ.'LINE')GOTO13510 IF(ICASE.EQ.'REGI')GOTO13520 IF(ICASE.EQ.'MARK')GOTO13530 IF(ICASE.EQ.'TEXT')GOTO13540 GOTO13510 C 13510 CONTINUE IF(JPATTT.EQ.-1)GOTO9000 GOTO9000 C 13520 CONTINUE GOTO9000 C 13530 CONTINUE GOTO9000 C 13540 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 140-- ** C ** TREAT THE PC PRINTER DRIVER ** C ****************************************************** C 14000 CONTINUE IF(ICASE.EQ.'LINE')GOTO14010 IF(ICASE.EQ.'REGI')GOTO14020 IF(ICASE.EQ.'MARK')GOTO14030 IF(ICASE.EQ.'TEXT')GOTO14040 GOTO14010 C 14010 CONTINUE IF(JPATTT.EQ.-1)GOTO9000 GOTO9000 C 14020 CONTINUE GOTO9000 C 14030 CONTINUE GOTO9000 C 14040 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 150-- ** C ** TREAT THE LATEK (USING EEPIC) DRIVER ** C ****************************************************** C 15000 CONTINUE IF(ICASE.EQ.'LINE')GOTO15010 IF(ICASE.EQ.'REGI')GOTO15020 IF(ICASE.EQ.'MARK')GOTO15030 IF(ICASE.EQ.'TEXT')GOTO15040 GOTO15010 C 15010 CONTINUE GOTO9000 C 15020 CONTINUE GOTO9000 C 15030 CONTINUE GOTO9000 C 15040 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 160-- ** C ** TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER ** C ****************************************************** C 16000 CONTINUE IF(ICASE.EQ.'LINE')GOTO16010 IF(ICASE.EQ.'REGI')GOTO16020 IF(ICASE.EQ.'MARK')GOTO16030 IF(ICASE.EQ.'TEXT')GOTO16040 GOTO16010 C 16010 CONTINUE GOTO9000 C 16020 CONTINUE GOTO9000 C 16030 CONTINUE GOTO9000 C 16040 CONTINUE GOTO9000 C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'SEPA')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF GRSEPA--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)ICASE 9012 FORMAT('ICASE = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)IPATTT,JPATTT 9013 FORMAT('IPATTT,JPATTT = ',A4,I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)PXSPA,PYSPA,PXSPA2,PYSPA2 9014 FORMAT('PXSPA,PYSPA,PXSPA2,PYSPA2 = ',4E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9015)IHORPA,IVERPA,IDUPPA,IDDOPA 9015 FORMAT('IHORPA,IVERPA,IDUPPA,IDDOPA = ',A4,2X,A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9018)IMANUF,IMODEL 9018 FORMAT('IMANUF,IMODEL = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9019)IGUNIT 9019 FORMAT('IGUNIT = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9023)NCSTR 9023 FORMAT('NCSTR = ',I8) CALL DPWRST('XXX','BUG ') IF(NCSTR.LE.0)GOTO9027 DO9025I=1,NCSTR CCCCC IASCNE=ICHAR(ICSTR(I:I)) CALL DPCOAN(ICSTR(I:I),IASCNE) WRITE(ICOUT,9026)I,ICSTR(I:I),IASCNE 9026 FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8) CALL DPWRST('XXX','BUG ') 9025 CONTINUE 9027 CONTINUE WRITE(ICOUT,9029)IBUGG4,ISUBG4,IERRG4 9029 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE GRSEPP(I, 1IPL1NU, 1IPL2NU, 1IDMANU,IDMODE,IDMOD2,IDMOD3, 1IDPOWE,IDCONT,IDCOLO,IDFONT,IDNVPP,IDNHPP,IDUNIT, 1IDNVOF,IDNHOF, 1IBUGO2,IFOUN2,IERROR) C C PURPOSE--SCAN FOR PARTICULAR MANUFACTURERS FOR DEVICE I, C AND APPROPRIATELY UPDATE THE CONTINUITY, COLOR, AND C PICTURE POINT VECTORS. C NOTE--MANY OF THE PICTURE POINT SETTINGS HAVE BEEN ASSIGNED C VALUES OF 1000 AND 1000--THIS INDICATES THAT THE C ACTUAL COORECT VALUES ARE NOT KNOWN AND SHOULD C BE ASSIGNED THE PROPER VALUE IF SUCH A DEVICE C EXISTS AT ONE'S INSTALLATION. C INPUT ARGUMENTS-- C --I C --IDMANU C --IDMODE C --IDMOD2 C --IDMOD3 C OUTPUT ARGUMENTS-- C --IDPOWE C --IDCONT C --IDCOLO C --IDNVPP C --IDNHPP C --IFOUN2 ('YES' OR 'NO' ) C --IERROR ('YES' OR 'NO' ) C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-3651 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL BUREAU OF STANDARDS. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--82/7 C ORIGINAL VERSION--OCTOBER 1980. C UPDATED --MAY 1982. C UPDATED --JANUARY 1989. SUN (BY BILL ANDERSON) C DRIVER OBSOLETE C UPDATED --JANUARY 1989. POSTSCRIPT (BY ALAN HECKERT) C UPDATED --JANUARY 1989. CGM (BY ALAN HECKERT) C UPDATED --JANUARY 1989. QMS QUIC (BY ALAN HECKERT) C UPDATED --JANUARY 1989. CALCOMP (BY ALAN HECKERT) C UPDATED --JANUARY 1989. ZETA (BY ALAN HECKERT) C UPDATED --MARCH 1990. X11 (BY ALAN HECKERT) C UPDATED --MARCH 1990. EMULATE ORIENTATION FOR SOME C DEVICES (BY ALAN HECKERT) C UPDATED --MAY 1990. HP-GL UPDATES (BY ALAN HECKERT) C UPDATED --NOVEMBER 1990. POSTSCRIPT BUG FIX (BY ALAN HECKERT) C UPDATED --MAY 1991. RENUMBER TOP BRANCHES (JJF) C UPDATED --MAY 1991. VGA/TURBOC DRIVER (JJF) C DRIVER OBSOLETE C UPDATED --AUGUST 1992. HP-GL FOR LASERJET III (ALAN) C UPDATED --JULY 1996. LAHEY DRIVER (ALAN HECKERT) C OLD CALCOMP STYLE C DRIVER OBSOLETE C UPDATED --OCTOBER 1996. QUICKWIN (ALAN) C UPDATED --OCTOBER 1996. OPEN GL (ALAN) C USE BILL MITCHELLS OPENGL C BINDING FOR FORTRAN C UPDATED --OCTOBER 1996. GKS (ALAN) C CODED, NOT TESTED C UPDATED --OCTOBER 1996. BINARY CGM (ALAN) C PLACEHOLDER FOR NOW C UPDATED --OCTOBER 1996. DISPLAY POSTSCRIPT (ALAN) C PLACEHOLDER FOR NOW C UPDATED --NOVEMBER 1996. SUPPORT FOR C "LANDSCAPE WORDPERFECT" C FOR POSTSCRIPT DRIVER C UPDATED --OCTOBER 1997. LAHEY INTERACTOR (ALAN) C UPDATED --JULY 1998. LAHEY WINTERACTOR C UPDATED --JUNE 2000. GD (FOR JPEG, PNG, WINDOWS BMP) C UPDATED --JUNE 2000. MACINTOSH C PLACEHOLDER FOR NOW C CHANGE THIS TO "QUARTZ" C UPDATED --JUNE 2000. PC PRINTER C PLACEHOLDER FOR NOW C CHANGE THIS TO "GHOSTSCRIPT" C UPDATED --MARCH 2002. ADD LATEX (EEPIC) C UPDATED --MARCH 2002. ADD SVG (SCALABLE VECTOR GRAPHICS) C UPDATED --JANUARY 2003. SUPPORT FOR ORIENTATION WHEN DEVICE C IS INITIALIZED. C UPDATED --JANUARY 2003. SUPPORT FOR LANDSCAPE WORDPERFECT C ORIENTATION FOR POSTSCRIPT AND C OTHER DEVICES C UPDATED --MARCH 2005. SUPPORT FOR AQUATERM DEVICE C USED WITH MAC OSX C C--------------------------------------------------------------------- C CHARACTER*4 IDMANU CHARACTER*4 IDMODE CHARACTER*4 IDMOD2 CHARACTER*4 IDMOD3 C CHARACTER*4 IDPOWE CHARACTER*4 IDCONT CHARACTER*4 IDCOLO CHARACTER*4 IDFONT C CHARACTER*4 IC4 CCCCC CHARACTER*3 IC3 CHARACTER*2 IC2 CCCCC CHARACTER*1 IC1 C CHARACTER*4 IBUGO2 CHARACTER*4 IFOUN2 CHARACTER*4 IERROR C C--------------------------------------------------------------------- C DIMENSION IDMANU(*) DIMENSION IDMODE(*) DIMENSION IDMOD2(*) DIMENSION IDMOD3(*) C DIMENSION IDPOWE(*) DIMENSION IDCONT(*) DIMENSION IDCOLO(*) DIMENSION IDFONT(*) DIMENSION IDNVPP(*) DIMENSION IDNHPP(*) DIMENSION IDUNIT(*) C C MAY, 1988. ADD VERTICAL AND HORIZONTAL OFFSET PARAMETERS. C DIMENSION IDNVOF(*) DIMENSION IDNHOF(*) C C--------------------------------------------------------------------- C INCLUDE 'DPCOST.INC' INCLUDE 'DPCODV.INC' C C MAY, 1988. ADD "GRAPHICS UNIT" FROM "DPCOGR" COMMON BLOCKS. C COMMON/ICOMGU/IGUNIT,IPRGR,IRDGR C C FEBRUARY, 2006. ADD "MACRO UNIT" FROM "DPCOF2" COMMON BLOCK. C COMMON /ICOMI1/ 1IMESNU, 1INEWNU, 1IMAINU, 1IHELNU, 1IBUGNU, 1IQUENU, 1ISYSNU, 1ILOGNU, 1IDIRNU, 1IDICNU, 1IREANU, 1IWRINU, 1ISAVNU, 1ILISNU, 1ICRENU, 1ICREN2, 1ICAPNU C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C IFOUN2='NO' IERROR='NO' C IDPOWE(I)='ON' C C MAY, 1988. SEPARATE UNITS FOR GRAPHICS. CCCCC IDUNIT(I)=IPR IDUNIT(I)=IPRGR IF(I.EQ.2)IDUNIT(I)=IPL1NU IF(I.EQ.3)IDUNIT(I)=IPL2NU C C ****************************************************************** C ** FOLLOWING ARE EITHER ALPHANUMERIC TERMINALS OR LINE PRINTERS** C ****************************************************************** IF(IDMANU(I).EQ.'ANDE')GOTO1100 IF(IDMANU(I).EQ.'AJ')GOTO1100 IF(IDMANU(I).EQ.'BATC')GOTO1200 IF(IDMANU(I).EQ.'DISC')GOTO1300 IF(IDMANU(I).EQ.'DTC')GOTO1400 IF(IDMANU(I).EQ.'HAZE')GOTO1500 IF(IDMANU(I).EQ.'OMRO')GOTO1600 IF(IDMANU(I).EQ.'TELE')GOTO1700 IF(IDMANU(I).EQ.'TERM')GOTO1800 IF(IDMANU(I).EQ.'TEXA')GOTO1900 IF(IDMANU(I).EQ.'TI')GOTO1900 C C ****************************************************************** C ** FOLLOWING ARE METAFILES ** C ** (GENERAL, GENERAL CODED, METAFILE, FILE, CGM) ** C ****************************************************************** C IF(IDMANU(I).EQ.'FILE')GOTO2100 IF(IDMANU(I).EQ.'META')GOTO2100 IF(IDMANU(I).EQ.'GENE')GOTO2100 IF(IDMANU(I).EQ.'CGM')GOTO2100 IF(IDMANU(I).EQ.'CGMB')GOTO2100 C C ****************************************************************** C ** FOLLOWING ARE CURRENTLY SUPPORTED DEVICES ** C ** ** C ** 1) TEKTRONIX - (MODELS 4006, 4010, 4020, 4022, 4025, 4027 ** C ** 4051, 4052, 4113, 4115, 4662, 4105 ** C ** 4107, 4109, 4014, 4114) ** C ** 2) HP - HP-GL (9872, 7475, 7580) ** C ** - 7221 PLOTTER ** C ** - 2622 AND COMPATIBLE ** C ** (2623, 2647, 2648, 9816, 9836, ** C ** 2393, [MONOCHROME MODELS] ** C ** 2627, 2397, 2390 [8 COLORS]) ** C ** 3) CALCOMP - REQUIRES LOCAL VERSION OF CALCOMP LIBRARY ** C ** 4) ZETA - REQUIRES LOCAL VERSION OF ZETA (A CALCOMP ** C ** EXTENDED LIBRARY) ** C ** 5) REGIS - ANY DEC TERMINAL RUNNING REGIS PROTOCOL ** C ** 6) SUN - USES SUN GRAPHICS LIBRARY ** C ** CODE IN DATAPLOT GRAPHICS ROUTINES NEEDS ** C ** TO BE UNCOMMENTED) ** C ** 7) QUIC - (EITHER LANDSCAPE OR PORTRAIT MODE) ** C ** 8) POSTSCRIPT - (EITHER LANDSCAPE OR PORTRAIT MODE) ** C ** 9) X11 - (PICTURE POINTS CAN VARY) ** C ** 9) VGA/TURBO-C - REQUIRES TURBO-C 2.0 OR ABOVE ** C ** 10) LAHEY - REQUIRES LAHEY COMPILER AND GRAPHICS LIB ** C ** 11) QWIN - REQUIRES MICROSOFT COMPILER ** C ** 12) GKS - REQUIRES A GKS LIBRARY ** C ** 13) OPGL - REQUIRES BILL MITCHELLS OPENGL ** C ** FORTRAN 90 BINDING ** C ** 14) GD - REQUIRES GD LIBRARY ** C ** (JPEG, PNG, WINDOWS BMP) ** C ** 15) PRIN - PC PRINTERS FOR WINDOWS 95/98/NT ** C ** - CHANGE TO GHOSTSCRIPT (OR GS) ** C ** 16) LATEX (EEPIC) - LATEX (USING EEPIC PACKAGE) ** C ** 17) MACINTOSH - USE QUARTZ DRIVER ** C ** 18) SVG - SCALABLE VECTOR GRAPHICS ** C ** 19) AQUATERM - AQUATERM ** C ****************************************************************** C IF(IDMANU(I).EQ.'HEWL')GOTO6000 IF(IDMANU(I).EQ.'HP')GOTO6000 IF(IDMANU(I).EQ.'TEKT')GOTO6400 IF(IDMANU(I).EQ.'ZETA')GOTO6900 IF(IDMANU(I).EQ.'CALC')GOTO5400 IF(IDMANU(I).EQ.'LAHE')GOTO15400 IF(IDMANU(I).EQ.'REGI')GOTO7100 IF(IDMANU(I).EQ.'VT')GOTO7100 IF(IDMANU(I).EQ.'DEC')GOTO7100 IF(IDMANU(I).EQ.'SUN')GOTO7200 IF(IDMANU(I).EQ.'PCL')GOTO7300 IF(IDMANU(I).EQ.'QUIC')GOTO7400 IF(IDMANU(I).EQ.'QMS')GOTO7400 IF(IDMANU(I).EQ.'POST')GOTO7500 IF(IDMANU(I).EQ.'X11 ')GOTO7600 IF(IDMANU(I).EQ.'TURB')GOTO7700 IF(IDMANU(I).EQ.'LAHE')GOTO7800 IF(IDMANU(I).EQ.'QWIN')GOTO7900 IF(IDMANU(I).EQ.'GKS ')GOTO8000 IF(IDMANU(I).EQ.'PRIN')GOTO8100 IF(IDMANU(I).EQ.'GD ')GOTO8200 IF(IDMANU(I).EQ.'OPGL')GOTO8300 IF(IDMANU(I).EQ.'APPL')GOTO5100 IF(IDMANU(I).EQ.'MACI')GOTO5100 IF(IDMANU(I).EQ.'QUAR')GOTO5100 IF(IDMANU(I).EQ.'ABSO')GOTO5100 IF(IDMANU(I).EQ.'LATE')GOTO8400 IF(IDMANU(I).EQ.'EEPI')GOTO8400 IF(IDMANU(I).EQ.'SVG ')GOTO8500 IF(IDMANU(I).EQ.'AQUA')GOTO8600 C C ****************************************************************** C ** FOLLOWING ARE CURRENTLY UNSUPPORTED DEVICES ** C ****************************************************************** C IF(IDMANU(I).EQ.'BETA')GOTO5200 IF(IDMANU(I).EQ.'BROO')GOTO5300 IF(IDMANU(I).EQ.'COMP')GOTO5500 IF(IDMANU(I).EQ.'FR80')GOTO5700 IF(IDMANU(I).EQ.'GERB')GOTO5800 IF(IDMANU(I).EQ.'GOUL')GOTO5900 IF(IDMANU(I).EQ.'HOUS')GOTO6100 IF(IDMANU(I).EQ.'HI')GOTO6100 IF(IDMANU(I).EQ.'SC40')GOTO6200 IF(IDMANU(I).EQ.'SING')GOTO6300 IF(IDMANU(I).EQ.'VARI')GOTO6500 IF(IDMANU(I).EQ.'VECT')GOTO6600 IF(IDMANU(I).EQ.'VG')GOTO6600 IF(IDMANU(I).EQ.'VERS')GOTO6700 IF(IDMANU(I).EQ.'XYNE')GOTO6800 IF(IDMANU(I).EQ.'RAMT')GOTO7000 GOTO9000 C C **************************************** C ** TREAT THE ANDERSON JACOBSON CASE ** C **************************************** C 1100 CONTINUE IDCONT(I)='OFF' IDCOLO(I)='OFF' IDNHPP(I)=132 IDNVPP(I)=66 IDNVOF(I)=0 IDNHOF(I)=0 GOTO8900 C C **************************** C ** TREAT THE BATCH CASE ** C **************************** C 1200 CONTINUE IDCONT(I)='OFF' IDCOLO(I)='OFF' IDNHPP(I)=132 IDNVPP(I)=66 IDNVOF(I)=0 IDNHOF(I)=0 GOTO8900 C C ******************************* C ** TREAT THE DISCRETE CASE ** C ******************************* C 1300 CONTINUE IDCONT(I)='OFF' IDCOLO(I)='OFF' IDNHPP(I)=72 IDNVPP(I)=24 IF(IDMODE(I).EQ.'WIDE')IDNHPP(I)=132 IF(IDMODE(I).EQ.'WIDE')IDNVPP(I)=66 IDNVOF(I)=0 IDNHOF(I)=0 GOTO8900 C C ************************** C ** TREAT THE DTC CASE ** C ************************** C 1400 CONTINUE IDCONT(I)='OFF' IDCOLO(I)='OFF' IDNHPP(I)=132 IDNVPP(I)=66 IDNVOF(I)=0 IDNHOF(I)=0 GOTO8900 C C ******************************** C ** TREAT THE HAZELTINE CASE ** C ******************************** C 1500 CONTINUE IDCONT(I)='OFF' IDCOLO(I)='OFF' IDNHPP(I)=72 IDNVPP(I)=24 IDNVOF(I)=0 IDNHOF(I)=0 GOTO8900 C C **************************** C ** TREAT THE OMRON CASE ** C **************************** C 1600 CONTINUE IDCONT(I)='OFF' IDCOLO(I)='OFF' IDNHPP(I)=72 IDNVPP(I)=24 IDNVOF(I)=0 IDNHOF(I)=0 GOTO8900 C C ******************************* C ** TREAT THE TELETYPE CASE ** C ******************************* C 1700 CONTINUE IDCONT(I)='OFF' IDCOLO(I)='OFF' IDNHPP(I)=72 IDNVPP(I)=24 IDNVOF(I)=0 IDNHOF(I)=0 GOTO8900 C C ******************************* C ** TREAT THE TERMINET CASE ** C ******************************* C 1800 CONTINUE IDCONT(I)='OFF' IDCOLO(I)='OFF' IDNHPP(I)=132 IDNVPP(I)=66 IDNVOF(I)=0 IDNHOF(I)=0 GOTO8900 C C *************************************** C ** TREAT THE TEXAS INSTRUMENT CASE ** C *************************************** C 1900 CONTINUE IDCONT(I)='OFF' IDCOLO(I)='OFF' IDNHPP(I)=72 IDNVPP(I)=24 IDNVOF(I)=0 IDNHOF(I)=0 GOTO8900 C C ******************************* C ** TREAT THE METAFILE CASE ** C ******************************* C 2100 CONTINUE IDCONT(I)='ON' IDCOLO(I)='ON' IDNHPP(I)=10000 IDNVPP(I)=10000 IF(IDMANU(I).EQ.'CGM')IDMODE(I)='CGM' IF(IDMANU(I).EQ.'CGM')IDMANU(I)='GENE' IF(IDMANU(I).EQ.'CGMB')IDMODE(I)='CGMB' IF(IDMANU(I).EQ.'CGMB')IDMANU(I)='GENE' IDNVOF(I)=0 IDNHOF(I)=0 GOTO8900 C C ******************************** C ** TREAT THE MACINTOSH CASE ** C ** BASED ON LIBRARY WITH THE ** C ** ABSOFT COMPILER. ** C ******************************** C C NOTE: THIS DRIVER HAS NOT ACTUALLY BEEN DEVELOPED C 5100 CONTINUE IDCONT(I)='ON' IDCOLO(I)='ON' IDNHPP(I)=600 IDNVPP(I)=450 IDNVOF(I)=0 IDNHOF(I)=0 IF(IORNSW.EQ.'PORT')THEN IDNHPP(I)=450 IDNVPP(I)=600 ELSEIF(IORNSW.EQ.'LAN2')THEN IDNHPP(I)=450 IDNVPP(I)=350 IDNVOF(I)=125 IDNHOF(I)=0 ELSEIF(IORNSW.EQ.'SQUA')THEN IDNHPP(I)=450 IDNVPP(I)=450 IDNVOF(I)=0 IDNHOF(I)=0 ENDIF WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5102) 5102 FORMAT('MACINTOSH (BASED ON ABSOFT LIBRARY)') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5110) 5110 FORMAT('PICTURE POINTS--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5111)IDNHPP(I) 5111 FORMAT(12X,'HORIZONTAL = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,5112)IDNVPP(I) 5112 FORMAT(12X,'VERTICAL = ',I8) CALL DPWRST('XXX','BUG ') GOTO5190 C 5190 CONTINUE IFOUN2='YES' GOTO8900 C C ****************************** C ** TREAT THE BETACOM CASE ** C ****************************** C 5200 CONTINUE IDCONT(I)='ON' IDCOLO(I)='OFF' IDNHPP(I)=1000 IDNVPP(I)=1000 IDNVOF(I)=0 IDNHOF(I)=0 GOTO8900 C C ******************************* C ** TREAT THE BROOMALL CASE ** C ******************************* C 5300 CONTINUE IDCONT(I)='ON' IDCOLO(I)='OFF' IDNHPP(I)=1000 IDNVPP(I)=1000 IDNVOF(I)=0 IDNHOF(I)=0 GOTO8900 C C ****************************** C ** TREAT THE CALCOMP CASE ** C ****************************** C 5400 CONTINUE IDCONT(I)='ON' IDCOLO(I)='OFF' IF(ICALCL.GT.0)IDCOLO(I)='ON' IDNHPP(I)=INT(1000.*11.) IDNVPP(I)=INT(1000.*8.5) IDNVOF(I)=0 IDNHOF(I)=0 IF(IORNSW.EQ.'PORT')THEN IDNHPP(I)=INT(1000.*8.5) IDNVPP(I)=INT(1000.*11.) IDNVOF(I)=0 IDNHOF(I)=0 ELSEIF(IORNSW.EQ.'SQUA')THEN IDNHPP(I)=INT(1000.*8.5) IDNVPP(I)=INT(1000.*8.5) IDNVOF(I)=0 IDNHOF(I)=0 ELSEIF(IORNSW.EQ.'LAN2')THEN IDNHPP(I)=INT(1000.*8.5) IDNVPP(I)=INT(1000.*11.) IDNVOF(I)=INT(1000.*((11.0-7.73)/2)) IDNHOF(I)=0 ELSEIF(IORNSW.EQ.'POST')THEN IDNHPP(I)=INT(1000.*30.) IDNVPP(I)=INT(1000.*30.) IDNVOF(I)=0 IDNHOF(I)=0 ENDIF C GOTO8900 C C ****************************************************** C ** STEP 46-- ** C ** TREAT THE LAHEY XXXXXX CASE ** C ** REFERENCE--Programmer's Reference, Revision C ** C ** Lahey Computer Systems, January, 1992** C ** PAGES 51 THRU 65 ** C ****************************************************** C 15400 CONTINUE IDCONT(I)='ON' IDCOLO(I)='OFF' IF(ILAHNC.GT.0)IDCOLO(I)='ON' IF(IORNSW.EQ.'PORT')GOTO15410 IF(IORNSW.EQ.'SQUA')GOTO15420 IF(IDMODE(I).EQ.'WINT'.OR.IDMODE(I).EQ.'INTE')THEN IDNHPP(I)=600 IDNVPP(I)=450 ELSE IDNHPP(I)=INT(1000.*11.) IDNVPP(I)=INT(1000.*8.5) ENDIF GOTO15490 C 15410 CONTINUE IF(IDMODE(I).EQ.'WINT'.OR.IDMODE(I).EQ.'INTE')THEN IDNHPP(I)=450 IDNVPP(I)=600 ELSE IDNHPP(I)=INT(1000.*8.5) IDNVPP(I)=INT(1000.*11.) ENDIF GOTO15490 C 15420 CONTINUE IF(IDMODE(I).EQ.'WINT'.OR.IDMODE(I).EQ.'INTE')THEN IDNHPP(I)=450 IDNVPP(I)=450 ELSE IDNHPP(I)=INT(1000.*8.5) IDNVPP(I)=INT(1000.*8.5) ENDIF GOTO15490 C 15490 CONTINUE IDNVOF(I)=0 IDNHOF(I)=0 GOTO8900 C C ******************************* C ** TREAT THE COMPUTEK CASE ** C ******************************* C 5500 CONTINUE IDCONT(I)='ON' IDCOLO(I)='OFF' IDNHPP(I)=1000 IDNVPP(I)=1000 IDNVOF(I)=0 IDNHOF(I)=0 GOTO8900 C C *************************** C ** TREAT THE FR80 CASE ** C *************************** C 5700 CONTINUE IDCONT(I)='ON' IDCOLO(I)='OFF' IDNHPP(I)=1000 IDNVPP(I)=1000 IDNVOF(I)=0 IDNHOF(I)=0 GOTO8900 C C ***************************** C ** TREAT THE GERBER CASE ** C ***************************** C 5800 CONTINUE IDCONT(I)='ON' IDCOLO(I)='OFF' IDNHPP(I)=1000 IDNVPP(I)=1000 IDNVOF(I)=0 IDNHOF(I)=0 GOTO8900 C C **************************** C ** TREAT THE GOULD CASE ** C **************************** C 5900 CONTINUE IDCONT(I)='ON' IDCOLO(I)='OFF' IDNHPP(I)=1000 IDNVPP(I)=1000 IDNVOF(I)=0 IDNHOF(I)=0 GOTO8900 C C ********************************************************** C ** TREAT THE HEWLETT PACKARD CASE ** C ** REFERENCE--7221T OPERATING AND PROGRAMMING MANUAL, ** C ** PAGE 78 ** C ** (FOR 2622 AND 2623) PAGE 10-1 C ********************************************************** C C UPDATED MAY, 1990 FOR HP-GL. ADD CHECK FOR MODEL NUMBER: C UPDATED AUGUST 1992. CHECK FOR LASERJET III MODEL (TREAT AS 7475 C BUT IS MONOCHROME, ADVANCE PAGE HANDLED SEPARATELY) C 9872 - (4 PENS, 1 PAPER SIZE) C 7475, 7550 - (8 PENS, 2 PAPER SIZES) C 7580 - (8 PENS, 4 PAPER SIZES) C 7585, 7586 - (8 PENS, 5 PAPER SIZES) C LJET, LASE, LJ - (1 PEN, 1 PAPER SIZE) C C FOLLOWING ANSI STANDARD PAPER SIZES RECOGNIZED: C C A - 8 1/2 X 11 C B - 11 X 17 C C - 17 X 22 C D - 22 X 34 C E - 34 X 44 C C NOTE THAT FOR HP-GL, THE "IP" POINTS DEFINE THE "SCALE" POINTS WHILE C THE "SC" POINTS DEFINE THE USER UNITS. THAT IS, THE LOWER LEFT CORNER C SPECIFIED BY SC IS MAPPED TO THE LOWER LEFT SCALING POINT AND THE UPPER C RIGHT CORNER SPECIFIED BY SC IS MAPPED TO THE UPPER RIGHT SCALING POINT. C THAT IS, THE IP AND SC COMMANDS DEFINE THE WINDOW-TO-VIEWPORT MAPPING. C DATAPLOT DOES NOT SPECIFY THE IP PARAMETER BECAUSE MOST HP-GL PLOTTERS C ALLOW A USER TO MANUALLY SET THESE FROM THE PLOTTER AND WE DO NOT WANT C TO OVERIDE IF THEY HAVE SET IT. WE SET THE SC PARAMETERS EQUAL TO THE C DEFAULT IP VALUES FOR THE GIVEN PLOTTER AND PAPER SIZE (EXCEPT FOR THE C 7580/85/86 PLOTTERS WHICH USE NEGATIVE VALUES, FOR THESE WE DOUBLE THE C POSITIVE DISTANCE). THIS MEANS WE PLOT IN ABSOLUTE PLOTTER UNITS. WE C DO THIS SINCE DATAPLOT TYPICALLY WORKS IN "PICTURE POINT" UNITS ANYWAY C WHEN IT GETS TO THE DEVICE LEVEL. C C UPDATED JULY, 1990 FOR HP 26XX MODELS. SUPPORT COLOR ON SOME MODELS. C C MODEL RESOLUTION COLORS C ===== ========== ====== C 2622 512 X 390 0 C 2623 512 X 390 0 C 2647 720 X 360 0 C 2648 720 X 360 0 C 2393 512 X 390 0 C 9816 512 X 390 0 C 9836 512 X 390 0 C 2627 512 X 390 8 C 2397 512 X 390 8 C 2390 512 X 390 8 C C THESE MODELS ALL USE THE SAME DEVICE DRIVER. THEY DIFFER ONLY IN THE C NUMBER OF PICTURE POINTS AND IN WHETHER THEY SUPPORT COLOR OR NOT. C 6000 CONTINUE IDCONT(I)='ON' IDCOLO(I)='ON' IDNHPP(I)=16158 IDNVPP(I)=11040 IDNVOF(I)=0 IDNHOF(I)=0 IC4=IDMODE(I) IC2=IC4(1:2) CCCCC FOLLOWING CODE MODIFIED JULY, 1990 FOR HP-26XX TYPE TERMINALS CCCCC IF(IC2.EQ.'26')IDNHPP(I)=512 CCCCC IF(IC2.EQ.'26')IDNVPP(I)=390 CCCCC IF(IC2.EQ.'23')IDNHPP(I)=512 CCCCC IF(IC2.EQ.'23')IDNVPP(I)=390 CCCCC IF(IDMODE(I).EQ.'2647')IDNHPP(I)=720 CCCCC IF(IDMODE(I).EQ.'2647')IDNVPP(I)=360 CCCCC IF(IDMODE(I).EQ.'9816')IDNHPP(I)=512 CCCCC IF(IDMODE(I).EQ.'9816')IDNVPP(I)=390 CCCCC IF(IDMODE(I).EQ.'9836')IDNHPP(I)=512 CCCCC IF(IDMODE(I).EQ.'9836')IDNVPP(I)=390 CCCCC IF(IDMODE(I).EQ.'216')IDNHPP(I)=512 CCCCC IF(IDMODE(I).EQ.'216')IDNVPP(I)=390 CCCCC IF(IDMODE(I).EQ.'236')IDNHPP(I)=512 CCCCC IF(IDMODE(I).EQ.'236')IDNVPP(I)=390 IF(IDMODE(I).EQ.'2627'.OR.IDMODE(I).EQ.'2397'.OR. 1IDMODE(I).EQ.'2390')THEN IDNHPP(I)=512 IDNVPP(I)=390 IDCOLO(I)='ON' IDMODE(I)='2622' ELSE IF(IDMODE(I).EQ.'2647'.OR.IDMODE(I).EQ.'2648')THEN IDNHPP(I)=720 IDNVPP(I)=360 IDCOLO(I)='OFF' IDMODE(I)='2622' ELSE IF(IDMODE(I).EQ.'9816'.OR.IDMODE(I).EQ.'9836'.OR. 1IDMODE(I).EQ.'2393'.OR.IDMODE(I).EQ.'2622'.OR. 1IDMODE(I).EQ.'2623'.OR.IDMODE(I).EQ.'216'.OR. 1IDMODE(I).EQ.'236'.OR. 1IC2.EQ.'26')THEN IDNHPP(I)=512 IDNVPP(I)=390 IDCOLO(I)='OFF' IDMODE(I)='2622' END IF IF(IDMODE(I).EQ.'7221')IDNHPP(I)=3040 IF(IDMODE(I).EQ.'7221')IDNVPP(I)=2000 CCCCC IF(IC2.EQ.'26')IDMODE(I)='2622' CCCCC IF(IDMODE(I).EQ.'9816')IDMODE(I)='2622' CCCCC IF(IDMODE(I).EQ.'9836')IDMODE(I)='2622' CCCCC IF(IDMODE(I).EQ.'216')IDMODE(I)='2622' CCCCC IF(IDMODE(I).EQ.'236')IDMODE(I)='2622' IF(IDMOD2(I).EQ.'7550')IDMOD2(I)='7475' IF(IDMOD2(I).EQ.'7586')IDMOD2(I)='7585' CCCCC FOLLOWING LINES ADDED AUGUST 1992. CHECK FOR LASER JET IF(IDMOD2(I).EQ.'LJET' .OR. IDMOD2(I).EQ.'LJ ' .OR. 1 IDMOD2(I).EQ.'LASE')THEN IDMOD3(I)='LJET' IDMOD2(I)='7475' ENDIF CCCCC FOLLOWING LINES ADDED MARCH, 1990. CCCCC FOLLOWING MODIFIED JULY, 1990 (DISTINGUISH 2647 BY PICTURE POINTS) CCCCC IF(IDMODE(I).EQ.'2622')THEN IF(IDMODE(I).EQ.'2622'.AND.IDNHPP(I).EQ.512)THEN IF(IORNSW.EQ.'PORT')THEN IDNHPP(I)=302 IDNHOF(I)=45 ELSE IF(IORNSW.EQ.'SQUA')THEN IDNHPP(I)=390 IDNHOF(I)=60 END IF CCCCC ELSE IF(IDMODE(I).EQ.'2647')THEN ELSE IF(IDMODE(I).EQ.'2622'.AND.IDNHPP(I).EQ.720)THEN IF(IORNSW.EQ.'PORT')THEN IDNHPP(I)=278 IDNHOF(I)=221 ELSE IF(IORNSW.EQ.'SQUA')THEN IDNHPP(I)=369 IDNHOF(I)=180 ELSE IF(IORNSW.EQ.'LAND')THEN IDNHPP(I)=466 IDNHOF(I)=127 END IF ELSE IF(IDMODE(I).EQ.'GL ')THEN IGUNIT=IDUNIT(I) IF(IDMOD2(I).EQ.'7475')THEN IHPGCL=8 IF(IDMOD3(I).EQ.'B ')THEN IDNHPP(I)=16640 IDNVPP(I)=10365 CCCCC AUGUST 1992. ADD FOLLOWING 4 LINES ELSEIF(IDMOD3(I).EQ.'LJET')THEN IHPGCL=1 IDNHPP(I)=10250 IDNVPP(I)=7796 ELSE IDNHPP(I)=10250 IDNVPP(I)=7796 END IF ELSE IF(IDMOD2(I).EQ.'7580')THEN IHPGCL=8 IF(IDMOD3(I).EQ.'B ')THEN IDNHPP(I)=14200 IDNVPP(I)=9000 ELSE IF(IDMOD3(I).EQ.'C ')THEN IDNHPP(I)=19280 IDNVPP(I)=16566 ELSE IF(IDMOD3(I).EQ.'D ')THEN IDNHPP(I)=20120 IDNVPP(I)=30340 ELSE IDNHPP(I)=5580 IDNVPP(I)=9000 END IF ELSE IF(IDMOD2(I).EQ.'7585')THEN IHPGCL=8 IF(IDMOD3(I).EQ.'B ')THEN IDNHPP(I)=14200 IDNVPP(I)=9000 ELSE IF(IDMOD3(I).EQ.'C ')THEN IDNHPP(I)=14180 IDNVPP(I)=20150 ELSE IF(IDMOD3(I).EQ.'D ')THEN IDNHPP(I)=20120 IDNVPP(I)=30340 ELSE IF(IDMOD3(I).EQ.'E ')THEN IDNHPP(I)=41680 IDNVPP(I)=32360 ELSE IDNHPP(I)=5580 IDNVPP(I)=9000 END IF ELSE IHPGCL=4 IDMOD2(I)='9872' IDNHPP(I)=16158 IDNVPP(I)=11040 END IF IHPGX=IDNHPP(I) IHPGY=IDNVPP(I) IF(IORNSW.EQ.'PORT')THEN ASPECT=8.5/11. ELSE IF(IORNSW.EQ.'SQUA')THEN ASPECT=1. ELSE IF(IORNSW.EQ.'LAND')THEN ASPECT=11./8.5 ELSE ASPECT=-1.0 END IF IF(ASPECT.GT.0.0)THEN IXMIN=0 IXMAX=IDNHPP(I) IYMIN=0 IYMAX=IDNVPP(I) XDIST=REAL(IXMAX-IXMIN+1) YDIST=REAL(IYMAX-IYMIN+1) XSIZE=YDIST*ASPECT IF(XSIZE.GT.REAL(IXMAX))XSIZE=REAL(IXMAX) XOFF=(XDIST-XSIZE)/2. IF(XOFF.LT.0.)XOFF=0. IDNHPP(I)=INT(XSIZE+0.5) IDNHOF(I)=INT(XOFF+0.5) END IF END IF IF(IHPGCL.LE.4)THEN IHPGPM(1)='BLACK' IHPGPM(2)='RED ' IHPGPM(3)='BLUE' IHPGPM(4)='GREEN' DO6050J=5,16 ITEMP=MOD(J-1,4)+1 IHPGPM(J)=IHPGPM(ITEMP) 6050 CONTINUE ELSE IHPGPM(1)='BLACK' IHPGPM(2)='RED ' IHPGPM(3)='BLUE' IHPGPM(4)='GREEN' IHPGPM(5)='MAGENTA' IHPGPM(6)='ORANGE' IHPGPM(7)='CYAN' IHPGPM(8)='YELLOW' DO6060J=9,16 ITEMP=J-8 IHPGPM(J)=IHPGPM(ITEMP) 6060 CONTINUE END IF CCCCC END CHANGE WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') IF(IDMODE(I).EQ.'2622')GOTO6020 C MAY, 1990. CHANGE MESSAGE BASED ON 4 OR 8 PEN PLOTTERS. IF(IDMODE(I).EQ.'7221')WRITE(ICOUT,6001) 6001 FORMAT('HEWLETT-PACKARD 7221T') IF(IDMODE(I).EQ.'7221')CALL DPWRST('XXX','BUG ') IF(IDMODE(I).NE.'7221')WRITE(ICOUT,6002) 6002 FORMAT('HEWLETT-PACKARD WITH HP-GL') IF(IDMODE(I).NE.'7221')CALL DPWRST('XXX','BUG ') WRITE(ICOUT,6010) 6010 FORMAT('PEN SETTINGS--') CALL DPWRST('XXX','BUG ') C IF(IDMODE(I).NE.'7221')GOTO6070 WRITE(ICOUT,6011) 6011 FORMAT(12X,'PEN 1 = BLACK (3 MM)') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,6012) 6012 FORMAT(12X,'PEN 2 = RED (3 MM)') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,6013) 6013 FORMAT(12X,'PEN 3 = BLUE (3 MM)') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,6014) 6014 FORMAT(12X,'PEN 4 = GREEN (3 MM)') CALL DPWRST('XXX','BUG ') GOTO6090 C 6020 CONTINUE WRITE(ICOUT,6021) 6021 FORMAT('HEWLETT-PACKARD 26XX-TYPE TERMINAL') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,6022) 6022 FORMAT('INCLUDING 981X, 983X, 21X, 23X TERMINALS') CALL DPWRST('XXX','BUG ') GOTO6090 C 6070 CONTINUE DO6079J=1,IHPGCL WRITE(ICOUT,6072)J,IHPGPM(J) 6072 FORMAT('PEN ',I2,' = ',A8,'(3 MM)') CALL DPWRST('XXX','BUG ') 6079 CONTINUE GOTO6090 C 6090 CONTINUE GOTO8900 C C ***************************************** C ** TREAT THE HOUSTON INSTRUMENT CASE ** C ***************************************** C 6100 CONTINUE IDCONT(I)='ON' IDCOLO(I)='OFF' IDNHPP(I)=1000 IDNVPP(I)=1000 IDNVOF(I)=0 IDNHOF(I)=0 GOTO8900 C C ***************************** C ** TREAT THE SC4020 CASE ** C ***************************** C 6200 CONTINUE IDCONT(I)='ON' IDCOLO(I)='OFF' IDNHPP(I)=1000 IDNVPP(I)=1000 IDNVOF(I)=0 IDNHOF(I)=0 GOTO8900 C C ***************************** C ** TREAT THE SINGER CASE ** C ***************************** C 6300 CONTINUE IDCONT(I)='ON' IDCOLO(I)='OFF' IDNHPP(I)=1000 IDNVPP(I)=1000 IDNVOF(I)=0 IDNHOF(I)=0 GOTO8900 C C ******************************** C ** TREAT THE TEKTRONIX CASE ** C ******************************** C 6400 CONTINUE IDCONT(I)='ON' IDCOLO(I)='OFF' IF(IDMODE(I).EQ.'4027')IDCOLO(I)='ON' IF(IDMODE(I).EQ.'4105')IDCOLO(I)='ON' IF(IDMODE(I).EQ.'4107')IDCOLO(I)='ON' IF(IDMODE(I).EQ.'4109')IDCOLO(I)='ON' IF(IDMODE(I).EQ.'4115')IDCOLO(I)='ON' IF(IDMODE(I).EQ.'4107')IDCOLO(I)='ON' IF(IDMODE(I).EQ.'4109')IDCOLO(I)='ON' IF(IDMODE(I).EQ.'4113')IDCOLO(I)='ON' IF(IDMODE(I).EQ.'4115')IDCOLO(I)='ON' IF(IDMODE(I).EQ.'4662')IDCOLO(I)='ON' C IDNHPP(I)=4096 IDNVPP(I)=3124 IF(IDMODE(I).EQ.'4006')IDNHPP(I)=1024 IF(IDMODE(I).EQ.'4006')IDNVPP(I)=781 IF(IDMODE(I).EQ.'4010')IDNHPP(I)=1024 IF(IDMODE(I).EQ.'4010')IDNVPP(I)=781 IF(IDMODE(I).EQ.'4020')IDNHPP(I)=640 IF(IDMODE(I).EQ.'4020')IDNVPP(I)=480 IF(IDMODE(I).EQ.'4022')IDNHPP(I)=640 IF(IDMODE(I).EQ.'4022')IDNVPP(I)=480 IF(IDMODE(I).EQ.'4025')IDNHPP(I)=640 IF(IDMODE(I).EQ.'4025')IDNVPP(I)=480 IF(IDMODE(I).EQ.'4027')IDNHPP(I)=640 IF(IDMODE(I).EQ.'4027')IDNVPP(I)=480 IF(IDMODE(I).EQ.'4051')IDNHPP(I)=1024 IF(IDMODE(I).EQ.'4051')IDNVPP(I)=781 IF(IDMODE(I).EQ.'4052')IDNHPP(I)=1024 IF(IDMODE(I).EQ.'4052')IDNVPP(I)=781 CCCCC IF(IDMODE(I).EQ.'4105')IDNHPP(I)=480 CCCCC IF(IDMODE(I).EQ.'4105')IDNVPP(I)=360 CCCCC IF(IDMODE(I).EQ.'4107')IDNHPP(I)=480 CCCCC IF(IDMODE(I).EQ.'4107')IDNVPP(I)=360 CCCCC IF(IDMODE(I).EQ.'4109')IDNHPP(I)=480 CCCCC IF(IDMODE(I).EQ.'4109')IDNVPP(I)=360 IF(IDMODE(I).EQ.'4113')IDNHPP(I)=1000 IF(IDMODE(I).EQ.'4113')IDNVPP(I)=800 IF(IDMODE(I).EQ.'4115')IDNHPP(I)=1000 IF(IDMODE(I).EQ.'4115')IDNVPP(I)=800 IDNVOF(I)=0 IDNHOF(I)=0 CCCCC FOLLOWING LINES ADDED MARCH, 1990. IF(IDNHPP(I).EQ.4096)THEN IF(IORNSW.EQ.'PORT')THEN IDNHPP(I)=2414 IDNHOF(I)=841 ELSE IF(IORNSW.EQ.'SQUA')THEN IDNHPP(I)=3124 IDNHOF(I)=486 END IF ELSE IF(IDNHPP(I).EQ.1024)THEN IF(IORNSW.EQ.'PORT')THEN IDNHPP(I)=603 IDNHOF(I)=89 ELSE IF(IORNSW.EQ.'SQUA')THEN IDNHPP(I)=781 IDNHOF(I)=121 END IF ELSE IF(IDNHPP(I).EQ.640)THEN IF(IORNSW.EQ.'PORT')THEN IDNHPP(I)=371 IDNHOF(I)=54 ELSE IF(IORNSW.EQ.'SQUA')THEN IDNHPP(I)=480 IDNHOF(I)=80 END IF ELSE IF(IDNHPP(I).EQ.1000)THEN IF(IORNSW.EQ.'PORT')THEN IDNHPP(I)=618 IDNHOF(I)=191 ELSE IF(IORNSW.EQ.'SQUA')THEN IDNHPP(I)=800 IDNHOF(I)=100 END IF END IF IF(IDMODE(I).EQ.'4662')GOTO6410 GOTO6490 6410 CONTINUE WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,6411) 6411 FORMAT('TEKTRONIX 4662 MULTI-PEN PLOTTER') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,6412) 6412 FORMAT('PEN SETTINGS--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,6413) 6413 FORMAT(12X,'PEN 1 = BLACK (3.5 MM)') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,6414) 6414 FORMAT(12X,'PEN 2 = RED (3.5 MM)') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,6415) 6415 FORMAT(12X,'PEN 3 = BLUE (3.5 MM)') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,6416) 6416 FORMAT(12X,'PEN 4 = GREEN (3.5 MM)') CALL DPWRST('XXX','BUG ') 6490 CONTINUE GOTO8900 C C ***************************** C ** TREAT THE VARIAN CASE ** C ***************************** C 6500 CONTINUE IDCONT(I)='ON' IDCOLO(I)='OFF' IDNHPP(I)=1000 IDNVPP(I)=1000 IDNVOF(I)=0 IDNHOF(I)=0 GOTO8900 C C ************************************* C ** TREAT THE VECTOR GENERAL CASE ** C ************************************* C 6600 CONTINUE IDCONT(I)='ON' IDCOLO(I)='OFF' IDNHPP(I)=1000 IDNVPP(I)=1000 IDNVOF(I)=0 IDNHOF(I)=0 GOTO8900 C C ******************************* C ** TREAT THE VERSATEC CASE ** C ******************************* C 6700 CONTINUE IDCONT(I)='ON' IDCOLO(I)='OFF' IDNHPP(I)=1560 IDNVPP(I)=2080 IDNVOF(I)=0 IDNHOF(I)=0 GOTO8900 C C ******************************* C ** TREAT THE XYNETICS CASE ** C ******************************* C 6800 CONTINUE IDCONT(I)='ON' IDCOLO(I)='OFF' IDNHPP(I)=1000 IDNVPP(I)=1000 IDNVOF(I)=0 IDNHOF(I)=0 GOTO8900 C C *************************** C ** TREAT THE ZETA CASE ** C *************************** C 6900 CONTINUE IDCONT(I)='ON' IDCOLO(I)='OFF' IF(IZETCL.GT.0)IDCOLO(I)='ON' IDNHPP(I)=INT(1000.*11.) IDNVPP(I)=INT(1000.*8.5) IDNVOF(I)=0 IDNHOF(I)=0 IF(IORNSW.EQ.'PORT')THEN IDNHPP(I)=INT(1000.*8.5) IDNVPP(I)=INT(1000.*11.) IDNVOF(I)=0 IDNHOF(I)=0 ELSEIF(IORNSW.EQ.'SQUA')THEN IDNHPP(I)=INT(1000.*8.5) IDNVPP(I)=INT(1000.*8.5) IDNVOF(I)=0 IDNHOF(I)=0 ELSEIF(IORNSW.EQ.'LAN2')THEN IDNHPP(I)=INT(1000.*8.5) IDNVPP(I)=INT(1000.*11.) IDNVOF(I)=INT(1000.*((11.0-7.73)/2)) IDNHOF(I)=0 ELSEIF(IORNSW.EQ.'POST')THEN IDNHPP(I)=INT(1000.*30.) IDNVPP(I)=INT(1000.*30.) IDNVOF(I)=0 IDNHOF(I)=0 ENDIF C GOTO8900 C C *************************** C ** TREAT THE RAMTEK CASE** C *************************** C 7000 CONTINUE IDCONT(I)='ON' IDCOLO(I)='ON' IDNHPP(I)=1000 IDNVPP(I)=1000 IDNVOF(I)=0 IDNHOF(I)=0 GOTO8900 C C ****************************************************** C ** STEP 81-- ** C ** TREAT THE DEC REGIS CASE ** C ** REFERENCE--VT125 GRAPHICS TERMINAL USER GUIDE ** C ** PAGES 100 ** C ****************************************************** C 7100 CONTINUE IDCONT(I)='ON' IDCOLO(I)='OFF' IDNHPP(I)=768 IDNVPP(I)=480 IDNVOF(I)=0 IDNHOF(I)=0 IF(IORNSW.EQ.'PORT')THEN IDNHPP(I)=371 IDNHOF(I)=198 ELSE IF(IORNSW.EQ.'SQUA')THEN IDNHPP(I)=480 IDNHOF(I)=144 ELSE IF(IORNSW.EQ.'LAND')THEN IDNHPP(I)=621 IDNHOF(I)=73 ELSE IF(IORNSW.EQ.'LAN2')THEN IDNHPP(I)=621 IDNHOF(I)=73 END IF WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7102) 7102 FORMAT('DEC WITH REGIS') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7110) 7110 FORMAT('PICTURE POINTS--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7111)IDNHPP(I) 7111 FORMAT(12X,'HORIZONTAL = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7112)IDNVPP(I) 7112 FORMAT(12X,'VERTICAL = ',I8) CALL DPWRST('XXX','BUG ') GOTO8900 C C ****************************************************** C ** TREAT THE SUN CASE ** C ****************************************************** C 7200 CONTINUE IDCONT(I)='ON' IDCOLO(I)='OFF' IDUMMY=0 CSUN CALL isitcolor(IDUMMY) ISUNCL=IDUMMY IF(ISUNCL.GT.0)IDCOLO(I)='ON' IDNHPP(I)=10000 IDNVPP(I)=10000 IDNVOF(I)=0 IDNHOF(I)=0 GOTO8900 C C ****************************************************** C ** TREAT THE PCL CASE ** C ****************************************************** C 7300 CONTINUE IDCONT(I)='ON' IDCOLO(I)='OFF' IDNHPP(I)=(11.*PCLPPI)-(IPCLLM+IPCLRM) IDNVPP(I)=(8.5*PCLPPI)-(IPCLTM+IPCLBM) IF(IORNSW.EQ.'PORT')IDNHPP(I)=(8.5*PCLPPI)-(IPC2LM+IPC2RM) IF(IORNSW.EQ.'PORT')IDNVPP(I)=(11.*PCLPPI)-(IPC2TM+IPC2BM) IDNVOF(I)=0 IDNHOF(I)=0 GOTO8900 C ****************************************************** C ** TREAT THE QUIC CASE ** C ****************************************************** C 7400 CONTINUE IDCONT(I)='ON' IDCOLO(I)='OFF' IDNHPP(I)=(11.*QUIPPI)-(IQUILM+IQUIRM) IDNVPP(I)=(8.5*QUIPPI)-(IQUITM+IQUIBM) IF(IORNSW.EQ.'PORT')IDNHPP(I)=(8.5*QUIPPI)-(IQU2LM+IQU2RM) IF(IORNSW.EQ.'PORT')IDNVPP(I)=(11.*QUIPPI)-(IQU2TM+IQU2BM) IDNVOF(I)=IQUITM IDNHOF(I)=IQUILM IF(IORNSW.EQ.'PORT')IDNVOF(I)=IQU2TM IF(IORNSW.EQ.'PORT')IDNHOF(I)=IQU2LM GOTO8900 C C ****************************************************** C ** TREAT THE POSTSCRIPT CASE ** C ****************************************************** C C NOVEMBER, 1990 BUG FIX. SET OFFSETS TO 0 (WERE GETTING DOUBLE COUNTED). C ALSO FIXED GRINDE, GRERSC. C 7500 CONTINUE IDCONT(I)='ON' IDCOLO(I)='OFF' CCCCC JUNE 2004: ADD FOLLOWING LINE. SET POSTSCRIPT DEFAULT CCCCC COLOR DETERMINES IF DEVICE INITIALIZES CCCCC IN COLOR. C IF(IPSTDC.EQ.'ON')IDCOLO(I)='ON' IDNHPP(I)=(11.*PSTPPI)-(IPSTLM+IPSTRM) IDNVPP(I)=(8.5*PSTPPI)-(IPSTTM+IPSTBM) IF(IORNSW.EQ.'PORT')THEN IDNHPP(I)=(8.5*PSTPPI)-(IPS2LM+IPS2RM) IDNVPP(I)=(11.*PSTPPI)-(IPS2TM+IPS2BM) ELSEIF(IORNSW.EQ.'LAN2')THEN IDNHPP(I)=(8.5*PSTPPI)-(IPSTLM+IPSTRM) IDNVPP(I)=(6.5*PSTPPI)-(IPSTTM+IPSTBM) ELSEIF(IORNSW.EQ.'SQUA')THEN IDNHPP(I)=(8.5*PSTPPI)-(IPSTLM+IPSTRM) IDNVPP(I)=(8.5*PSTPPI)-(IPSTTM+IPSTBM) ENDIF IDNVOF(I)=0 IDNHOF(I)=0 GOTO8900 C C ****************************************************** C ** TREAT THE X11 CASE ** C ** ACTUAL PICTURE POINTS CAN VARY (BOTH BECAUSE ** C ** DIFFERENT WORKSTATIONS SUPPORTED AND BECAUSE ** C ** RESIDENT WINDOW MANAGER CAN MODIFY REQUESTED ** C ** PICTURE POINTS. SET TO 0 HERE (THE X11 C LIBRARY* C ** WILL SET DEFAULT VALUES. USER CAN SPECIFY A ** C ** SUGGESTED SIZE VIA DEVICE .. PICTURE POINTS. ** C ** THE X11 C LIBRARY WILL QUERY THE COLOR ** C ** CAPABILITY OF THE SPECIFIC WORKSTATION. ** C ****************************************************** C 7600 CONTINUE IDCONT(I)='ON' IDCOLO(I)='ON' IDNHPP(I)=0 IDNVPP(I)=0 IDNVOF(I)=0 IDNHOF(I)=0 GOTO8900 C C ************************************************* C ** TREAT THE VGA VIA TURBO-C CASE ** C ** REFERENCE--TURBO C 1.5 ADDITIONS & ** C ** ENHANCEMENTS, PAGE 105. ** C ** REFERENCE--TURBO C 2.0 REFERENCE GUIDE, ** C ** PAGE 200. ** C ************************************************* C 7700 CONTINUE IDCONT(I)='ON' IDCOLO(I)='ON' IDNHPP(I)=640 IDNVPP(I)=480 IDNVOF(I)=0 IDNHOF(I)=0 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7702) 7702 FORMAT('TURBO-C/VGA') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7710) 7710 FORMAT('PICTURE POINTS--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7711)IDNHPP(I) 7711 FORMAT(12X,'HORIZONTAL = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7712)IDNVPP(I) 7712 FORMAT(12X,'VERTICAL = ',I8) CALL DPWRST('XXX','BUG ') GOTO8900 C C ************************************************* C ** TREAT THE LAHEY CASE ** C ** REFERENCE--LAHEY REFERENCE MANUAL ** C ************************************************* C 7800 CONTINUE IF(IDMODE(I).EQ.'INTE')GOTO7820 IF(IDMODE(I).EQ.'WINT')GOTO7830 C IDCONT(I)='ON' IDCOLO(I)='ON' IDNHPP(I)=640 IDNVPP(I)=480 IDNVOF(I)=0 IDNHOF(I)=0 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7802) 7802 FORMAT('LAHEY ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7810) 7810 FORMAT('PICTURE POINTS--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7811)IDNHPP(I) 7811 FORMAT(12X,'HORIZONTAL = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7812)IDNVPP(I) 7812 FORMAT(12X,'VERTICAL = ',I8) CALL DPWRST('XXX','BUG ') GOTO8900 C 7820 CONTINUE IDCONT(I)='ON' IDCOLO(I)='ON' IDNHPP(I)=800 IDNVPP(I)=600 IDNVOF(I)=0 IDNHOF(I)=0 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7821) 7821 FORMAT('LAHEY (INTERACTOR) ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7823) 7823 FORMAT('PICTURE POINTS--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7825)IDNHPP(I) 7825 FORMAT(12X,'HORIZONTAL = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7827)IDNVPP(I) 7827 FORMAT(12X,'VERTICAL = ',I8) CALL DPWRST('XXX','BUG ') GOTO8900 C 7830 CONTINUE IDCONT(I)='ON' IDCOLO(I)='ON' IDNHPP(I)=1000 IDNVPP(I)=1000 IDNVOF(I)=0 IDNHOF(I)=0 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7831) 7831 FORMAT('LAHEY (INTERACTOR) ') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7833) 7833 FORMAT('PICTURE POINTS--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7835)IDNHPP(I) 7835 FORMAT(12X,'HORIZONTAL = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7837)IDNVPP(I) 7837 FORMAT(12X,'VERTICAL = ',I8) CALL DPWRST('XXX','BUG ') GOTO8900 C C ************************************************* C ** TREAT THE MICROSOFT QWIN CASE ** C ** REFERENCE--MICROSOFT FORTRAN MANUAL ** C ************************************************* C 7900 CONTINUE IDCONT(I)='ON' IDCOLO(I)='ON' IDNHPP(I)=-1 IDNVPP(I)=-1 IDNVOF(I)=0 IDNHOF(I)=0 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7902) 7902 FORMAT('MICROSOFT QUICK-WIN DRIVER') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7910) 7910 FORMAT('PICTURE POINTS--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7911)IDNHPP(I) 7911 FORMAT(12X,'HORIZONTAL = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,7912)IDNVPP(I) 7912 FORMAT(12X,'VERTICAL = ',I8) CALL DPWRST('XXX','BUG ') GOTO8900 C C ************************************************* C ** TREAT THE GKS CASE ** C ************************************************* C 8000 CONTINUE IDCONT(I)='ON' IDCOLO(I)='ON' IDNHPP(I)=1000 IDNVPP(I)=1000 IDNVOF(I)=0 IDNHOF(I)=0 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8002) 8002 FORMAT('TURBO-C/VGA') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8010) 8010 FORMAT('PICTURE POINTS--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8011)IDNHPP(I) 8011 FORMAT(12X,'HORIZONTAL = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8012)IDNVPP(I) 8012 FORMAT(12X,'VERTICAL = ',I8) CALL DPWRST('XXX','BUG ') GOTO8900 C C ************************************************* C ** TREAT THE PC PRINTER CASE ** C ************************************************* C 8100 CONTINUE IDCONT(I)='ON' IDCOLO(I)='ON' IDNHPP(I)=1000 IDNVPP(I)=1000 IDNVOF(I)=0 IDNHOF(I)=0 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8102) 8102 FORMAT('TURBO-C/VGA') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8110) 8110 FORMAT('PICTURE POINTS--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8111)IDNHPP(I) 8111 FORMAT(12X,'HORIZONTAL = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8112)IDNVPP(I) 8112 FORMAT(12X,'VERTICAL = ',I8) CALL DPWRST('XXX','BUG ') GOTO8900 C 8900 CONTINUE IFOUN2='YES' GOTO9000 C C ************************************************* C ** TREAT THE GD CASE ** C ************************************************* C 8200 CONTINUE IDCONT(I)='ON' IDCOLO(I)='ON' IDNHPP(I)=600 IDNVPP(I)=465 IDNVOF(I)=0 IDNHOF(I)=0 IF(IORNSW.EQ.'PORT')THEN IDNHPP(I)=465 IDNVPP(I)=600 ELSEIF(IORNSW.EQ.'LAN2')THEN IDNHPP(I)=465 IDNVPP(I)=360 IDNVOF(I)=220 IDNHOF(I)=0 ELSEIF(IORNSW.EQ.'SQUA')THEN IDNHPP(I)=465 IDNVPP(I)=465 IDNVOF(I)=0 IDNHOF(I)=0 ENDIF IDFONT(I)='SIMP' WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8202)IDMODE(I) 8202 FORMAT('GD LIBRARY--',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8210) 8210 FORMAT('PICTURE POINTS--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8211)IDNHPP(I) 8211 FORMAT(12X,'HORIZONTAL = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8212)IDNVPP(I) 8212 FORMAT(12X,'VERTICAL = ',I8) CALL DPWRST('XXX','BUG ') GOTO8290 C 8290 CONTINUE IFOUN2='YES' GOTO9000 C C ************************************************* C ** TREAT THE OPEN-GL CASE ** C ************************************************* C 8300 CONTINUE IDCONT(I)='ON' IDCOLO(I)='ON' IDNHPP(I)=600 IDNVPP(I)=450 IDNVOF(I)=0 IDNHOF(I)=0 IF(IORNSW.EQ.'PORT')THEN IDNHPP(I)=450 IDNVPP(I)=600 ELSEIF(IORNSW.EQ.'LAN2')THEN IDNHPP(I)=450 IDNVPP(I)=350 IDNVOF(I)=125 IDNHOF(I)=0 ENDIF WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8302) 8302 FORMAT('OPEN-GL (BASED ON f90gl)') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8310) 8310 FORMAT('PICTURE POINTS--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8311)IDNHPP(I) 8311 FORMAT(12X,'HORIZONTAL = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8312)IDNVPP(I) 8312 FORMAT(12X,'VERTICAL = ',I8) CALL DPWRST('XXX','BUG ') GOTO8390 C 8390 CONTINUE IFOUN2='YES' GOTO9000 C C **************************************************** C ** TREAT THE LATEX CASE-- ** C ** USE 72 DPI COORDINATE SCALE STARTING FROM ** C ** LOWER LEFT CORNER. SUPPORT PORTRAIT AND ** C ** LANDSCAPE WORDPERFECT OPTIONS. REGULAR ** C ** LANDSCAPE MODE WILL BE TREATED SAME AS ** C ** LANDSCAPE WORDPERFECT (I.E., LANDSCAPE ** C ** MODE IN A PORTRAIT PAGE). ** C **************************************************** C 8400 CONTINUE C C NOTE: IF CAPTURE SWITCH IS ON AND THIS IS DEVICE 1, THEN C SET IGUNIT EQUAL TO CAPTURE FILE. C IFLAG9=0 IF(I.EQ.1 .AND. IPR.EQ.ICAPNU)THEN IGUNIT=ICAPNU IFLAG9=1 ENDIF IDNVOF(I)=0 IDNHOF(I)=0 ADOTPI=300.0 IF(IORNSW.EQ.'PORT')THEN IDNHPP(I)=6.25*ADOTPI IDNVPP(I)=9.0*ADOTPI ELSEIF(IORNSW.EQ.'LAND')THEN IDNHPP(I)=6.25*ADOTPI IDNVPP(I)=(6.25*ADOTPI)*(8.5/11.0) ELSEIF(IORNSW.EQ.'LAN2')THEN IDNHPP(I)=6.25*ADOTPI IDNVPP(I)=(6.25*ADOTPI)*(8.5/11.0) ELSEIF(IORNSW.EQ.'SQUA')THEN IDNHPP(I)=6.0*ADOTPI IDNVPP(I)=6.0*ADOTPI ELSE IDNHPP(I)=6.25*ADOTPI IDNVPP(I)=(6.25*ADOTPI)*(8.5/11.0) ENDIF IF(IFLAG9.EQ.0)THEN WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8402)IDMODE(I) 8402 FORMAT('LATEX (USING EPIC/EEPIC/GRAPHICS)--',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8410) 8410 FORMAT('PICTURE POINTS--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8411)IDNHPP(I) 8411 FORMAT(12X,'HORIZONTAL = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8412)IDNVPP(I) 8412 FORMAT(12X,'VERTICAL = ',I8) CALL DPWRST('XXX','BUG ') ENDIF GOTO8490 C 8490 CONTINUE IFOUN2='YES' GOTO9000 C C **************************************************** C ** TREAT THE SVG (SCALABLE VECTOR GRAPHICS CASE) ** C **************************************************** C 8500 CONTINUE IDCONT(I)='ON' IDCOLO(I)='ON' IDNHPP(I)=600 IDNVPP(I)=465 IDNVOF(I)=0 IDNHOF(I)=0 IF(IORNSW.EQ.'PORT')THEN IDNHPP(I)=465 IDNVPP(I)=600 ELSEIF(IORNSW.EQ.'LAN2')THEN IDNHPP(I)=465 IDNVPP(I)=360 IDNVOF(I)=220 IDNHOF(I)=0 ENDIF WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8502)IDMODE(I) 8502 FORMAT('SCALABLE VECTOR GRAPHICS (SVG)--',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8510) 8510 FORMAT('PICTURE POINTS--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8511)IDNHPP(I) 8511 FORMAT(12X,'HORIZONTAL = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8512)IDNVPP(I) 8512 FORMAT(12X,'VERTICAL = ',I8) CALL DPWRST('XXX','BUG ') GOTO8590 C 8590 CONTINUE IFOUN2='YES' GOTO9000 C C **************************************************** C ** TREAT THE AQUATERM (MAC OSX) CASE ** C **************************************************** C 8600 CONTINUE IDCONT(I)='ON' IDCOLO(I)='ON' IDNHPP(I)=600 IDNVPP(I)=450 IDNVOF(I)=0 IDNHOF(I)=0 IF(IORNSW.EQ.'PORT')THEN IDNHPP(I)=450 IDNVPP(I)=600 ELSEIF(IORNSW.EQ.'LAN2')THEN IDNHPP(I)=450 IDNVPP(I)=350 IDNVOF(I)=125 IDNHOF(I)=0 ELSEIF(IORNSW.EQ.'SQUA')THEN IDNHPP(I)=450 IDNVPP(I)=450 IDNVOF(I)=0 IDNHOF(I)=0 ENDIF WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8602) 8602 FORMAT('AQUATERM (FOR MAC OSX)') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8610) 8610 FORMAT('PICTURE POINTS--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8611)IDNHPP(I) 8611 FORMAT(12X,'HORIZONTAL = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,8612)IDNVPP(I) 8612 FORMAT(12X,'VERTICAL = ',I8) CALL DPWRST('XXX','BUG ') GOTO5190 C 8690 CONTINUE IFOUN2='YES' GOTO9000 C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE RETURN END SUBROUTINE GRSESI(ICASE,IFONT,PHEIGH,PWIDTH,PVEGAP,PHOGAP, 1JSIZE, 1JHEIG2,JWIDT2,JVEGA2,JHOGA2, 1PHEIG2,PWIDT2,PVEGA2,PHOGA2) C C PURPOSE--FOR A LINE, REGION, MARKER, OR TEXT, C SET A SIZE (E.G., A CHARACTER SIZE) C (HEIGHT, WIDTH, C VERTICAL GAP, HORIZONTAL GAP9 C GIVEN IN (0.0 TO 100.0) REPRESENTATION C INTO AN INTEGER NUMERIC REPRESENTATION (IN JSIZE) C THAT WILL BE UNDERSTOOD BY THE TEKTRONIX C GRAPHICS DEVICE BEING USED. C ALSO, CREATE OTHER VARIABLES WHICH CONTAIN C THE CLOSEST ALLOWABLE SIZES C (IN 0.0 TO 100.0 UNITS) THAT IS PERMITTED ON C THE TEKTRONIX GRAPHICS DEVICE BEING USED. C C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PVONE--301-921-3651 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL BUREAU OF STANDARDS. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--83.6 C ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY 1983. C UPDATED --JANUARY 1989. SUN (BY BILL ANDERSON) C DRIVER OBSOLETE C UPDATED --JANUARY 1989. POSTSCRIPT (BY ALAN HECKERT) C UPDATED --JANUARY 1989. CGM (BY ALAN HECKERT) C UPDATED --JANUARY 1989. QMS QUIC (BY ALAN HECKERT) C UPDATED --JANUARY 1989. CALCOMP (BY ALAN HECKERT) C UPDATED --JANUARY 1989. ZETA (BY ALAN HECKERT) C UPDATED --MARCH 1990. X11 (BY ALAN HECKERT) C UPDATED --MARCH 1991. REGIS FIX (BY ALAN HECKERT) C UPDATED --MAY 1991. RENUMBER TOP BRANCHES (JJF) C UPDATED --MAY 1991. VGA/TURBOC DRIVER (JJF) C DRIVER OBSOLETE C UPDATED --JULY 1996. LAHEY DRIVER (ALAN HECKERT) C OLD STYLE CALCOMP C DRIVER OBSOLETE C UPDATED --OCTOBER 1996. QUICKWIN DRIVER (ALAN) C UPDATED --OCTOBER 1996. OPENGL DRIVER (ALAN) C USE BILL MITCHELLS OPENGL C BINDING FOR FORTRAN C UPDATED --OCTOBER 1996. GKS (ALAN) C CODED, NOT TESTED C UPDATED --OCTOBER 1996. BINARY CGM (ALAN) C PLACEHOLDER FOR NOW C UPDATED --OCTOBER 1996. DISPLAY POSTSCRIPT (ALAN) C PLACEHOLDER FOR NOW C UPDATED --OCTOBER 1997. LAHEY INTERACTOR (ALAN) C UPDATED --JULY 1998. LAHEY WINTERACTOR C UPDATED --JUNE 2000. GD (FOR JPEG, PNG, WINDOWS BMP) C UPDATED --JUNE 2000. MACINTOSH C PLACEHOLDER FOR NOW C UPDATED --JUNE 2000. PC PRINTER C PLACEHOLDER FOR NOW C UPDATED --MARCH 2005. SUPPORT FOR AQUATERM C UPDATED --FEBRUARY 2006. SUPPORT FOR LATEX C C-----NON-COMMON VARIABLES (GRAPHICS)------------------------------------------- C CWINT USE WINTERACTER CINTE USE INTERACTER CCCCC FOLLOWING LINES FOR MICROSOFT FORTRAN OCTOBER 1996 CQWIN USE DFLIB CIVFO USE IFQWIN CQWVF TYPE(FONTINFO) MSFONT CQWVF TYPE (WINDOWCONFIG) DPSCREEN CQWVF CHARACTER*4 QWSCRN CQWVF COMMON/QUICKWN/DPSCREEN,QWSCRN,IQWNFT,IQWNFN CHARACTER*1 IQUOTE C CHARACTER*4 ICASE CHARACTER*4 IFONT C CHARACTER*130 ICSTR CHARACTER*4 ISUBN0 C C-----COMMON---------------------------------------------------------- C INCLUDE 'DPCOGR.INC' INCLUDE 'DPCONP.INC' INCLUDE 'DPCOBE.INC' INCLUDE 'DPCODV.INC' C C-----COMMON VARIABLES (GENERAL)-------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C CALL DPCONA(39,IQUOTE) ISUBN0='SESI' C NCSTR=(-999) C IERRG4='NO' C PVETO2=(-999.0) PHOTO2=(-999.0) C IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'SESI')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF GRSESI--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)ICASE,IFONT 52 FORMAT('ICASE,IFONT = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)PHEIGH,PWIDTH,PVEGAP,PHOGAP 53 FORMAT('PHEIGH,PWIDTH,PVEGAP,PHOGAP = ',4E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,54)JSIZE 54 FORMAT('JSIZE = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,55)JHEIG2,JWIDT2,JVEGA2,JHOGA2 55 FORMAT('JHEIG2,JWIDT2,JVEGA2,JHOGA2 = ',4I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,56)PHEIG2,PWIDT2,PVEGA2,PHOGA2 56 FORMAT('PHEIG2,PWIDT2,PVEGA2,PHOGA2 = ',4E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,57)IMANUF,IMODEL 57 FORMAT('IMANUF,IMODEL = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,59)IBUGG4 59 FORMAT('IBUGG4 = ',A4) CALL DPWRST('XXX','BUG ') 90 CONTINUE C C ******************************************** C ** STEP 1-- ** C ** BRANCH ACCORDING TO THE MANUFACTURER ** C ** AND THE MODEL ** C ******************************************** C IF(IMANUF.EQ.'TEKT')GOTO1005 IF(IMANUF.EQ.'HP')GOTO1010 IF(IMANUF.EQ.'PCL')GOTO1015 IF(IMANUF.EQ.'GENE')GOTO1020 IF(IMANUF.EQ.'CALC')GOTO1025 IF(IMANUF.EQ.'ZETA')GOTO1030 IF(IMANUF.EQ.'RAMT')GOTO1035 IF(IMANUF.EQ.'SUN ')GOTO1040 IF(IMANUF.EQ.'XXXX')GOTO1045 IF(IMANUF.EQ.'REGI')GOTO1050 IF(IMANUF.EQ.'POST')GOTO1055 IF(IMANUF.EQ.'QUIC')GOTO1060 IF(IMANUF.EQ.'X11 ')GOTO1065 IF(IMANUF.EQ.'TURB')GOTO1070 IF(IMANUF.EQ.'GKS ')GOTO1075 IF(IMANUF.EQ.'LAHE')GOTO1080 IF(IMANUF.EQ.'GD ')GOTO1085 IF(IMANUF.EQ.'QWIN')GOTO1090 IF(IMANUF.EQ.'AQUA')GOTO1091 IF(IMANUF.EQ.'OPGL')GOTO1095 IF(IMANUF.EQ.'PRIN')GOTO1096 IF(IMANUF.EQ.'LATE')GOTO1097 IF(IMANUF.EQ.'MACI')GOTO1098 GOTO9000 C 1005 CONTINUE IF(IMODEL.EQ.'4012')GOTO1100 IF(IMODEL.EQ.'4013')GOTO1100 IF(IMODEL.EQ.'4014')GOTO1100 IF(IMODEL.EQ.'4015')GOTO1100 IF(IMODEL.EQ.'4016')GOTO1100 C IF(IMODEL.EQ.'4054')GOTO1100 C IF(IMODEL.EQ.'4113')GOTO1100 IF(IMODEL.EQ.'4114')GOTO1100 C IF(IMODEL.EQ.'4662')GOTO1200 C GOTO9000 C 1010 CONTINUE IF(IMODEL.EQ.'2622')GOTO2300 IF(IMODEL.EQ.'2623')GOTO2300 IF(IMODEL.EQ.'2627')GOTO2300 IF(IMODEL.EQ.'2647')GOTO2300 IF(IMODEL.EQ.'7221')GOTO2100 GOTO2200 C 1015 CONTINUE GOTO2600 C 1020 CONTINUE IF(IMODEL.EQ.'CODE')GOTO3200 IF(IMODEL.EQ.'CGM')GOTO3300 IF(IMODEL.EQ.'CGMB')GOTO3400 GOTO3100 C 1025 CONTINUE GOTO4100 C 1030 CONTINUE GOTO5100 C 1035 CONTINUE GOTO6100 C 1040 CONTINUE GOTO6600 C 1045 CONTINUE GOTO7100 C 1050 CONTINUE GOTO8100 C 1055 CONTINUE IF(IMODEL.EQ.'DISP')GOTO8900 GOTO8600 C 1060 CONTINUE GOTO9100 C 1065 CONTINUE GOTO9600 C 1070 CONTINUE GOTO10000 C 1075 CONTINUE GOTO11000 C 1080 CONTINUE IF(IMODEL.EQ.'INTE')GOTO4900 IF(IMODEL.EQ.'WINT')GOTO4950 GOTO4600 C 1085 CONTINUE IF(IMODEL.EQ.'JPEG')GOTO12000 IF(IMODEL.EQ.'PNG ')GOTO12000 IF(IMODEL.EQ.'WBMP')GOTO12000 IF(IMODEL.EQ.'GIF')GOTO12000 GOTO12000 C 1090 CONTINUE GOTO4700 C 1091 CONTINUE GOTO13500 C 1095 CONTINUE GOTO4800 C 1096 CONTINUE GOTO14000 C 1097 CONTINUE GOTO15000 C 1098 CONTINUE GOTO13000 C C **************************************************************** C ** STEP 11-- C ** TREAT THE TEKTRONIX 4012, 4013, 4014, 4016, 4054, AND 4114 C ** (THESE ARE ALL NON-COLOR (= MONOCHROME) DEVICES C ** WHICH ARE LARGE SCREEN AND SO HAVE C ** 4 CHARCTER SIZES.) C ** REFERENCE--XXX C **************************************************************** C 1100 CONTINUE CCCCC IF(JSIZE.EQ.1)WRITE(IGUNIT,1111)IESCC C1111 FORMAT(A1,';') CCCCC IF(JSIZE.EQ.2)WRITE(IGUNIT,1112)IESCC C1112 FORMAT(A1,':') CCCCC IF(JSIZE.EQ.3)WRITE(IGUNIT,1113)IESCC C1113 FORMAT(A1,'9') CCCCC IF(JSIZE.EQ.4)WRITE(IGUNIT,1114)IESCC C1114 FORMAT(A1,'8') ICSTR(1:1)=IESCC ICSTR(2:2)=';' CCCCC IF(JSIZE.EQ.1)ICSTR(2:2)=';' IF(JSIZE.EQ.2)ICSTR(2:2)=':' IF(JSIZE.EQ.3)ICSTR(2:2)='9' IF(JSIZE.EQ.4)ICSTR(2:2)='8' NCSTR=2 CALL GRWRST(ICSTR,NCSTR,ISUBN0) GOTO9000 C C **************************************************************** C ** STEP 12-- C ** TREAT THE TEKTRONIX 4662 PENPLOTTER CASE ** C ** REFERENCE--XXX C **************************************************************** C 1200 CONTINUE CCCCC IF(JSIZE.EQ.1)WRITE(IGUNIT,1211)IESCC C1211 FORMAT(A1,'AI31,48') CCCCC IF(JSIZE.EQ.2)WRITE(IGUNIT,1212)IESCC C1212 FORMAT(A1,'AI34,53') CCCCC IF(JSIZE.EQ.3)WRITE(IGUNIT,1213)IESCC C1213 FORMAT(A1,'AI51,82') CCCCC IF(JSIZE.EQ.4)WRITE(IGUNIT,1214)IESCC C1214 FORMAT(A1,'AI56,88') ICSTR(1:1)=IESCC ICSTR(2:8)='AI31,48' CCCCC IF(JSIZE.EQ.1)ICSTR(2:8)='AI31,48' IF(JSIZE.EQ.2)ICSTR(2:8)='AI34,53' IF(JSIZE.EQ.3)ICSTR(2:8)='AI51,82' IF(JSIZE.EQ.4)ICSTR(2:8)='AI56,88' NCSTR=8 CALL GRWRST(ICSTR,NCSTR,ISUBN0) GOTO9000 C C ****************************************************** C ** STEP 21-- ** C ** TREAT THE HEWLETT-PACKARD 7221 CASE ** C ** (MULTI-COLOR PENPLOTTER) ** C ** TO SET SIZE-- ** C ** USE THE TILDA PERCENT (= LABEL SIZE) INSTRUCTION * C ** AND PACKED BINARY COORDINATES, ** C ** (WITH TRAILING RIGHT CURLY BRACKET WHICH ARE THE** C ** DEFAULT NO-OP END-OF-INSTRUCTION TERMINATOR). ** C ** REFERENCE--HP 7221A GRAPHICS PLOTTER ** C ** OPERATING AND PROGRAMMING MANUAL, ** C ** PAGE 119-121. ** C ****************************************************** C 2100 CONTINUE ICSTR(1:2)='~%' NCSTR=2 PVETO2=PHEIG2+PVEGA2 PHOTO2=PWIDT2+PHOGA2 CALL GRTRSD(PHOTO2,PVETO2,IX,IY,ISUBN0) CALL HPTRPT(IX,IY,ICSTR,NCSTR,ISUBN0) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) 2190 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 22-- ** C ** TREAT THE HEWLETT-PACKARD HP-GL CASES ** C ** (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS) ** C ** (MULTI-COLOR PENPLOTTERS) ** C ** TO SET SIZE-- ** C ** USE THE SR (= REL CHAR SIZE) INSTRUCTION ** C ** ALONG WITH FLOATING POINT COORDINATES, ** C ** (WITH TRAILING SEMI-COLONS WHICH ARE THE ** C ** DEFAULT NO-OP END-OF-INSTRUCTION TERMINATOR). ** C ** REFERENCE--HP 9872C GRAPHICS PLOTTER ** C ** OPERATING AND PROGRAMMING MANUAL, ** C ** PAGE 84-85, 144. ** C ****************************************************** C 2200 CONTINUE CCCCC WRITE(IGUNIT,2211)PWIDT2,PHEIG2 C2211 FORMAT('SR',F10.1,',',F10.1,';') ICSTR(1:2)='SR' NCSTR=2 NCHTOT=10 NCHDEC=1 CALL GRTRRE(PWIDT2,NCHTOT,NCHDEC,ICSTR,NCSTR) ICSTR(13:13)=',' NCSTR=13 CALL GRTRRE(PHEIG2,NCHTOT,NCHDEC,ICSTR,NCSTR) ICSTR(24:24)=';' NCSTR=24 CALL GRWRST(ICSTR,NCSTR,ISUBN0) 2290 CONTINUE GOTO9000 C C ********************************************************** C ** STEP 23-- ** C ** TREAT THE HEWLETT-PACKARD HP-2622 CASES ** C ** (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS) ** C ** (MONOCHROME DISPLAY TERMINALS) ** C ** REFERENCE--HP 2322C GRAPHICS PLOTTER ** C ** REFERENCE MANUAL, ** C ** PAGE 10-19, XXX. ** C ********************************************************** C 2300 CONTINUE C NEEDS MORE WORK FOR FULL 8 SIZES ICSTR(1:1)=IESCC ICSTR(2:6)='*m1mZ' IF(PHEIG2.GT.3.0)ICSTR(2:6)='*m2mZ' IF(PHEIG2.GT.6.0)ICSTR(2:6)='*m3mZ' IF(PHEIG2.GT.9.0)ICSTR(2:6)='*m4mZ' IF(PHEIG2.GT.11.0)ICSTR(2:6)='*m5mZ' IF(PHEIG2.GT.14.0)ICSTR(2:6)='*m6mZ' IF(PHEIG2.GT.17.0)ICSTR(2:6)='*m8mZ' NCSTR=6 CALL GRWRST(ICSTR,NCSTR,ISUBN0) GOTO9000 C C ********************************************************** C ** STEP 26-- ** C ** TREAT THE HEWLETT-PACKARD PCL CASES ** C ** HP LASERJET LASER PRINTERS ** C ** SIZE DETERMINED BY WHICH OF THE 3 BUILT IN FONTS ARE** C ** USED. CURRENTLY NO SUPPORT FOR DOWNLOADABLE FONTS ** C ** 1. COURIER MEDIUM (DEFAULT) - 12 PT, 10 CPI ** C ** 2. COURIER BOLD - 12 PT, 10 CPI ** C ** 3. CONDENSED LINE PRINTER - 8.5 PT, 16.66 CPI ** C ** POINT SIZE - ESC (sV ** C ** CPI - ESC (sH ** C ** REFERENCE--HP SERIES II LASER JET TECHNICAL ** C ** REFERENCE MANUAL, ** C ** PAGE ** C ********************************************************** C 2600 CONTINUE ICSTR(1:1)=IESCC IF(IPCLFN.EQ.'COND')GOTO2610 C C COURIER MEDIUM, COURIER BOLD CASE C ICSTR(2:6)='(s12V' ICSTR(7:7)=IESCC ICSTR(8:12)='(s10H' NCSTR=12 GOTO2690 C C CONDENSED LINE PRINTER CASE C 2610 CONTINUE ICSTR(2:7)='(s8.5V' ICSTR(8:8)=IESCC ICSTR(9:16)='(s16.66H' NCSTR=16 GOTO2690 C 2690 CONTINUE CALL GRWRST(ICSTR,NCSTR,ISUBN0) GOTO9000 C C ****************************************************** C ** STEP 31-- ** C ** TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE ** C ****************************************************** C 3100 CONTINUE CCCCC WRITE(IGUNIT,3111)PHEIGH,PWIDTH C3111 FORMAT('SET SIZE CHARACTERS ',F10.5,2X,F10.5) ICSTR(1:20)='SET SIZE CHARACTERS ' NCSTR=20 NCHTOT=10 NCHDEC=5 CALL GRTRRE(PHEIGH,NCHTOT,NCHDEC,ICSTR,NCSTR) ICSTR(31:32)=' ' NCSTR=32 CALL GRTRRE(PWIDTH,NCHTOT,NCHDEC,ICSTR,NCSTR) CALL GRWRST(ICSTR,NCSTR,ISUBN0) GOTO9000 C C *************************************************************** C ** STEP 32-- ** C ** TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE ** C *************************************************************** C 3200 CONTINUE ICSTR(1:5)='SESI ' NCSTR=5 NCHTOT=10 NCHDEC=5 CALL GRTRRE(PHEIGH,NCHTOT,NCHDEC,ICSTR,NCSTR) ICSTR(16:17)=' ' NCSTR=17 CALL GRTRRE(PWIDTH,NCHTOT,NCHDEC,ICSTR,NCSTR) CALL GRWRST(ICSTR,NCSTR,ISUBN0) GOTO9000 C C *************************************************************** C ** STEP 33-- ** C ** TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE ** C *************************************************************** C 3300 CONTINUE ICSTR(1:11)='CHARHEIGHT ' NCSTR=10 NCHTOT=10 NCHDEC=5 CALL GRTRRE(PHEIGH,NCHTOT,NCHDEC,ICSTR,NCSTR) ICSTR(22:22)=';' NCSTR=22 CALL GRWRST(ICSTR,NCSTR,ISUBN0) GOTO9000 C C *************************************************** C ** STEP 34-- ** C ** TREAT THE CGM (BINARY) CASE ** C *************************************************** C 3400 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 41-- ** C ** TREAT THE CALCOMP XXXXXX CASE ** C ** TO SET SIZE-- ** C ** WRITE OUT AN XXXXXXXXXX ** C ** (NOT DONE) ** C ** REFERENCE--XX ** C ** XX ** C ** PAGES XX AND XX ** C ** USE CALCOMP LIBRARY. SIZE SENT TO "SYMBOL" ** C ** SUBROUTINE IN "GRWRTH" AND "GRWRTV". ** C ****************************************************** C 4100 CONTINUE CCCCC WRITE(IGUNIT,4111) C4111 FORMAT('FIX SUBROUTINE GRSESI TO SET CHAR SZ CALCOMP DEVICE') GOTO9000 C C ****************************************************** C ** STEP 46-- ** C ** TREAT THE LAHEY XXXXXX CASE ** C ** REFERENCE--Programmer's Reference, Revision C ** C ** Lahey Computer Systems, January, 1992** C ** PAGES 51 THRU 65 ** C ****************************************************** C 4600 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 47-- ** C ** TREAT THE MICROSOFT QUICKWIN DRIVER ** C ** FOR WINDOWS 95 AND WINDOWS NT. ** C ****************************************************** C 4700 CONTINUE IF(IQWNFT.LT.1)GOTO9000 ICSTR=' ' CCCCC ICSTR(1:7)='t Arial' CCCCC ICSTR(2:2)=IQUOTE CCCCC NCSTR=8 CCCCC ICSTR(NCSTR:NCSTR)=IQUOTE NCSTR=1 ICSTR(NCSTR:NCSTR)='f' NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='h' NCSTR=NCSTR+1 IF(JHEIG2.LE.5)JHEIG2=5 IF(JHEIG2.GE.30)JHEIG2=30 WRITE(ICSTR(NCSTR:NCSTR+1),'(I2.2)')JHEIG2 NCSTR=NCSTR+2 ICSTR(NCSTR:NCSTR)='w' NCSTR=NCSTR+1 IF(JWIDT2.LE.5)JWIDT2=5 IF(JWIDT2.GE.30)JWIDT2=30 WRITE(ICSTR(NCSTR:NCSTR+1),'(I2.2)')JWIDT2 NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='b' CQWVF IRESLT=SETFONT(ICSTR(1:NCSTR)) CCCCC IRESLT=SETFONT('n1') CQWVF IRESLT=GETFONTINFO(MSFONT) CQWVF JHEIG2=MSFONT.PIXHEIGHT CQWVF JWIDT2=MSFONT.PIXWIDTH IF(JHEIG2.EQ.0)JHEIG2=16 IF(JWIDT2.EQ.0)JWDT2=8 GOTO9000 C C ****************************************************** C ** STEP 48-- ** C ** TREAT THE OPEN-GL DRIVER ** C ** FOR WINDOWS 95 AND WINDOWS NT AND X11 ** C ****************************************************** C 4800 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 49-- ** C ** TREAT THE LAHEY INTERACTOR CASE ** C ****************************************************** C 4900 CONTINUE CINTE CALL IGrCharSize(PHEIG2,PWIDT2) GOTO9000 C C ****************************************************** C ** STEP 49B- ** C ** TREAT THE LAHEY WINTERACTOR CASE ** C ****************************************************** C 4950 CONTINUE ATEMP=1.5 AHEIG=PHEIG2/(100.0*(1.0/25.0)) AWIDTH=PWIDT2/(ATEMP*100.0*(1.0/75.0)) CWINT CALL IGrCharSize(AHEIG,AWIDTH) GOTO9000 C C C ****************************************************** C ** STEP 51-- ** C ** TREAT THE ZETA 3600SX AND 3653SX CASES ** C ** TO SET SIZE-- ** C ** REFERENCE--USER MANUAL FOR DIGITAL PLOTTER ** C ** MODELS 3600SX AND 3653SX ** C ** PAGES B-0 AND B-1 ** C ** USE ZETA VERSION OF CALCOMP LIBRARY. SIZE ** C ** SENT TO "SYMBOL" ROUTINE IN "GRWRTH" AND "GRWRTV"** C ** HOWEVER, SET THE CHARACTER ASPECT RATIO IN GRTRSI* C ****************************************************** C 5100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 61-- ** C ** TREAT THE RAMTEK XXXXXX CASE ** C ** TO SET SIZE-- ** C ** WRITE OUT AN XXXXXXXXXX ** C ** (NOT DONE) ** C ** REFERENCE--XX ** C ** XX ** C ** PAGES XX AND XX ** C ****************************************************** C 6100 CONTINUE CCCCC WRITE(IGUNIT,6111) C6111 FORMAT('FIX SUBROUTINE GRSESI TO SIZE CHAR SZ RAMTEK DEVICE') ICSTR(1:50)='FIX SUBROUTINE GRSESI TO SET CHAR SZ RAMTEK DEVICE' NCSTR=50 CALL GRWRST(ICSTR,NCSTR,ISUBN0) GOTO9000 C C C ****************************************************** C ** STEP 66-- ** C ** TREAT THE SUN CASE - WRITTEN BY BILL ANDERSON ** C ****************************************************** C 6600 CONTINUE IDUMMY = INT(PHEIG2*100) CSUN CALL cfcharheight(IDUMMY) GOTO 9000 C C ****************************************************** C ** STEP 71-- ** C ** TREAT THE XXXXXX XXXXXX CASE ** C ** TO SET SIZE-- ** C ** WRITE OUT AN XXXXXXXXXX ** C ** (NOT DONE) ** C ** REFERENCE--XX ** C ** XX ** C ** PAGES XX AND XX ** C ****************************************************** C 7100 CONTINUE CCCCC WRITE(IGUNIT,7111) C7111 FORMAT('FIX SUBROUTINE GRSESI TO SIZE CHAR SZ XXXXXX DEVICE') ICSTR(1:50)='FIX SUBROUTINE GRSESI TO SET CHAR SZ XXXXXX DEVICE' NCSTR=50 CALL GRWRST(ICSTR,NCSTR,ISUBN0) GOTO9000 C C ****************************************************** C ** STEP 81-- ** C ** TREAT THE DEC REGIS CASE ** C ** TO SET CHARACTER HEIGHT--- ** C ** WRITE OUT A T ( S SIZE-NUMBER ) ** C ** WHERE SIZE-NUMBER IS FROM 0 TO 16 ** C ** REFERENCE--VT125 GRAPHICS TERMINAL USER GUIDE ** C ** PAGES 118 ** C ****************************************************** C C MARCH, 1991. BASE ON VALUE OF JSIZE (DETERMINED IN GRTRSI). 8100 CONTINUE ICSTR(1:3)='T(S' ICSTR(4:6)=' 0)' CCCCC IF(PHEIG2.GT.03.1)ICSTR(4:6)='01)' CCCCC IF(PHEIG2.LE.05.2)GOTO8110 CCCCC IF(PHEIG2.GT.05.2)ICSTR(4:6)='02)' CCCCC IF(PHEIG2.GT.07.8)ICSTR(4:6)='03)' CCCCC IF(PHEIG2.GT.10.9)ICSTR(4:6)='04)' CCCCC IF(PHEIG2.GT.14.1)ICSTR(4:6)='05)' CCCCC IF(PHEIG2.GT.17.2)ICSTR(4:6)='06)' CCCCC IF(PHEIG2.GT.20.3)ICSTR(4:6)='07)' CCCCC IF(PHEIG2.GT.23.4)ICSTR(4:6)='08)' CCCCC IF(PHEIG2.GT.26.6)ICSTR(4:6)='09)' CCCCC IF(PHEIG2.GT.29.7)ICSTR(4:6)='10)' CCCCC IF(PHEIG2.GT.32.8)ICSTR(4:6)='11)' CCCCC IF(PHEIG2.GT.35.9)ICSTR(4:6)='12)' CCCCC IF(PHEIG2.GT.39.1)ICSTR(4:6)='13)' CCCCC IF(PHEIG2.GT.42.2)ICSTR(4:6)='14)' CCCCC IF(PHEIG2.GT.45.3)ICSTR(4:6)='15)' CCCCC IF(PHEIG2.GT.48.4)ICSTR(4:6)='16)' IF(JSIZE.GE.0.AND.JSIZE.LE.9)WRITE(ICSTR(5:5),'(I1)')JSIZE IF(JSIZE.GE.10.AND.JSIZE.LE.99)WRITE(ICSTR(4:5),'(I2)')JSIZE 8110 CONTINUE NCSTR=6 CALL GRWRST(ICSTR,NCSTR,ISUBN0) GOTO9000 C C ****************************************************** C ** STEP 86-- ** C ** TREAT THE POSTSCRIPT CASE ** C ** CHARACTER SIZE DETERMINED BY POINT SIZE ** C ** OF FONT SELECTED. FONT SELECTED IN "GRWRTH" ** C ** "GRWRTV". NOTHING DONE HERE. ** C ** REFERENCE--POSTSCRIPT LANGUAGE TUTORIAL AND ** C ** COOKBOOK, ADOBE SYSTEMS ** C ****************************************************** C 8600 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 89-- ** C ** TREAT THE DISPLAY POSTSCRIPT DRIVER ** C ****************************************************** C 8900 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 91-- ** C ** TREAT THE QUIC CASE ** C ** CHARACTER SIZE DETERMINED BY POINT SIZE ** C ** OF FONT SELECTED. FONT SELECTED IN "GRWRTH" ** C ** "GRWRTV". NOTHING DONE HERE. ** C ** REFERENCE--QUIC PROGRAMMERS MANUAL, ** C ** FROM QMS ** C ****************************************************** C 9100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 96-- ** C ** TREAT THE X11 CASE ** C ** C LIBRARY WILL HANDLE SIZE AND JUSTIFICATION, ** C ** SO THIS WILL BE A NULL ROUTINE ** C ****************************************************** C 9600 CONTINUE GOTO9000 C C ************************************************* C ** STEP 100-- ** C ** TREAT THE VGA VIA TURBO-C CASE ** C ** DONE VIA settextstyle in GRWRTH & GRWRTV ** C ************************************************* C 10000 CONTINUE CALL TCSESI(PHEIGH,PWIDTH,PVEGAP,PHOGAP) GOTO9000 C C ****************************************************** C ** STEP 110-- ** C ** TREAT THE GKS DRIVER ** C ****************************************************** C 11000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 120-- ** C ** TREAT THE GD DRIVER ** C ** THIS LIBRARY PROVIDES SUPPORT FOR: ** C ** 1) JPEG ** C ** 2) PNG ** C ** 3) WINDOWS BMP (BLACK/WHITE ONLY) ** C ****************************************************** C 12000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 130-- ** C ** TREAT THE MACINTOSH DRIVER ** C ** LIBRARY FROM ABSOFT COMPILER ** C ****************************************************** C 13000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 135-- ** C ** TREAT THE MAC OSX AQUATERM DRIVER ** C ****************************************************** C 13500 CONTINUE CAQUA CALL aqtSetFontsize(PHEIG2) GOTO9000 C C ****************************************************** C ** STEP 140-- ** C ** TREAT THE PC PRINTER DRIVER ** C ****************************************************** C 14000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 150-- ** C ** TREAT THE LATEX DRIVER ** C ****************************************************** C 15000 CONTINUE IF(JSIZE.EQ.1)THEN ICSTR(1:1)=IBASLC ICSTR(2:5)='tiny' NCSTR=5 ELSEIF(JSIZE.EQ.2)THEN ICSTR(1:1)=IBASLC ICSTR(2:11)='scriptsize' NCSTR=11 ELSEIF(JSIZE.EQ.3)THEN ICSTR(1:1)=IBASLC ICSTR(2:13)='footnotesize' NCSTR=13 ELSEIF(JSIZE.EQ.5)THEN ICSTR(1:1)=IBASLC ICSTR(2:6)='small' NCSTR=6 ELSEIF(JSIZE.EQ.5)THEN ICSTR(1:1)=IBASLC ICSTR(2:11)='normalsize' NCSTR=11 ELSEIF(JSIZE.EQ.6)THEN ICSTR(1:1)=IBASLC ICSTR(2:6)='large' NCSTR=6 ELSEIF(JSIZE.EQ.7)THEN ICSTR(1:1)=IBASLC ICSTR(2:6)='Large' NCSTR=6 ELSEIF(JSIZE.EQ.8)THEN ICSTR(1:1)=IBASLC ICSTR(2:6)='LARGE' NCSTR=6 ELSEIF(JSIZE.EQ.9)THEN ICSTR(1:1)=IBASLC ICSTR(2:5)='huge' NCSTR=5 ELSEIF(JSIZE.EQ.10)THEN ICSTR(1:1)=IBASLC ICSTR(2:5)='Huge' NCSTR=5 ELSE ICSTR(1:1)=IBASLC ICSTR(2:11)='normalsize' NCSTR=11 ENDIF C CALL GRWRST(ICSTR,NCSTR,ISUBN0) C GOTO9000 C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'SESI')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF GRSESI--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)ICASE,IFONT 9012 FORMAT('ICASE,IFONT = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)PHEIGH,PWIDTH,PVEGAP,PHOGAP 9013 FORMAT('PHEIGH,PWIDTH,PVEGAP,PHOGAP = ',4E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)JSIZE 9014 FORMAT('JSIZE = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9015)JHEIG2,JWIDT2,JVEGA2,JHOGA2 9015 FORMAT('JHEIG2,JWIDT2,JVEGA2,JHOGA2 = ',4I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9016)PHEIG2,PWIDT2,PVEGA2,PHOGA2 9016 FORMAT('PHEIG2,PWIDT2,PVEGA2,PHOGA2 = ',4E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9017)IMANUF,IMODEL 9017 FORMAT('IMANUF,IMODEL = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9018)PVETO2,PHOTO2,IX,IY 9018 FORMAT('PVETO2,PHOTO2,IX,IY = ',2E15.7,2X,2I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9023)NCSTR 9023 FORMAT('NCSTR = ',I8) CALL DPWRST('XXX','BUG ') IF(NCSTR.LE.0)GOTO9027 DO9025I=1,NCSTR CCCCC IASCNE=ICHAR(ICSTR(I:I)) CALL DPCOAN(ICSTR(I:I),IASCNE) WRITE(ICOUT,9026)I,ICSTR(I:I),IASCNE 9026 FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8) CALL DPWRST('XXX','BUG ') 9025 CONTINUE 9027 CONTINUE WRITE(ICOUT,9029)IBUGG4,ISUBG4,IERRG4 9029 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE GRSETH(ICASE,PTHICK,JTHICK,PTHIC2) C C PURPOSE--FOR A LINE, REGION, MARKER, OR TEXT, C SET A THICKNESS (E.G., A PEN THICKNESS) C ON A SPECIFIC GRAPHICS DEVICE. C C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-3651 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL BUREAU OF STANDARDS. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--83.6 C ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY 1983. C UPDATED --JANUARY 1989. SUN (BY BILL ANDERSON) C DRIVER OBSOLETE C UPDATED --JANUARY 1989. POSTSCRIPT (BY ALAN HECKERT) C UPDATED --JANUARY 1989. CGM (BY ALAN HECKERT) C UPDATED --JANUARY 1989. QMS QUIC (BY ALAN HECKERT) C UPDATED --JANUARY 1989. CALCOMP (BY ALAN HECKERT) C UPDATED --JANUARY 1989. ZETA (BY ALAN HECKERT) C UPDATED --MARCH 1990. X11 (BY ALAN HECKERT) C UPDATED --MAY 1991. RENUMBER TOP BRANCHES (JJF) C UPDATED --MAY 1991. VGA/TURBOC DRIVER (JJF) C DRIVER OBSOLETE C UPDATED --JULY 1996. LAHEY DRIVER (ALAN HECKERT) C OLD STYLE CALCOMP C DRIVER OBSOLETE C UPDATED --OCTOBER 1996. QUICKWIN DRIVER (ALAN) C UPDATED --OCTOBER 1996. OPENGL DRIVER (ALAN) C USE BILL MITCHELLS OPENGL C BINDING FOR FORTRAN C UPDATED --OCTOBER 1996. GKS (ALAN) C CODED, NOT TESTED C UPDATED --OCTOBER 1996. BINARY CGM (ALAN) C PLACEHOLDER FOR NOW C UPDATED --OCTOBER 1996. DISPLAY POSTSCRIPT (ALAN) C PLACEHOLDER FOR NOW C UPDATED --OCTOBER 1997. LAHEY INTERACTOR (ALAN) C UPDATED --JULY 1998. LAHEY WINTERACTOR C UPDATED --JUNE 2000. GD (FOR JPEG, PNG, WINDOWS BMP) C UPDATED --JUNE 2000. MACINTOSH C PLACEHOLDER FOR NOW C UPDATED --JUNE 2000. PC PRINTER C PLACEHOLDER FOR NOW C UPDATED --MARCH 2005. SUPPORT FOR AQUATERM C UPDATED --FEBRUARY 2006. SUPPORT FOR LATEX C C-----NON-COMMON VARIABLES (GRAPHICS)------------------------------------------- C CWINT USE WINTERACTER CINTE USE INTERACTER CHARACTER*4 ICASE C CHARACTER*130 ICSTR CHARACTER*4 ISUBN0 C C-----COMMON---------------------------------------------------------- C INCLUDE 'DPCOGR.INC' INCLUDE 'DPCONP.INC' INCLUDE 'DPCOBE.INC' INCLUDE 'DPCOST.INC' INCLUDE 'DPCODV.INC' C C-----COMMON VARIABLES (GENERAL)-------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C EXTERNAL XLATTR C C-----START POINT----------------------------------------------------- C ISUBN0='SETH' C NCSTR=(-999) C IERRG4='NO' C IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'SETH')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF GRSETH--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)ICASE 52 FORMAT('ICASE = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)PTHICK 53 FORMAT('PTHICK = ',E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,54)IMANUF,IMODEL 54 FORMAT('IMANUF,IMODEL = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,59)IBUGG4 59 FORMAT('IBUGG4 = ',A4) CALL DPWRST('XXX','BUG ') 90 CONTINUE C C ******************************************** C ** STEP 1-- ** C ** BRANCH ACCORDING TO THE MANUFACTURER ** C ** AND THE MODEL ** C ******************************************** C IF(IMANUF.EQ.'TEKT')GOTO1005 IF(IMANUF.EQ.'HP')GOTO1010 IF(IMANUF.EQ.'PCL')GOTO1015 IF(IMANUF.EQ.'GENE')GOTO1020 IF(IMANUF.EQ.'CALC')GOTO1025 IF(IMANUF.EQ.'ZETA')GOTO1030 IF(IMANUF.EQ.'RAMT')GOTO1035 IF(IMANUF.EQ.'SUN ')GOTO1040 IF(IMANUF.EQ.'XXXX')GOTO1045 IF(IMANUF.EQ.'REGI')GOTO1050 IF(IMANUF.EQ.'POST')GOTO1055 IF(IMANUF.EQ.'QUIC')GOTO1060 IF(IMANUF.EQ.'X11 ')GOTO1065 IF(IMANUF.EQ.'TURB')GOTO1070 IF(IMANUF.EQ.'GKS ')GOTO1075 IF(IMANUF.EQ.'LAHE')GOTO1080 IF(IMANUF.EQ.'GD ')GOTO1085 IF(IMANUF.EQ.'QWIN')GOTO1090 IF(IMANUF.EQ.'AQUA')GOTO1091 IF(IMANUF.EQ.'OPGL')GOTO1095 IF(IMANUF.EQ.'PRIN')GOTO1096 IF(IMANUF.EQ.'LATE')GOTO1097 IF(IMANUF.EQ.'MACI')GOTO1098 GOTO9000 C 1005 CONTINUE GOTO1100 C 1010 CONTINUE IF(IMODEL.EQ.'7221')GOTO2100 IF(IMODEL.EQ.'2622')GOTO2300 IF(IMODEL.EQ.'2623')GOTO2300 IF(IMODEL.EQ.'2627')GOTO2300 IF(IMODEL.EQ.'2647')GOTO2300 GOTO2200 C 1015 CONTINUE GOTO2600 C 1020 CONTINUE IF(IMODEL.EQ.'CODE')GOTO3200 IF(IMODEL.EQ.'CGM')GOTO3300 IF(IMODEL.EQ.'CGMB')GOTO3400 GOTO3100 C 1025 CONTINUE GOTO4100 C 1030 CONTINUE GOTO5100 C 1035 CONTINUE GOTO6100 C 1040 CONTINUE GOTO6600 C 1045 CONTINUE GOTO7100 C 1050 CONTINUE GOTO8100 C 1055 CONTINUE IF(IMODEL.EQ.'DISP')GOTO8900 GOTO8600 C 1060 CONTINUE GOTO9100 C 1065 CONTINUE GOTO9600 C 1070 CONTINUE GOTO10000 C 1075 CONTINUE GOTO11000 C 1080 CONTINUE IF(IMODEL.EQ.'INTE')GOTO4900 IF(IMODEL.EQ.'WINT')GOTO4950 GOTO4600 C 1085 CONTINUE IF(IMODEL.EQ.'JPEG')GOTO12000 IF(IMODEL.EQ.'PNG ')GOTO12000 IF(IMODEL.EQ.'WBMP')GOTO12000 IF(IMODEL.EQ.'GIF')GOTO12000 GOTO12000 C 1090 CONTINUE GOTO4700 C 1091 CONTINUE GOTO13500 C 1095 CONTINUE GOTO4800 C 1096 CONTINUE GOTO14000 C 1097 CONTINUE GOTO15000 C 1098 CONTINUE GOTO13000 C C ****************************************************** C ** STEP 11-- ** C ** TREAT THE TEKTRONIX CASE ** C ** REFERENCE--XXX ** C ****************************************************** C 1100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 21-- ** C ** TREAT THE HEWLETT-PACKARD 7221 CASE ** C ** (MULTI-COLOR PENPLOTTER) ** C ** REFERENCE--HP 7221A GRAPHICS PLOTTER ** C ** OPERATING AND PROGRAMMING MANUAL, ** C ** PAGE XX. ** C ****************************************************** C 2100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 22-- ** C ** TREAT THE HEWLETT-PACKARD HP-GL CASES ** C ** (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS) ** C ** (MULTI-COLOR PENPLOTTERS) ** C ** REFERENCE--HP 9872C GRAPHICS PLOTTER ** C ** OPERATING AND PROGRAMMING MANUAL, ** C ** PAGE XX, XXX. ** C ****************************************************** C 2200 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 23-- ** C ** TREAT THE HEWLETT-PACKARD 2622 CASES ** C ** LINE THICKNESS IMPLEMENTED IN SOFTWARE ** C ****************************************************** C 2300 CONTINUE GOTO9000 C C ********************************************************** C ** STEP 26-- ** C ** TREAT THE HEWLETT-PACKARD PCL CASES ** C ** LASERJET LASER PRINTERS ** C ********************************************************** C 2600 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 31-- ** C ** TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE ** C ****************************************************** C C JANUARY, 1988: TWO SET COMMANDS FOR LINE THICKNESS. C SET THICKNESS - IF OFF, LINE WIDTH IS SET TO THE C REQUESTED VALUE, UP TO THE POST PROCESSOR C TO IMPLEMENT MULTIPLE WIDTH LINES. C IF ON, MULTIPLE LINE WIDTH WILL BE IMPLEMENTED C WITHIN DATAPLOT. THE LINE WIDTH FOR A C SINGLE LINE DETERMINED BY NEXT COMMAND. C SET PEN WIDTH - SETS PEN WIDTH TO BE USED IN IMPLEMENTING C MULTIPLE LINE WIDTH WITHIN DATAPLOT (0.1 DEFAULT) 3100 CONTINUE C IF(IPTHSW.EQ.'ON')GOTO3150 C ICSTR(1:14)='SET THICKNESS ' NCSTR=14 NCHTOT=10 NCHDEC=5 CALL GRTRRE(PTHIC2,NCHTOT,NCHDEC,ICSTR,NCSTR) CALL GRWRST(ICSTR,NCSTR,ISUBN0) GOTO3190 C 3150 CONTINUE C ICSTR(1:14)='SET THICKNESS ' NCSTR=14 NCHTOT=10 NCHDEC=5 CALL GRTRRE(PPENSW,NCHTOT,NCHDEC,ICSTR,NCSTR) CALL GRWRST(ICSTR,NCSTR,ISUBN0) C 3190 CONTINUE C GOTO9000 C C *************************************************************** C ** STEP 32-- ** C ** TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE ** C *************************************************************** C C JANUARY, 1988: TWO SET COMMANDS FOR LINE THICKNESS. C SET THICKNESS - IF OFF, LINE WIDTH IS SET TO THE C REQUESTED VALUE, UP TO THE POST PROCESSOR C TO IMPLEMENT MULTIPLE WIDTH LINES. C IF ON, MULTIPLE LINE WIDTH WILL BE IMPLEMENTED C WITHIN DATAPLOT. THE LINE WIDTH FOR A C SINGLE LINE DETERMINED BY NEXT COMMAND. C SET PEN WIDTH - SETS PEN WIDTH TO BE USED IN IMPLEMENTING C MULTIPLE LINE WIDTH WITHIN DATAPLOT (0.1 DEFAULT) 3200 CONTINUE C IF(IPTHSW.EQ.'ON')GOTO3250 C ICSTR(1:5)='SETH ' NCSTR=5 NCHTOT=10 NCHDEC=5 CALL GRTRRE(PTHIC2,NCHTOT,NCHDEC,ICSTR,NCSTR) CALL GRWRST(ICSTR,NCSTR,ISUBN0) GOTO3290 C 3250 CONTINUE C ICSTR(1:5)='SETH ' NCSTR=5 NCHTOT=10 NCHDEC=5 CALL GRTRRE(PPENSW,NCHTOT,NCHDEC,ICSTR,NCSTR) CALL GRWRST(ICSTR,NCSTR,ISUBN0) C 3290 CONTINUE C GOTO9000 C C ****************************************************** C ** STEP 33-- ** C ** TREAT THE CGM CASE ** C ** LINEWIDTH ** C ** NOTE THAT LINE WIDTH SPECIFICATION MODE IS SET ** C ** TO ABSOLUTE IN "GRINDE". THIS CORRESPONDS TO ** C ** THE DATAPLOT MEANING (I.E., 0.1 IS A PERCENTAGE ** C ** OF THE TOTAL (100 PER CENT) VERTICAL SIZE OR ** C ** VDC UNITS. ** C ** NOTE: THE ABSOLUTE MODE DESCRIBED IN THE STANDARD* C ** DOES NOT SEEM TO BE SUPPORTED. THERE IS ** C ** AN "ABSTRACT" MODE, BUT I CAN NOT FIND ** C ** DOCUMENTATION ON WHAT THIS MEANS. IT MAY ** C ** BE A REPLACEMENT FOR ABSOLUTE, BUT I AM ** C ** NOT SURE. FOR NOW, USE SCALED MODE WHICH ** C ** SPECIFIES LINE WIDTH AS A MULTIPLE OF THE ** C ** NOMINAL DEVICE LINE WIDTH. ** C ****************************************************** C 3300 CONTINUE C IF(IPTHSW.EQ.'ON')GOTO3350 C ICSTR(1:10)='LINEWIDTH ' NCSTR=10 ASCALE=PTHIC2/PPENSW NCHTOT=10 NCHDEC=5 CALL GRTRRE(ASCALE,NCHTOT,NCHDEC,ICSTR,NCSTR) ICSTR(21:21)=';' NCSTR=21 CALL GRWRST(ICSTR,NCSTR,ISUBN0) GOTO3390 C 3350 CONTINUE C ICSTR(1:14)='LINEWIDTH 1.0;' NCSTR=14 CALL GRWRST(ICSTR,NCSTR,ISUBN0) C 3390 CONTINUE C GOTO9000 C C *************************************************** C ** STEP 34-- ** C ** TREAT THE CGM (BINARY) CASE ** C *************************************************** C 3400 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 41-- ** C ** TREAT THE CALCOMP XXXXXX CASE ** C ** LINE THICKNESS IS IMPLEMENTED IN SOFTWARE ** C ** REFERENCE--XX ** C ** XX ** C ** PAGES XX AND XX ** C ****************************************************** C 4100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 46-- ** C ** TREAT THE LAHEY XXXXXX CASE ** C ** REFERENCE--Programmer's Reference, Revision C ** C ** Lahey Computer Systems, January, 1992** C ** PAGES 51 THRU 65 ** C ****************************************************** C 4600 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 47-- ** C ** TREAT THE MICROSOFT QUICKWIN DRIVER ** C ** FOR WINDOWS 95 AND WINDOWS NT. ** C ****************************************************** C 4700 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 48-- ** C ** TREAT THE OPEN-GL DRIVER ** C ** FOR WINDOWS 95 AND WINDOWS NT AND X11 ** C ****************************************************** C 4800 CONTINUE IF(IOPGOF.EQ.'OFF')GOTO9000 ICODE=1 ISTYLE=0 CALL GLATTR(ICODE,ISTYLE,PTHIC2) GOTO9000 C C ****************************************************** C ** STEP 49-- ** C ** TREAT THE LAHEY INTERACTOR CASE ** C ****************************************************** C 4900 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 49B- ** C ** TREAT THE LAHEY WINTERACTOR CASE ** C ****************************************************** C 4950 CONTINUE GOTO9000 C C C ****************************************************** C ** STEP 51-- ** C ** TREAT THE ZETA 3600SX AND 3653SX CASES ** C ** REFERENCE--USER MANUAL FOR DIGITAL PLOTTER ** C ** MODELS 3600SX AND 3653SX ** C ** PAGES B-0 AND B-1 ** C ****************************************************** C 5100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 61-- ** C ** TREAT THE RAMTEK XXXXXX CASE ** C ** (NOT DONE) ** C ** REFERENCE--XX ** C ** XX ** C ** PAGES XX AND XX ** C ****************************************************** C 6100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 66-- ** C ** TREAT THE SUN CASE ** C ****************************************************** C 6600 CONTINUE CSUN CALL cflnwidth(pthick) GOTO9000 C C ****************************************************** C ** STEP 71-- ** C ** TREAT THE XXXXXX XXXXXX CASE ** C ** (NOT DONE) ** C ** REFERENCE--XX ** C ** XX ** C ** PAGES XX AND XX ** C ****************************************************** C 7100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 81-- ** C ** TREAT THE REGIS CASE ** C ****************************************************** C 8100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 86-- ** C ** TREAT THE POSTSCRIPT CASE ** C ** SETLINEWIDTH ** C ****************************************************** C 8600 CONTINUE NCHTOT=5 NCSTR=0 ITEMP=INT(PTHIC2) CALL GRTRIN(ITEMP,NCHTOT,ICSTR,NCSTR) ICSTR(6:18)=' setlinewidth' NCSTR=18 CALL GRWRST(ICSTR,NCSTR,ISUBN0) GOTO9000 C C ****************************************************** C ** STEP 89-- ** C ** TREAT THE DISPLAY POSTSCRIPT DRIVER ** C ****************************************************** C 8900 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 91-- ** C ** TREAT THE QUIC CASE ** C ** FOR QUIC, THE PEN WIDTH IS SET ONLY AFTER ** C ** VECTOR GRAPHICS MODE IS ENTERED IN "GRDRLI" OR ** C ** "GRDRPL". NOTHING DONE HERE ** C ****************************************************** C 9100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 96-- ** C ** TREAT THE X11 CASE ** C ****************************************************** C 9600 CONTINUE IF(IX11OF.EQ.'OFF')GOTO9000 ICODE=1 INDEX=PTHIC2+0.5 CALL XLATTR(INDEX,ICODE) GOTO9000 C CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1991 (JJF) C ************************************************* C ** STEP 100-- ** C ** TREAT THE VGA VIA TURBO-C CASE ** C ** REFERENCE--TURBO C 1.5 ADDITIONS & ** C ** ENHANCEMENTS, PAGE 124. ** C ** REFERENCE--TURBO C 2.0 REFERENCE GUIDE, ** C ** PAGE 320-321. ** C ** REFERENCE--WEISKAMP, POWER GRAPHICS ** C ** USING TURBO C, PAGE 30. ** C ************************************************* C 10000 CONTINUE CALL TCSETH(PTHICK) GOTO9000 C C ****************************************************** C ** STEP 110-- ** C ** TREAT THE GKS DRIVER ** C ****************************************************** C 11000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 120-- ** C ** TREAT THE GD DRIVER ** C ** THIS LIBRARY PROVIDES SUPPORT FOR: ** C ** 1) JPEG ** C ** 2) PNG ** C ** 3) WINDOWS BMP (BLACK/WHITE ONLY) ** C ** LINE THICKNESS HANDLED IN SOFTWARE ** C ****************************************************** C 12000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 130-- ** C ** TREAT THE MACINTOSH DRIVER ** C ** LIBRARY FROM ABSOFT COMPILER ** C ****************************************************** C 13000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 135-- ** C ** TREAT THE MAC OSX AQUATERM DRIVER ** C ****************************************************** C 13500 CONTINUE CAQUA CALL aqtSetLinewidth(PTHIC2) GOTO9000 C C ****************************************************** C ** STEP 140-- ** C ** TREAT THE PC PRINTER DRIVER ** C ****************************************************** C 14000 CONTINUE GOTO9000 C C C ****************************************************** C ** STEP 150-- ** C ** TREAT THE LATEX (USING EEPIC) DRIVER ** C ****************************************************** C 15000 CONTINUE IF(ILATLT.EQ.'HARD')THEN IF(PTHIC2.GE.0.25)THEN ICSTR(1:1)=IBASLC ICSTR(2:11)='Thicklines' NCSTR=11 CALL GRWRST(ICSTR,NCSTR,ISUBN0) ELSEIF(PTHIC2.GE.0.15)THEN ICSTR(1:1)=IBASLC ICSTR(2:11)='thicklines' NCSTR=11 CALL GRWRST(ICSTR,NCSTR,ISUBN0) ELSE ICSTR(1:1)=IBASLC ICSTR(2:10)='thinlines' NCSTR=10 CALL GRWRST(ICSTR,NCSTR,ISUBN0) ENDIF ENDIF GOTO9000 C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'SETH')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF GRSETH--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)ICASE 9012 FORMAT('ICASE = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)PTHICK,JTHICK,PTHIC2 9013 FORMAT('PTHICK,JTHICK,PTHIC2 = ',E15.7,I8,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)IMANUF,IMODEL 9014 FORMAT('IMANUF,IMODEL = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9019)IBUGG4,ISUBG4,IERRG4 9019 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE GRTRCA(ITYPE,ICASE,JCASE) C C PURPOSE--FOR A LINE, REGION, MARKER, OR TEXT, C TRANSLATE A CASE (UPPER OR LOWER) GIVEN IN CHARACTER REPRESENTATI C INTO A NUMERIC REPRESENTATION C THAT WILL BE UNDERSTOOD BY A SPECIFIC C GRAPHICS DEVICE. C C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-3651 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL BUREAU OF STANDARDS. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--83.6 C ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY 1983. C UPDATED --JANUARY 1989. SUN (BY BILL ANDERSON) C DRIVER OBSOLETE C UPDATED --JANUARY 1989. POSTSCRIPT (BY ALAN HECKERT) C UPDATED --JANUARY 1989. CGM (BY ALAN HECKERT) C UPDATED --JANUARY 1989. QMS QUIC (BY ALAN HECKERT) C UPDATED --JANUARY 1989. CALCOMP (BY ALAN HECKERT) C UPDATED --JANUARY 1989. ZETA (BY ALAN HECKERT) C UPDATED --MARCH 1990. X11 (BY ALAN HECKERT) C UPDATED --MAY 1991. RENUMBER TOP BRANCHES (JJF) C UPDATED --MAY 1991. VGA/TURBOC DRIVER (JJF) C DRIVER OBSOLETE C UPDATED --JULY 1996. LAHEY DRIVER (ALAN HECKERT) C OLD CALCOMP STYLE C DRIVER OBSOLETE C UPDATED --OCTOBER 1996. QUICKWIN DRIVER (ALAN) C UPDATED --OCTOBER 1996. OPENGL DRIVER (ALAN) C USE BILL MITCHELLS OPENGL C BINDING FOR FORTRAN C UPDATED --OCTOBER 1996. GKS (ALAN) C CODED, NOT TESTED C UPDATED --OCTOBER 1996. BINARY CGM (ALAN) C PLACEHOLDER FOR NOW C UPDATED --OCTOBER 1996. DISPLAY POSTSCRIPT (ALAN) C PLACEHOLDER FOR NOW C UPDATED --OCTOBER 1997. LAHEY INTERACTOR (ALAN) C UPDATED --JULY 1998. LAHEY WINTERACTOR C UPDATED --JUNE 2000. GD (FOR JPEG, PNG, WINDOWS BMP) C UPDATED --JUNE 2000. MACINTOSH C PLACEHOLDER FOR NOW C UPDATED --JUNE 2000. PC PRINTER C PLACEHOLDER FOR NOW C UPDATED --MARCH 2005. SUPPORT FOR AQUATERM C C-----NON-COMMON VARIABLES (GRAPHICS)------------------------------------------- C CWINT USE WINTERACTER CINTE USE INTERACTER CHARACTER*4 ITYPE CHARACTER*4 ICASE C C-----COMMON---------------------------------------------------------- C INCLUDE 'DPCOGR.INC' INCLUDE 'DPCOBE.INC' C C-----COMMON VARIABLES (GENERAL)-------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C IERRG4='NO' C IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRCA')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF GRTRCA--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)ITYPE 52 FORMAT('ITYPE = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)ICASE 53 FORMAT('ICASE = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,54)IMANUF,IMODEL 54 FORMAT('IMANUF,IMODEL = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,59)IBUGG4 59 FORMAT('IBUGG4 = ',A4) CALL DPWRST('XXX','BUG ') 90 CONTINUE C C ************************************* C ** STEP 0-- ** C ** DEFINE CASE ** C ** FOR A GENERAL GRAPHICS DEVICE ** C ************************************* C JCASE=1 IF(ICASE.EQ.'UPPE')JCASE=1 IF(ICASE.EQ.'LOWE')JCASE=2 C C ******************************************** C ** STEP 1-- ** C ** BRANCH ACCORDING TO THE MANUFACTURER ** C ** AND THE MODEL ** C ******************************************** C IF(IMANUF.EQ.'TEKT')GOTO1005 IF(IMANUF.EQ.'HP')GOTO1010 IF(IMANUF.EQ.'PCL')GOTO1015 IF(IMANUF.EQ.'GENE')GOTO1020 IF(IMANUF.EQ.'CALC')GOTO1025 IF(IMANUF.EQ.'ZETA')GOTO1030 IF(IMANUF.EQ.'RAMT')GOTO1035 IF(IMANUF.EQ.'SUN ')GOTO1040 IF(IMANUF.EQ.'XXXX')GOTO1045 IF(IMANUF.EQ.'REGI')GOTO1050 IF(IMANUF.EQ.'POST')GOTO1055 IF(IMANUF.EQ.'QUIC')GOTO1060 IF(IMANUF.EQ.'X11 ')GOTO1065 IF(IMANUF.EQ.'TURB')GOTO1070 IF(IMANUF.EQ.'GKS ')GOTO1075 IF(IMANUF.EQ.'LAHE')GOTO1080 IF(IMANUF.EQ.'GD ')GOTO1085 IF(IMANUF.EQ.'QWIN')GOTO1090 IF(IMANUF.EQ.'AQUA')GOTO1091 IF(IMANUF.EQ.'OPGL')GOTO1095 IF(IMANUF.EQ.'PRIN')GOTO1096 IF(IMANUF.EQ.'MACI')GOTO1098 GOTO9000 C 1005 CONTINUE GOTO1100 C 1010 CONTINUE IF(IMODEL.EQ.'7221')GOTO2100 IF(IMODEL.EQ.'2622')GOTO2300 IF(IMODEL.EQ.'2623')GOTO2300 IF(IMODEL.EQ.'2627')GOTO2300 IF(IMODEL.EQ.'2647')GOTO2300 GOTO2200 C 1015 CONTINUE GOTO2600 C 1020 CONTINUE IF(IMODEL.EQ.'CGM')GOTO3300 IF(IMODEL.EQ.'CGMB')GOTO3400 GOTO3100 C 1025 CONTINUE GOTO4100 C 1030 CONTINUE GOTO5100 C 1035 CONTINUE GOTO6100 C 1040 CONTINUE GOTO6600 C 1045 CONTINUE GOTO7100 C 1050 CONTINUE GOTO8100 C 1055 CONTINUE IF(IMODEL.EQ.'DISP')GOTO8900 GOTO8600 C 1060 CONTINUE GOTO9100 C 1065 CONTINUE GOTO9600 C 1070 CONTINUE GOTO10000 C 1075 CONTINUE GOTO11000 C 1080 CONTINUE IF(IMODEL.EQ.'INTE')GOTO4900 IF(IMODEL.EQ.'WINT')GOTO4950 GOTO4600 C 1085 CONTINUE IF(IMODEL.EQ.'JPEG')GOTO12000 IF(IMODEL.EQ.'PNG ')GOTO12000 IF(IMODEL.EQ.'WBMP')GOTO12000 IF(IMODEL.EQ.'GIF')GOTO12000 GOTO12000 C 1090 CONTINUE GOTO4700 C 1091 CONTINUE GOTO13500 C 1095 CONTINUE GOTO4800 C 1096 CONTINUE GOTO14000 C 1098 CONTINUE GOTO13000 C C ****************************************************** C ** STEP 11-- ** C ** TREAT THE TEKTRONIX CASE ** C ****************************************************** C 1100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 21-- ** C ** TREAT THE HEWLETT-PACKARD 7221 CASE ** C ** (MULTI-COLOR PENPLOTTER) ** C ** REFERENCE--HP 7221A GRAPHICS PLOTTER ** C ** OPERATING AND PROGRAMMING MANUAL, ** C ** PAGE XX. ** C ****************************************************** C 2100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 22-- ** C ** TREAT THE HEWLETT-PACKARD HP-GL CASES ** C ** (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS) ** C ** (MULTI-COLOR PENPLOTTERS) ** C ** REFERENCE--HP 9872C GRAPHICS PLOTTER ** C ** OPERATING AND PROGRAMMING MANUAL, ** C ** PAGE XX, XXX. ** C ****************************************************** C 2200 CONTINUE GOTO9000 C C C ****************************************************** C ** STEP 23-- ** C ** TREAT THE HP-2622 CASE ** C ****************************************************** C 2300 CONTINUE GOTO9000 C C C ****************************************************** C ** STEP 26-- ** C ** TREAT THE PCL CASE ** C ****************************************************** C 2600 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 31-- ** C ** TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE ** C ****************************************************** C 3100 CONTINUE GOTO9000 C C C ****************************************************** C ** STEP 33-- ** C ** TREAT THE CGM CASE ** C ****************************************************** C 3300 CONTINUE GOTO9000 C C *************************************************** C ** STEP 34-- ** C ** TREAT THE CGM (BINARY) CASE ** C *************************************************** C 3400 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 41-- ** C ** TREAT THE CALCOMP XXXXXX CASE ** C ** (NOT DONE) ** C ** REFERENCE--XX ** C ** XX ** C ** PAGES XX AND XX ** C ****************************************************** C 4100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 46-- ** C ** TREAT THE LAHEY XXXXXX CASE ** C ** REFERENCE--Programmer's Reference, Revision C ** C ** Lahey Computer Systems, January, 1992** C ** PAGES 51 THRU 65 ** C ****************************************************** C 4600 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 47-- ** C ** TREAT THE MICROSOFT QUICKWIN DRIVER ** C ** FOR WINDOWS 95 AND WINDOWS NT. ** C ****************************************************** C 4700 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 48-- ** C ** TREAT THE OPEN-GL DRIVER ** C ** FOR WINDOWS 95 AND WINDOWS NT AND X11 ** C ****************************************************** C 4800 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 49-- ** C ** TREAT THE LAHEY INTERACTOR CASE ** C ****************************************************** C 4900 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 49B- ** C ** TREAT THE LAHEY WINTERACTOR CASE ** C ****************************************************** C 4950 CONTINUE GOTO9000 C C C ****************************************************** C ** STEP 51-- ** C ** TREAT THE ZETA 3600SX AND 3653SX CASES ** C ** REFERENCE--USER MANUAL FOR DIGITAL PLOTTER ** C ** MODELS 3600SX AND 3653SX ** C ** PAGES B-0 AND B-1 ** C ****************************************************** C 5100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 61-- ** C ** TREAT THE RAMTEK XXXXXX CASE ** C ** (NOT DONE) ** C ** REFERENCE--XX ** C ** XX ** C ** PAGES XX AND XX ** C ****************************************************** C 6100 CONTINUE GOTO9000 C C C ****************************************************** C ** STEP 66-- ** C ** TREAT THE SUN CASE ** C ****************************************************** C 6600 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 71-- ** C ** TREAT THE XXXXXX XXXXXX CASE ** C ** (NOT DONE) ** C ** REFERENCE--XX ** C ** XX ** C ** PAGES XX AND XX ** C ****************************************************** C 7100 CONTINUE GOTO9000 C C C ****************************************************** C ** STEP 81-- ** C ** TREAT THE REGIS CASE ** C ****************************************************** C 8100 CONTINUE GOTO9000 C C C ****************************************************** C ** STEP 86-- ** C ** TREAT THE POSTSCRIPT CASE ** C ****************************************************** C 8600 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 89-- ** C ** TREAT THE DISPLAY POSTSCRIPT DRIVER ** C ****************************************************** C 8900 CONTINUE GOTO9000 C C C ****************************************************** C ** STEP 91-- ** C ** TREAT THE QUIC CASE ** C ****************************************************** C 9100 CONTINUE GOTO9000 C C C ****************************************************** C ** STEP 96-- ** C ** TREAT THE X11 CASE ** C ****************************************************** C 9600 CONTINUE GOTO9000 C C ************************************************* C ** STEP 100-- ** C ** TREAT THE VGA VIA TURBO-C CASE ** C ************************************************* C 10000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 110-- ** C ** TREAT THE GKS DRIVER ** C ****************************************************** C 11000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 120-- ** C ** TREAT THE GD DRIVER ** C ** THIS LIBRARY PROVIDES SUPPORT FOR: ** C ** 1) JPEG ** C ** 2) PNG ** C ** 3) WINDOWS BMP (BLACK/WHITE ONLY) ** C ****************************************************** C 12000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 130-- ** C ** TREAT THE MACINTOSH DRIVER ** C ** LIBRARY FROM ABSOFT COMPILER ** C ****************************************************** C 13000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 135-- ** C ** TREAT THE MAC OSX AQUATERM DRIVER ** C ****************************************************** C 13500 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 140-- ** C ** TREAT THE PC PRINTER DRIVER ** C ****************************************************** C 14000 CONTINUE GOTO9000 C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRCA')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF GRTRCA--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)ITYPE 9012 FORMAT('ITYPE = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)ICASE,JCASE 9013 FORMAT('ICASE,JCASE = ',A4,I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)IMANUF,IMODEL 9014 FORMAT('IMANUF,IMODEL = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9019)IBUGG4,ISUBG4,IERRG4 9019 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE GRTRCO(ICASE,ICOL,JCOL) C C PURPOSE--FOR A LINE, REGION, MARKER, OR TEXT, C TRANSLATE A COLOR GIVEN IN CHARACTER REPRESENTATION C INTO A NUMERIC REPRESENTATION C THAT WILL BE UNDERSTOOD BY A SPECIFIC C GRAPHICS DEVICE. C NOTE--THIS SUBROUTINE IS NEEDED FOR COLOR DEVICES ONLY. C C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-3651 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL BUREAU OF STANDARDS. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--83.6 C ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY 1983. C UPDATED --JANUARY 1989. SUN (BY BILL ANDERSON) C DRIVER OBSOLETE C UPDATED --JANUARY 1989. POSTSCRIPT (BY ALAN HECKERT) C UPDATED --JANUARY 1989. CGM (BY ALAN HECKERT) C UPDATED --JANUARY 1989. QMS QUIC (BY ALAN HECKERT) C UPDATED --JANUARY 1989. CALCOMP (BY ALAN HECKERT) C UPDATED --JANUARY 1989. ZETA (BY ALAN HECKERT) C UPDATED --MARCH 1990. X11 (BY ALAN HECKERT) C UPDATED --MAY 1990. PEN MAP FOR HPGL, ZETA, CALCOMP (ALAN) C UPDATED --JULY 1990. SOME HP-26XX TERMINALS SUPPORT COLOR C UPDATED --AUGUST 1990. SUPPORT GRAYSCALE ON POSTSCRIPT (ALAN) C UPDATED --JANUARY 1991. ADD COLOR SUPPORT FOR REGIS (ALAN) C UPDATED --MAY 1991. RENUMBER TOP BRANCHES (JJF) C UPDATED --MAY 1991. VGA/TURBOC DRIVER (JJF) C DRIVER OBSOLETE C UPDATED --JUNE 1991. ADDITIONAL COLOR SUPPORT FOR X11 (ALAN) C UPDATED --AUGUST 1992. SIGNIFICANT CHANGES TO SUPPORT A C CONSISTENT SET OF COLORS AND C INDICES (ALAN) C ALSO MAKE TABLE-DRIVEN FOR C BETTER EFFICIENCY. C UPDATED --JULY 1996. LAHEY DRIVER (ALAN HECKERT) C OLD CALCOMP STYLE C DRIVER OBSOLETE C UPDATED --OCTOBER 1996. QUICKWIN DRIVER (ALAN) C UPDATED --OCTOBER 1996. OPENGL DRIVER (ALAN) C USE BILL MITCHELLS OPENGL C BINDING FOR FORTRAN C UPDATED --OCTOBER 1996. GKS (ALAN) C CODED, NOT TESTED C UPDATED --OCTOBER 1996. BINARY CGM (ALAN) C PLACEHOLDER FOR NOW C UPDATED --OCTOBER 1996. DISPLAY POSTSCRIPT (ALAN) C PLACEHOLDER FOR NOW C UPDATED --OCTOBER 1997. LAHEY INTERACTOR (ALAN) C UPDATED --JULY 1998. LAHEY WINTERACTOR C UPDATED --JUNE 2000. GD (FOR JPEG, PNG, WINDOWS BMP) C UPDATED --JUNE 2000. MACINTOSH C PLACEHOLDER FOR NOW C UPDATED --JUNE 2000. PC PRINTER C PLACEHOLDER FOR NOW C UPDATED --MARCH 2002. LATEX (USING EEPIC) C UPDATED --MARCH 2002. SVG (SCALABLE VECTOR GRAPHICS) C UPDATED --MARCH 2005. SUPPORT FOR AQUATERM C C-----NON-COMMON VARIABLES (GRAPHICS)------------------------------------------- C CWINT USE WINTERACTER CINTE USE INTERACTER CHARACTER*4 ICASE CHARACTER*4 ICOL C FOLLOWING LINE ADDED AUGUST, 1990. CCCCC CHARACTER*4 ICOLT C FOLLOWING ADDED AUGUST 1992. CHARACTER*4 CJUNK C PARAMETER (MAXCLR=89) C CHARACTER*4 ICOLNM(MAXCLR) C INTEGER J4027(MAXCLR) INTEGER J4105(MAXCLR) INTEGER JPLOT4(MAXCLR) INTEGER JPLOT8(MAXCLR) INTEGER J2622(MAXCLR) INTEGER JCGM(MAXCLR) INTEGER JSUN(MAXCLR) INTEGER JX11(MAXCLR) INTEGER JREGIS(MAXCLR) INTEGER JPC(MAXCLR) INTEGER JLAHEY(MAXCLR) INTEGER JWINT(MAXCLR) C CHARACTER*130 ICSTR CHARACTER*4 ISUBN0 C C-----COMMON---------------------------------------------------------- C INCLUDE 'DPCOGR.INC' INCLUDE 'DPCONP.INC' INCLUDE 'DPCOBE.INC' INCLUDE 'DPCODV.INC' C C-----COMMON VARIABLES (GENERAL)-------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C AUGUST 1992. DEFINE COLOR TABLES. C C ROW 1: WHIT, BLAC, RED , BLUE, GREE, MAGE, ORAN, CYAN, YELL, YGRE C ROW 2: DGRE, LBLU, VBLU, VRED, DGRA, LGRA, AQUA, BROW, CABL, CORA C ROW 3: CBLU, DOGR, DORC, DSBL, DTUR, FIRE, FGRE, GOLD, GLDR, GRAY C ROW 4: IRED, KHAK, DMGR, LSBL, LGRE, MARO, MAQU, MBLU, MFGR, MGLD C ROW 5: MORC, MSGR, MSBL, MSPG, MTUR, MVRD, MDBL, NAVY, ORED, ORCH C ROW 6: PGRE, PINK, PLUM, PURP, SALM, SGRE, SIEN, SKBL, SBLU, SPGR C ROW 7: STBL, TAN , THIS, TURQ, VIOL, WHEA, GYEL, LCYA, BLU2, BLU3 C ROW 8: BLU4, CYA2, CYA3, CYA4, GRE2, GRE3, GRE4, YEL2, YEL3, YEL4 C ROW 9: ORA2, ORA3, ORA4, RED2, RED3, RED4, MAG1, MAG2, MAG3 C DATA (ICOLNM(I),I=1,50)/ 1 'WHIT', 'BLAC', 'RED ', 'BLUE', 'GREE', 'MAGE', 'ORAN', 'CYAN', X 'YELL', 'YGRE', 2 'DGRE', 'LBLU', 'VBLU', 'VRED', 'DGRA', 'LGRA', 'AQUA', 'BROW', X 'CABL', 'CORA', 3 'CBLU', 'DOGR', 'DORC', 'DSBL', 'DTUR', 'FIRE', 'FGRE', 'GOLD', X 'GLDR', 'GRAY', 4 'IRED', 'KHAK', 'DMGR', 'LSBL', 'LGRE', 'MARO', 'MAQU', 'MBLU', X 'MFGR', 'MGLD', 5 'MORC', 'MSGR', 'MSBL', 'MSPG', 'MTUR', 'MVRD', 'MDBL', 'NAVY', X 'ORED', 'ORCH'/ DATA (ICOLNM(I),I=51,MAXCLR)/ 6 'PGRE', 'PINK', 'PLUM', 'PURP', 'SALM', 'SGRE', 'SIEN', 'SKBL', X 'SBLU', 'SPGR', 7 'STBL', 'TAN ', 'THIS', 'TURQ', 'VIOL', 'WHEA', 'GYEL', 'LCYA', X 'BLU2', 'BLU3', 8 'BLU4', 'CYA2', 'CYA3', 'CYA4', 'GRE2', 'GRE3', 'GRE4', 'YEL2', X 'YEL3', 'YEL4', 9 'ORA2', 'ORA3', 'ORA4', 'RED2', 'RED3', 'RED4', 'MAG2', 'MAG3', X 'MAG4'/ C C TEKTRONIX 4027 C C WHITE = 0 C RED = 1 C GREEN = 2 C BLUE = 3 C YELLOW = 4 C ORANGE = 5 C PURPLE = 6 C BLACK = 7 C DATA (J4027(I),I=1,MAXCLR)/ 1 0, 7, 1, 3, 2, 6, 5, 3, 4, 4, 2 2, 3, 3, 1, 7, 0, 3, 5, 3, 1, 3 3, 2, 6, 3, 6, 4, 2, 4, 4, 7, 4 1, 4, 0, 3, 2, 1, 3, 3, 2, 4, 5 6, 2, 3, 2, 6, 6, 3, 3, 5, 6, 6 2, 1, 6, 6, 4, 2, 6, 3, 3, 2, 7 3, 4, 4, 6, 6, 4, 2, 3, 3, 3, 8 3, 3, 3, 3, 2, 2, 2, 4, 4, 4, 9 5, 5, 5, 1, 1, 1, 6, 6, 6/ C TEKTRONIX 4105, GENERAL, GENERAL CODED C C BLACK = 0 C WHITE = 1 C RED = 2 C GREEN = 3 C BLUE = 4 C CYAN = 5 C MAGENTA= 6 C YELLOW = 7 C DATA (J4105(I),I=1,MAXCLR)/ 1 1, 0, 2, 4, 3, 6, 2, 5, 7, 7, 2 3, 4, 4, 2, 0, 1, 4, 2, 4, 2, 3 4, 3, 6, 4, 6, 7, 3, 7, 7, 0, 4 2, 7, 1, 4, 3, 2, 4, 4, 3, 7, 5 6, 3, 4, 3, 6, 6, 4, 4, 2, 6, 6 3, 2, 6, 6, 7, 3, 6, 4, 4, 3, 7 4, 7, 7, 6, 6, 7, 3, 5, 4, 4, 8 4, 5, 5, 5, 3, 3, 3, 7, 7, 7, 9 7, 7, 7, 2, 2, 2, 6, 6, 6/ C C PLOTTERS WITH 4 PENS (TEKTRONIX 4662, HP-7221, CALCOMP, ZETA, HP-GL) C C BLACK = 1 C RED = 2 C BLUE = 3 C GREEN = 4 C DATA (JPLOT4(I),I=1,MAXCLR)/ 1 1, 1, 2, 3, 4, 4, 2, 3, 2, 2, 2 4, 3, 3, 2, 1, 1, 3, 2, 3, 2, 3 3, 4, 2, 3, 2, 2, 4, 2, 2, 1, 4 2, 2, 1, 3, 4, 2, 3, 3, 4, 2, 5 2, 4, 3, 4, 2, 2, 3, 3, 2, 2, 6 4, 2, 2, 2, 2, 4, 2, 3, 3, 4, 7 3, 2, 2, 2, 2, 2, 4, 3, 3, 3, 8 3, 3, 3, 3, 4, 4, 4, 2, 2, 2, 9 2, 2, 2, 2, 2, 2, 4, 4, 4/ C C PLOTTERS WITH 8 PENS (HP-GL, CALCOMP, ZETA) C C BLACK = 1 C RED = 2 C BLUE = 3 C GREEN = 4 C MAGENTA = 5 C ORANGE = 6 C CYAN = 7 C YELLOW = 8 C DATA (JPLOT8(I),I=1,MAXCLR)/ 1 1, 1, 2, 3, 4, 5, 6, 7, 8, 8, 2 4, 7, 3, 2, 1, 1, 3, 8, 3, 2, 3 3, 4, 5, 3, 5, 8, 4, 8, 8, 1, 4 2, 8, 1, 3, 4, 5, 7, 3, 4, 8, 5 5, 4, 7, 4, 5, 5, 3, 3, 6, 5, 6 4, 2, 5, 5, 8, 4, 5, 7, 3, 4, 7 3, 8, 8, 5, 5, 8, 4, 7, 3, 3, 8 3, 7, 7, 7, 4, 4, 4, 8, 8, 8, 9 6, 6, 6, 2, 2, 2, 5, 5, 5/ C C HP-2622 AND RELATED TERMINALS C C BLACK = 0 C RED = 1 C GREEN = 2 C YELLOW = 3 C BLUE = 4 C MAGENTA = 5 C CYAN = 6 C WHITE = 7 C DATA (J2622(I),I=1,MAXCLR)/ 1 7, 0, 1, 4, 2, 5, 3, 6, 3, 3, 2 2, 6, 4, 1, 0, 7, 6, 3, 4, 1, 3 4, 2, 5, 4, 5, 3, 2, 3, 3, 0, 4 1, 3, 7, 6, 2, 5, 6, 4, 2, 3, 5 5, 2, 6, 2, 5, 5, 4, 4, 3, 5, 6 2, 1, 5, 5, 3, 2, 5, 6, 4, 2, 7 4, 3, 3, 5, 5, 3, 2, 6, 4, 4, 8 4, 6, 6, 6, 2, 2, 2, 3, 3, 3, 9 3, 3, 3, 1, 1, 1, 5, 5, 5/ C C DIRECT RGB DEVICES (CGM, POSTSCRIPT) C C THESE DEVICES ALLOW THE RGB VALUE TO BE SPECIFIED DIRECTLY, C SO SIMPLY MAP TO SAME INDEX. GRSECO ROUTINE WILL THEN USE C A TABLE OF RGB VALUES. C DATA (JCGM(I),I=1,MAXCLR)/ 1 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 2 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 3 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 4 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 5 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 6 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 7 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 8 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 9 81, 82, 83, 84, 85, 86, 87, 88, 89/ C C SUN C C RED = 1 C GREEN = 2 C BLUE = 3 C YELLOW = 4 C BLACK = 5 C MAGENTA = 6 C WHITE = 7 C DARK = 0 (ONLY MAP DARK GRAY TO THIS, OTHERWISE USE BLACK) C DATA (JSUN(I),I=1,MAXCLR)/ 1 7, 5, 1, 3, 2, 6, 4, 3, 4, 4, 2 2, 3, 3, 1, 0, 7, 3, 4, 3, 1, 3 3, 2, 6, 3, 6, 4, 2, 4, 4, 0, 4 1, 4, 7, 3, 2, 6, 3, 3, 2, 4, 5 6, 2, 3, 2, 6, 6, 3, 3, 1, 6, 6 2, 1, 6, 6, 4, 2, 6, 3, 3, 2, 7 3, 4, 4, 6, 6, 4, 2, 3, 3, 3, 8 3, 3, 3, 3, 2, 2, 2, 4, 4, 4, 9 4, 4, 4, 1, 1, 1, 6, 6, 6/ C C X11 C C SUPPORTS FULL SET OF COLORS C DATA (JX11(I),I=1,MAXCLR)/ 1 1, 0, 4, 5, 2, 6, 8, 7, 3, 9, 2 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 3 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 4 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 5 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 6 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 7 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 8 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 9 80, 81, 82, 83, 84, 85, 86, 87, 88/ C C REGIS C C SUPPORTS FULL SET OF COLORS (WITH 1 OR 2 OMISSIONS) C DATA (JREGIS(I),I=1,MAXCLR)/ 1 62, 3, 47, 4, 23, 39, 41, 18, 63, 64, 2 24, 8, 60, 51, 35, 37, 1, 3, 5, 17, 3 6, 25, 43, 7, 57, 19, 26, 20, 21, 35, 4 48, 38, 36, 9, 27, 40, 2, 10, 28, 22, 5 44, 29, 11, 30, 58, 49, 12, 13, 50, 42, 6 31, 45, 46, 57, 52, 32, 53, 14, 15, 33, 7 16, 54, 55, 56, 59, 61, 34, 18, 4, 4, 8 4, 18, 18, 18, 23, 23, 23, 63, 63, 63, 9 41, 41, 41, 47, 47, 47, 39, 39, 39/ C C IBM-PC (TURBO-C DRIVER) C C BLACK = 0 C BLUE = 1 C GREEN = 2 C CYAN = 3 C RED = 4 C MAGENTA = 5 C BROWN = 6 C GRAY = 7 C DGRA = 8 C LBLUE = 9 C LGRAY =10 C LCYAN =11 C LRED =12 C LMAGE =13 C YELLOW =14 C WHITE =15 C C LRED, LMAGE ARE NOT IN THE SUPPORTED COLOR LIST. C LRED MAPS TO RED2 C LMAG MAPS TO MAG2 C DATA (JPC(I),I=1,MAXCLR)/ 1 15, 0, 4, 1, 2, 5, 14, 3, 14, 14, 2 2, 9, 1, 4, 8, 10, 3, 6, 9, 12, 3 1, 2, 5, 1, 5, 14, 2, 14, 14, 7, 4 12, 14, 10, 9, 2, 5, 11, 9, 2, 14, 5 5, 2, 9, 2, 13, 5, 1, 1, 4, 13, 6 2, 4, 5, 5, 14, 2, 5, 11, 1, 2, 7 1, 6, 14, 5, 5, 14, 2, 11, 1, 1, 8 1, 3, 3, 3, 2, 2, 2, 14, 14, 14, 9 14, 14, 14, 4, 4, 4, 5, 5, 5/ C C IBM-PC (LAHEY DRIVER) C C BLACK = 0 C BLUE = 1 C GREEN = 2 C CYAN = 3 C RED = 4 C MAGENTA = 5 C BROWN = 6 C GRAY = 7 C DGRA = 8 C LBLUE = 9 C LGRAY =10 C LCYAN =11 C LRED =12 C LMAGE =13 C YELLOW =14 C WHITE =15 C C LRED, LMAGE ARE NOT IN THE SUPPORTED COLOR LIST. C LRED MAPS TO RED2 C LMAG MAPS TO MAG2 C DATA (JLAHEY(I),I=1,MAXCLR)/ 1 15, 0, 4, 1, 2, 5, 14, 3, 14, 14, 2 2, 9, 1, 4, 8, 10, 3, 6, 9, 12, 3 1, 2, 5, 1, 5, 14, 2, 14, 14, 7, 4 12, 14, 10, 9, 2, 5, 11, 9, 2, 14, 5 5, 2, 9, 2, 13, 5, 1, 1, 4, 13, 6 2, 4, 5, 5, 14, 2, 5, 11, 1, 2, 7 1, 6, 14, 5, 5, 14, 2, 11, 1, 1, 8 1, 3, 3, 3, 2, 2, 2, 14, 14, 14, 9 14, 14, 14, 4, 4, 4, 5, 5, 5/ C C IBM-PC (LAHEY DRIVER, USING INTERACTOR OR WINTERACTOR) C THIS DRIVER SUPPORTS 16 COLORS, WITH EACH COLOR C SUPPORTING 16 SHADES. C C WHITE = 0 - 15 C LIGHT RED = 16 - 31 C DARK RED = 32 - 47 C LIGHT YELLOW = 48 - 63 C DARK YELLOW = 64 - 79 C LIGHT GREEN = 80 - 95 C DARK GREEN = 96 - 111 C LIGHT CYAN = 112 - 127 C DARK CYAN = 128 - 143 C LIGHT BLUE = 144 - 159 C DARK BLUE = 160 - 175 C LIGHT MAGENTA = 176 - 191 C DARK MAGENTA = 192 - 207 C BLACK = 208 - 223 C DARK GRAY = 224 - 239 C LIGHT GRAY = 240 - 255 C DATA (JWINT(I),I=1,MAXCLR)/ 1 0,223, 47,175,111,207, 31,143, 79, 80, 2111,144,207, 47,224,240, 80,223,160, 16, 3144,111,207,175, 96, 64, 95, 64, 64, 224, 4 32, 16,240,144, 80,192, 96,159, 96, 48, 5 32, 96,160, 96,192,192,143,128, 32, 32, 6 80, 16,176,207, 31, 95,127,159,160, 95, 7160, 16, 48,176,207, 63, 64,112,164,168, 8172,132,136,140,100,104,108, 68, 72, 76, 9 20, 24, 28, 36, 40, 44,196,200,204/ C C-----START POINT----------------------------------------------------- C C AUGUST 1992. BE CONSISTENT IN COLORS RECOGNIZED AND IN MAPPING C INDEX TO COLOR. EXCEPTION IS THAT PEN PLOTTERS WILL STILL TREAT C INDEX AS A SLOT NUMBER (SINCE SLOT NUMBERS MAY BE FILLED WITH AN C ARBITRARY COLOR). C C ***************************************************************** C ** DATAPLOT SUPPORTS THE FOLLOWING COLORS. THE TABLE SHOWS ** C ** THE DATAPLOT 4 CHARACTER NAME AND ASSOCIATED INDEX NUMBER. ** C ** THE SUPPORTED COLORS ARE THE "NAMED" COLORS IN THE COLOR ** C ** DATABASE IN RELEASE 3 OF X11. A FEW ADDITIONS ARE ADDED ** C ** FROM RELEASE 4 OF X11 (BUT NOT THE ENTIRE SET). THE SOURCE** C ** IS APPENDIX D OF THE XLIB PROGRAMMERS REFERENCE (VOL. II) ** C ** FROM O'REILLY AND ASSOCIATES. EVEN THOUGH WE ARE USING ** C ** THE RELEASE 3 LIST, USE THE RGB VALUES FROM RELEASE SINCE ** C ** RELEASE 3 WAS TUNED SPECIFICALLY TO A VT-240 WHILE RELEASE ** C ** 4 VALUES SHOULD BE A LITTLE MORE ROBUST. HOWEVER, THE ** C ** SAME RGB VALUES CAN PRODUCE DIFFERENT COLORS ON DIFFERENT ** C ** HARDWARE. ** C ** ** C ** X11 SUPPORTS THE FULL SET OF COLORS (SOME IMPLEMENTATIONS ** C ** MAY NOT, UNSUPPORTED COLORS MAPPED TO BLACK/WHITE). ** C ** POSTSCRIPT ALLOWS RGB VALUES TO BE SPECIFIED DIRECTLY. ** C ** CGM ALLOWS A COLOR TABLE TO BE DEFINED. ** C ** REGIS SUPPORTS 64 OF THE 67 COLORS FROM RELASE 3, NONE OF ** C ** THE ADDITIONS OF RELEASE 4. ** C ** MOST OTHER TERMINALS AND PLOTTERS SUPPORT 4 TO 8 COLORS, ** C ** UNAVAILABLE COLORS ARE MAPPED TO THE (HOPEFULLY) ** C ** CLOSEST SUPPORTED COLOR. PENPLOTTERS ASSUME PEN SLOTS ** C ** CONTAIN THE FOLLOWING COLORS: ** C ** 4 PENS 8 PENS: ** C ** ====== ======= ** C ** BLACK BLACK ** C ** RED RED ** C ** BLUE BLUE ** C ** GREEN GREEN ** C ** MAGENTA ** C ** ORANGE ** C ** CYAN ** C ** YELLOW ** C ** ** C ** USE THE PEN MAP COMMANDS IF A DIFFERENT* C ** ORDER IS USED. ** C ** ** C ** THE FOLLOWING IS THE LIST OF CURRENLT RECOGNIZED COLORS. ** C ** ** C ** COLOR INDEX DATAPLOT NAME RGB ** C ** ===== ===== ============= === ** C ** WHITE 0 WHIT 255, 255, 255 ** C ** BLACK 1 BLAC 0, 0, 0 ** C ** RED 2 RED 255, 0, 0 ** C ** BLUE 3 BLUE 0, 0, 255 ** C ** GREEN 4 GREE 0, 255, 0 ** C ** MAGENTA 5 MAGE 255, 0, 255 ** C ** ORANGE 6 ORAN 255, 165, 0 ** C ** CYAN 7 CYAN 0, 255, 255 ** C ** YELLOW 8 YELL 255, 255, 0 ** C ** YELLOW GREEN 9 YGRE 154, 205, 50 ** C ** DARK GREEN 10 DGRE 0, 100, 0 ** C ** LIGHT BLUE 11 LBLU 173, 216, 230 ** C ** BLUE VIOLET 12 VBLU 138, 43, 226 ** C ** VIOLET RED 13 VRED 208, 32, 144 ** C ** DARK SLATE GRAY 14 DGRE,DGRA,DGRY 47, 79, 79 ** C ** LIGHT GRAY 15 LGRE,LGRA,LGRY 211, 211, 211 ** C ** AQUAMARINE 16 AQUA 127, 255, 212 ** C ** BROWN 17 BROWN 165, 42, 42 ** C ** CADET BLUE 18 CABL 95, 158, 160 ** C ** CORAL 19 CORA 255, 127, 80 ** C ** CORNFLOWER BLUE 20 CBLU 100, 149, 237 ** C ** DARK OLIVE GREEN 21 DOGR 85, 107, 47 ** C ** DARK ORCHID 22 DORC 153, 50, 204 ** C ** DARK SLATE BLUE 23 DSBL 72, 61, 139 ** C ** DARK TURQUOISE 24 DTUR 0, 206, 209 ** C ** FIREBRICK 25 FIRE 178, 34, 34 ** C ** FOREST GREEN 26 FGRE 34, 139, 34 ** C ** GOLD 27 GOLD 255, 215, 0 ** C ** GOLDENROD 28 GLDR 218, 165, 32 ** C ** GRAY 29 GRAY, GREY 192, 192, 192 ** C ** INDIAN RED 30 IRED, LRED 205, 92, 92 ** C ** KHAKI 31 KHAK 240, 230, 140 ** C ** DIM GRAY 32 DMGR 105, 105, 105 ** C ** LIGHT STEEL BLUE 33 LSBL 176, 196, 222 ** C ** LIME GREEN 34 LGRE 50, 205, 50 ** C ** MAROON 35 MARO 176, 48, 96 ** C ** MEDIUM AQUAMARINE 36 MAQU 102, 205, 170 ** C ** MEDIUM BLUE 37 MBLU 0, 0, 205 ** C ** MEDIUM FOREST GREEN38 MFGR 107, 142, 35 ** C ** LIGHT GOLDENROD YEL39 MGLD 250, 250, 210 ** C ** MEDIUM ORCHID 40 MORC 186, 85, 211 ** C ** MEDIUM SEA GREEN 41 MSGR 60, 179, 113 ** C ** MEDIUM SLATE BLUE 42 MSBL 123, 104, 238 ** C ** MEDIUM SPRING GREEN43 MSPG 0, 250, 154 ** C ** MEDIUM TURQUOISE 44 MTUR, LMAG 72, 209, 204 ** C ** MEDIUM VIOLET RED 45 MVRD 199, 21, 133 ** C ** MIDNIGHT BLUE 46 MDBL 25, 25, 112 ** C ** NAVY BLUE 47 NAVY 0, 0, 128 ** C ** ORANGE RED 48 ORED 255, 69, 0 ** C ** ORCHID 49 ORCH 218, 112, 214 ** C ** PALE GREEN 50 PGRE 152, 251, 152 ** C ** PINK 51 PINK 255, 192, 203 ** C ** PLUM 52 PLUM 221, 160, 221 ** C ** PURPLE 53 PURP 160, 32, 240 ** C ** SALMON 54 SALM 250, 128, 114 ** C ** SEA GREEN 55 SGRE 46, 139, 87 ** C ** SIENNA 56 SIEN 160, 82, 45 ** C ** SKY BLUE 57 SKBL, SKYB, 135, 206, 235 ** C ** SLATE BLUE 58 SBLU 106, 90, 205 ** C ** SPRING GREEN 59 SPGR 0, 255, 127 ** C ** STEEL BLUE 60 STBL 70, 130, 180 ** C ** TAN 61 TAN 210, 180, 140 ** C ** THISTLE 62 THIS 216, 191, 216 ** C ** TURQUOISE 63 TURQ 64, 224, 208 ** C ** VIOLET 64 VIOL 238, 130, 238 ** C ** WHEAT 65 WHEA 245, 222, 179 ** C ** GREEN YELLOW 66 GYEL 173, 255, 47 ** C ** LIGHT CYAN 67 LCYA 224, 255, 255 ** C ** BLUE2 68 BLU2 0, 0, 238 ** C ** BLUE3 69 BLU3 0, 0, 205 ** C ** BLUE4 70 BLU4 0, 0, 139 ** C ** CYAN2 71 CYA2 0, 238, 238 ** C ** CYAN3 72 CYA3 0, 205, 205 ** C ** CYAN4 73 CYA4 0, 139, 139 ** C ** GREEN2 74 GRE2 0, 238, 0 ** C ** GREEN3 75 GRE3 0, 205, 0 ** C ** GREEN4 76 GRE4 0, 139, 0 ** C ** YELLOW2 77 YEL2 238, 238, 0 ** C ** YELLOW3 78 YEL3 205, 205, 0 ** C ** YELLOW4 79 YEL4 139, 139, 0 ** C ** ORANGE2 80 ORA2 238, 154, 0 ** C ** ORANGE3 81 ORA3 205, 133, 0 ** C ** ORANGE4 82 ORA4 139, 90, 0 ** C ** RED2 83 RED2, LRED 238, 0, 0 ** C ** RED3 84 RED3 205, 0, 0 ** C ** RED2 85 RED4 139, 0, 0 ** C ** MAGENTA2 86 MAG2, LMAG 238, 0, 238 ** C ** MAGENTA3 87 MAG3 205, 0, 205 ** C ** MAGENTA4 88 MAG4 139, 0, 139 ** C ** ** C ** SUPPORT GRAY SCALE WITH FOLLOWING SCHEME: ** C ** G0 = BLACK ** C ** G1-G99 = GRAY SCALE FROM BLACK TO WHITE ** C ** G100 = WHITE ** C ** -1 THROUGH -100 WILL CORRESPOND TO G1 THROUGH G100 ** C ** CURRENTLY, POSTSCRIPT, X11, AND CGM SUPPORT GRAY SCALE, ** C ** OTHER DEVICES WILL MAP TO BLACK OR WHITE ** C ***************************************************************** C C ********************************************** C ** MAP A COLOR NAME TO AN INDEX FOR THE ** C ** GENERIC CASE. ** C ********************************************** C JINDEX=-999 C C CHECK FOR SUPPORTED NAMES C DO40I=1,MAXCLR IF(ICOL.EQ.ICOLNM(I))THEN JINDEX=I-1 GOTO49 ENDIF 40 CONTINUE C C CHECK FOR SYNONYMS C IF(ICOL.EQ.'DGRY' .OR. ICOL.EQ.'DGRE')THEN JINDEX=14 ICOL='DGRE' ELSEIF(ICOL.EQ.'LGRY' .OR. ICOL.EQ.'LGRE')THEN JINDEX=15 ICOL='LGRA' ELSEIF(ICOL.EQ.'GREY')THEN JINDEX=29 ICOL='GRAY' ELSEIF(ICOL.EQ.'LRED')THEN JINDEX=83 ICOL='IRED' ELSEIF(ICOL.EQ.'LMAG')THEN JINDEX=44 ICOL='MTUR' ELSEIF(ICOL.EQ.'SKYB')THEN JINDEX=57 ICOL='SKBL' ENDIF 49 CONTINUE C C CHECK FOR INDEX (0 THROUGH MAXCLR-1) C CJUNK=' ' DO1I=0,9 WRITE(CJUNK(1:1),'(I1)')I IF(ICOL(1:4).EQ.CJUNK(1:4))THEN JINDEX=I GOTO9 ENDIF 1 CONTINUE 9 CONTINUE CJUNK=' ' DO11I=10,MAXCLR-1 WRITE(CJUNK(1:2),'(I2)')I IF(ICOL(1:4).EQ.CJUNK(1:4))THEN JINDEX=I GOTO19 ENDIF 11 CONTINUE 19 CONTINUE C C CHECK FOR GREY SCALE (G0 - G100 OR -1 THROUGH -100) C IF(ICOL.EQ.'G0')JINDEX=1 IF(ICOL.EQ.'G100')JINDEX=0 IF(ICOL.EQ.'-100')JINDEX=0 IF(ICOL(1:1).EQ.'G'.OR.ICOL(1:1).EQ.'-')THEN CJUNK=' ' DO21I=1,9 WRITE(CJUNK(1:1),'(I1)')I IF(ICOL(2:4).EQ.CJUNK(1:3))THEN JINDEX=-I GOTO29 ENDIF 21 CONTINUE 29 CONTINUE CJUNK=' ' DO31I=10,99 WRITE(CJUNK(1:2),'(I2)')I IF(ICOL(2:4).EQ.CJUNK(1:3))THEN JINDEX=-I GOTO39 ENDIF 31 CONTINUE 39 CONTINUE ENDIF C ISUBN0='TRCO' C NCSTR=(-999) C IERRG4='NO' C IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRCO')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF GRTRCO--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)IMANUF,IMODEL,IMODE2,IMODE3 52 FORMAT('IMANUF,IMODEL,IMODE2,IMODE3 = ',A4,2X,A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)IGUNIT,IGCODE 53 FORMAT('IGUNIT,IGCODE = ',I8,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,54)ISOFT,ISOFT2,ISOFT3 54 FORMAT('ISOFT,ISOFT2,ISOFT3 = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,55)IGBAUD 55 FORMAT('IGBAUD = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,62)ICASE 62 FORMAT('ICASE = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,63)ICOL 63 FORMAT('ICOL = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,64)IMANUF,IMODEL 64 FORMAT('IMANUF,IMODEL = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,69)IBUGG4 69 FORMAT('IBUGG4 = ',A4) CALL DPWRST('XXX','BUG ') 90 CONTINUE C C ******************************************** C ** STEP 1-- ** C ** BRANCH ACCORDING TO THE MANUFACTURER ** C ** AND THE MODEL ** C ******************************************** C IF(IMANUF.EQ.'TEKT')GOTO1005 IF(IMANUF.EQ.'HP')GOTO1010 IF(IMANUF.EQ.'PCL')GOTO1015 IF(IMANUF.EQ.'GENE')GOTO1020 IF(IMANUF.EQ.'CALC')GOTO1025 IF(IMANUF.EQ.'ZETA')GOTO1030 IF(IMANUF.EQ.'RAMT')GOTO1035 IF(IMANUF.EQ.'SUN ')GOTO1040 IF(IMANUF.EQ.'XXXX')GOTO1045 IF(IMANUF.EQ.'REGI')GOTO1050 IF(IMANUF.EQ.'POST')GOTO1055 IF(IMANUF.EQ.'QUIC')GOTO1060 IF(IMANUF.EQ.'X11 ')GOTO1065 IF(IMANUF.EQ.'TURB')GOTO1070 IF(IMANUF.EQ.'GKS ')GOTO1075 IF(IMANUF.EQ.'LAHE')GOTO1080 IF(IMANUF.EQ.'GD ')GOTO1085 IF(IMANUF.EQ.'QWIN')GOTO1090 IF(IMANUF.EQ.'AQUA')GOTO1091 IF(IMANUF.EQ.'OPGL')GOTO1095 IF(IMANUF.EQ.'PRIN')GOTO1096 IF(IMANUF.EQ.'MACI')GOTO1098 IF(IMANUF.EQ.'LATE')GOTO1097 IF(IMANUF.EQ.'SVG ')GOTO1099 GOTO9000 C 1005 CONTINUE IF(IMODEL.EQ.'4027')GOTO1100 IF(IMODEL.EQ.'4105')GOTO1200 IF(IMODEL.EQ.'4107')GOTO1200 IF(IMODEL.EQ.'4109')GOTO1200 IF(IMODEL.EQ.'4115')GOTO1200 IF(IMODEL.EQ.'4662')GOTO1300 C GOTO1200 C 1010 CONTINUE IF(IMODEL.EQ.'7221')GOTO2100 IF(IMODEL.EQ.'2622')GOTO2300 IF(IMODEL.EQ.'2623')GOTO2300 IF(IMODEL.EQ.'2627')GOTO2300 IF(IMODEL.EQ.'2647')GOTO2300 GOTO2200 C 1015 CONTINUE GOTO2600 C 1020 CONTINUE IF(IMODEL.EQ.'CODE')GOTO3200 IF(IMODEL.EQ.'CGM')GOTO3300 IF(IMODEL.EQ.'CGMB')GOTO3400 GOTO3100 C 1025 CONTINUE GOTO4100 C 1030 CONTINUE GOTO5100 C 1035 CONTINUE GOTO6100 C 1040 CONTINUE C IF(IMODEL.EQ.'COLO')GOTO6600 C GOTO6700 GOTO6600 C 1045 CONTINUE GOTO7100 C 1050 CONTINUE GOTO8100 C 1055 CONTINUE IF(IMODEL.EQ.'DISP')GOTO8900 GOTO8600 C 1060 CONTINUE GOTO9100 C 1065 CONTINUE GOTO9600 C 1070 CONTINUE GOTO10000 C 1075 CONTINUE GOTO11000 C 1080 CONTINUE IF(IMODEL.EQ.'INTE')GOTO4900 IF(IMODEL.EQ.'WINT')GOTO4950 GOTO4600 C 1085 CONTINUE IF(IMODEL.EQ.'JPEG')GOTO12000 IF(IMODEL.EQ.'PNG ')GOTO12000 IF(IMODEL.EQ.'WBMP')GOTO12000 IF(IMODEL.EQ.'GIF')GOTO12000 GOTO12000 C 1090 CONTINUE GOTO4700 C 1091 CONTINUE GOTO13500 C 1095 CONTINUE GOTO4800 C 1096 CONTINUE GOTO14000 C 1097 CONTINUE GOTO15000 C 1098 CONTINUE GOTO13000 C 1099 CONTINUE GOTO16000 C C ****************************************************** C ** STEP 11-- ** C ** TREAT THE 4027 CASE ** C ** (COLOR DEVICE) ** C ** REFERENCE--XXX ** C ****************************************************** C 1100 CONTINUE JCOL=0 CCCCC IF(ICOL.EQ.'WHIT')JCOL=0 CCCCC IF(ICOL.EQ.'RED')JCOL=1 CCCCC IF(ICOL.EQ.'GREE')JCOL=2 CCCCC IF(ICOL.EQ.'BLUE')JCOL=3 CCCCC IF(ICOL.EQ.'YELL')JCOL=4 CCCCC IF(ICOL.EQ.'ORAN')JCOL=5 CCCCC IF(ICOL.EQ.'PURP')JCOL=6 CCCCC IF(ICOL.EQ.'BLAC')JCOL=7 C CCCCC IF(ICOL.EQ.'0')JCOL=0 CCCCC IF(ICOL.EQ.'1')JCOL=1 CCCCC IF(ICOL.EQ.'2')JCOL=2 CCCCC IF(ICOL.EQ.'3')JCOL=3 CCCCC IF(ICOL.EQ.'4')JCOL=4 CCCCC IF(ICOL.EQ.'5')JCOL=5 CCCCC IF(ICOL.EQ.'6')JCOL=6 CCCCC IF(ICOL.EQ.'7')JCOL=7 IF(JINDEX.LT.0)JCOL=0 IF(JINDEX.GE.0)JCOL=J4027(JINDEX+1) GOTO9000 C C ****************************************************** C ** STEP 12-- ** C ** TREAT THE 4105 CASE ** C ** (COLOR DEVICE) ** C ** REFERENCE--PROGRAMMER'S MANUAL, PAGE 5-50 ** C ****************************************************** C 1200 CONTINUE JCOL=0 CCCCC IF(ICOL.EQ.'BLAC')JCOL=0 CCCCC IF(ICOL.EQ.'WHIT')JCOL=1 CCCCC IF(ICOL.EQ.'RED')JCOL=2 CCCCC IF(ICOL.EQ.'GREE')JCOL=3 CCCCC IF(ICOL.EQ.'BLUE')JCOL=4 CCCCC IF(ICOL.EQ.'CYAN')JCOL=5 CCCCC IF(ICOL.EQ.'MAGE')JCOL=6 CCCCC IF(ICOL.EQ.'YELL')JCOL=7 C CCCCC IF(ICOL.EQ.'0')JCOL=0 CCCCC IF(ICOL.EQ.'1')JCOL=1 CCCCC IF(ICOL.EQ.'2')JCOL=2 CCCCC IF(ICOL.EQ.'3')JCOL=3 CCCCC IF(ICOL.EQ.'4')JCOL=4 CCCCC IF(ICOL.EQ.'5')JCOL=5 CCCCC IF(ICOL.EQ.'6')JCOL=6 CCCCC IF(ICOL.EQ.'7')JCOL=7 IF(JINDEX.LT.0)JCOL=0 IF(JINDEX.GE.0)JCOL=J4105(JINDEX+1) GOTO9000 C C ****************************************************** C ** STEP 13-- ** C ** TREAT THE 4662 CASE ** C ** (PENPLOTTER) ** C ** REFERENCE--XXX ** C ****************************************************** C 1300 CONTINUE JCOL=1 CCCCC IF(ICOL.EQ.'BLAC')JCOL=1 CCCCC IF(ICOL.EQ.'RED')JCOL=2 CCCCC IF(ICOL.EQ.'BLUE')JCOL=3 CCCCC IF(ICOL.EQ.'GREE')JCOL=4 C CCCCC IF(ICOL.EQ.'1')JCOL=1 CCCCC IF(ICOL.EQ.'2')JCOL=2 CCCCC IF(ICOL.EQ.'3')JCOL=3 CCCCC IF(ICOL.EQ.'4')JCOL=4 CCCCC IF(ICOL.EQ.'5')JCOL=5 CCCCC IF(ICOL.EQ.'6')JCOL=6 CCCCC IF(ICOL.EQ.'7')JCOL=7 CCCCC IF(ICOL.EQ.'8')JCOL=8 IF(JINDEX.LT.0)JCOL=1 IF(JINDEX.GE.0)JCOL=JPLOT4(JINDEX+1) GOTO9000 C C ****************************************************** C ** STEP 21-- ** C ** TREAT THE HEWLETT-PACKARD 7221 CASE ** C ** (MULTI-COLOR PENPLOTTER) ** C ** REFERENCE--HP 7221A GRAPHICS PLOTTER ** C ** OPERATING AND PROGRAMMING MANUAL, ** C ** PAGE 6 . ** C ****************************************************** C 2100 CONTINUE JCOL=1 CCCCC IF(ICOL.EQ.'BLAC')JCOL=1 CCCCC IF(ICOL.EQ.'RED')JCOL=2 CCCCC IF(ICOL.EQ.'BLUE')JCOL=3 CCCCC IF(ICOL.EQ.'GREE')JCOL=4 C CCCCC IF(ICOL.EQ.'0')JCOL=0 CCCCC IF(ICOL.EQ.'1')JCOL=1 CCCCC IF(ICOL.EQ.'2')JCOL=2 CCCCC IF(ICOL.EQ.'3')JCOL=3 CCCCC IF(ICOL.EQ.'4')JCOL=4 CCCCC IF(ICOL.EQ.'5')JCOL=5 CCCCC IF(ICOL.EQ.'6')JCOL=6 CCCCC IF(ICOL.EQ.'7')JCOL=7 CCCCC IF(ICOL.EQ.'8')JCOL=8 IF(JINDEX.LT.0)JCOL=1 IF(JINDEX.GE.0)JCOL=JPLOT8(JINDEX+1) GOTO9000 C C ****************************************************** C ** STEP 22-- ** C ** TREAT THE HEWLETT-PACKARD HP-GL CASES ** C ** (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS) ** C ** (MULTI-COLOR PENPLOTTERS) ** C ** REFERENCE--HP 9872C GRAPHICS PLOTTER ** C ** OPERATING AND PROGRAMMING MANUAL, ** C ** PAGE XX, XXX. ** C ****************************************************** C C UPDATED MAY, 1990 FOR "PEN MAP" C 2200 CONTINUE C IF(IHPGPF.EQ.'ON')GOTO2210 C JCOL=1 CCCCC IF(ICOL.EQ.'BLAC')JCOL=1 CCCCC IF(ICOL.EQ.'WHIT')JCOL=1 CCCCC IF(ICOL.EQ.'RED')JCOL=2 CCCCC IF(ICOL.EQ.'BLUE')JCOL=3 CCCCC IF(ICOL.EQ.'GREE')JCOL=4 CCCCC IF(ICOL.EQ.'MAGE')JCOL=5 CCCCC IF(ICOL.EQ.'ORAN')JCOL=6 CCCCC IF(ICOL.EQ.'CYAN')JCOL=7 CCCCC IF(ICOL.EQ.'YELL')JCOL=8 C CCCCC IF(ICOL.EQ.'0')JCOL=0 CCCCC IF(ICOL.EQ.'1')JCOL=1 CCCCC IF(ICOL.EQ.'2')JCOL=2 CCCCC IF(ICOL.EQ.'3')JCOL=3 CCCCC IF(ICOL.EQ.'4')JCOL=4 CCCCC IF(ICOL.EQ.'5')JCOL=5 CCCCC IF(ICOL.EQ.'6')JCOL=6 CCCCC IF(ICOL.EQ.'7')JCOL=7 CCCCC IF(ICOL.EQ.'8')JCOL=8 IF(JINDEX.LT.0)JCOL=1 IF(JINDEX.GE.0)JCOL=JPLOT8(JINDEX+1) IF(JCOL.GT.IHPGCL)JCOL=MOD(JCOL-1,IHPGCL)+1 GOTO9000 C 2210 CONTINUE JCOL=1 DO2219I=1,16 IF(ICOL(1:4).NE.IHPGPM(I)(1:4))GOTO2219 JCOL=I GOTO2299 2219 CONTINUE C IF(ICOL.EQ.'0')JCOL=0 IF(ICOL.EQ.'1')JCOL=1 IF(ICOL.EQ.'2')JCOL=2 IF(ICOL.EQ.'3')JCOL=3 IF(ICOL.EQ.'4')JCOL=4 IF(ICOL.EQ.'5')JCOL=5 IF(ICOL.EQ.'6')JCOL=6 IF(ICOL.EQ.'7')JCOL=7 IF(ICOL.EQ.'8')JCOL=8 C 2299 CONTINUE IF(JCOL.GT.IHPGCL)JCOL=1 C GOTO9000 C C ********************************************************** C ** STEP 23-- ** C ** TREAT THE HEWLETT-PACKARD HP-2622 CASES ** C ** (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS) ** C ** (MONOCHROME DISPLAY TERMINALS) ** C ** REFERENCE--HP 2322C GRAPHICS PLOTTER ** C ** REFERENCE MANUAL, ** C ** PAGE XX-X, XXX. ** C ********************************************************** C 2300 CONTINUE JCOL=7 CCCCC IF(ICOL.EQ.'BLAC')JCOL=0 CCCCC IF(ICOL.EQ.'WHIT')JCOL=7 CCCCC IF(ICOL.EQ.'RED')JCOL=1 CCCCC IF(ICOL.EQ.'BLUE')JCOL=4 CCCCC IF(ICOL.EQ.'GREE')JCOL=2 CCCCC IF(ICOL.EQ.'MAGE')JCOL=5 CCCCC IF(ICOL.EQ.'PURP')JCOL=5 CCCCC IF(ICOL.EQ.'ORAN')JCOL=3 CCCCC IF(ICOL.EQ.'CYAN')JCOL=6 CCCCC IF(ICOL.EQ.'YELL')JCOL=3 C CCCCC IF(ICOL.EQ.'0')JCOL=0 CCCCC IF(ICOL.EQ.'1')JCOL=1 CCCCC IF(ICOL.EQ.'2')JCOL=2 CCCCC IF(ICOL.EQ.'3')JCOL=3 CCCCC IF(ICOL.EQ.'4')JCOL=4 CCCCC IF(ICOL.EQ.'5')JCOL=5 CCCCC IF(ICOL.EQ.'6')JCOL=6 CCCCC IF(ICOL.EQ.'7')JCOL=7 CCCCC IF(ICOL.EQ.'8')JCOL=8 IF(JINDEX.LT.0)JCOL=7 IF(JINDEX.GE.0)JCOL=J2622(JINDEX+1) GOTO9000 C C ****************************************************** C ** STEP 26-- ** C ** TREAT THE PCL CASE (LASERJET PRINTERS) ** C ** BLACK AND WHITE DEVICE, HOWEVER CAN USE ** C ** "DOT DENSITY" TO SIMULATE COLOR ** C ** USED FOR REGIONS THAT ARE SOLID FILLED ** C ** REFERENCE--LASERJET SERIES II TECHNICAL REFERENCE* C ****************************************************** C 2600 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 31-- ** C ** TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE ** C ****************************************************** C 3100 CONTINUE C DECEMBER 1987: SET JCOL FOR GRERSC ROUTINE JCOL=0 CCCCC IF(ICOL.EQ.'BLAC')JCOL=0 CCCCC IF(ICOL.EQ.'WHIT')JCOL=1 CCCCC IF(ICOL.EQ.'RED')JCOL=2 CCCCC IF(ICOL.EQ.'GREE')JCOL=3 CCCCC IF(ICOL.EQ.'BLUE')JCOL=4 CCCCC IF(ICOL.EQ.'CYAN')JCOL=5 CCCCC IF(ICOL.EQ.'MAGE')JCOL=6 CCCCC IF(ICOL.EQ.'YELL')JCOL=7 C CCCCC IF(ICOL.EQ.'0')JCOL=0 CCCCC IF(ICOL.EQ.'1')JCOL=1 CCCCC IF(ICOL.EQ.'2')JCOL=2 CCCCC IF(ICOL.EQ.'3')JCOL=3 CCCCC IF(ICOL.EQ.'4')JCOL=4 CCCCC IF(ICOL.EQ.'5')JCOL=5 CCCCC IF(ICOL.EQ.'6')JCOL=6 CCCCC IF(ICOL.EQ.'7')JCOL=7 IF(JINDEX.LT.0)JCOL=0 IF(JINDEX.GE.0)JCOL=J4105(JINDEX+1) GOTO9000 C C *************************************************************** C ** STEP 32-- ** C ** TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE ** C *************************************************************** C 3200 CONTINUE C DECEMBER 1987: SET JCOL FOR GRERSC ROUTINE JCOL=0 CCCCC IF(ICOL.EQ.'BLAC')JCOL=0 CCCCC IF(ICOL.EQ.'WHIT')JCOL=1 CCCCC IF(ICOL.EQ.'RED')JCOL=2 CCCCC IF(ICOL.EQ.'GREE')JCOL=3 CCCCC IF(ICOL.EQ.'BLUE')JCOL=4 CCCCC IF(ICOL.EQ.'CYAN')JCOL=5 CCCCC IF(ICOL.EQ.'MAGE')JCOL=6 CCCCC IF(ICOL.EQ.'YELL')JCOL=7 C CCCCC IF(ICOL.EQ.'0')JCOL=0 CCCCC IF(ICOL.EQ.'1')JCOL=1 CCCCC IF(ICOL.EQ.'2')JCOL=2 CCCCC IF(ICOL.EQ.'3')JCOL=3 CCCCC IF(ICOL.EQ.'4')JCOL=4 CCCCC IF(ICOL.EQ.'5')JCOL=5 CCCCC IF(ICOL.EQ.'6')JCOL=6 CCCCC IF(ICOL.EQ.'7')JCOL=7 IF(JINDEX.LT.0)JCOL=0 IF(JINDEX.GE.0)JCOL=J4105(JINDEX+1) GOTO9000 C C ****************************************************** C ** STEP 33-- ** C ** TREAT THE CGM (DEVICE-INDEPENDENT) CASE ** C ** NOTE: INDEX 0 IS RESERVED FOR THE BACKGROUND ** C ** COLOR. ** C ** NOTE: CGM ALSO ALLOWS COLORS TO BE SPECIFED BY ** C ** RGB COMPONENT RATHER THAN BY AN INDEX. A ** C ** FUTURE ENHANCEMENT WOULD BE TO SPECIFY ** C ** COLORS IN THIS FORMAT (SO BLUE WOULD BE ** C ** AN ACTUAL BLUE RATHER THAN AN ARBITRARY ** C ** INDEX NUMBER). ** C ** AUGUST 1992. USE RGB VALUES ** C ****************************************************** C 3300 CONTINUE JCOL=2 CCCCC IF(ICOL.EQ.'BLAC')JCOL=1 CCCCC IF(ICOL.EQ.'WHIT')JCOL=8 CCCCC IF(ICOL.EQ.'RED')JCOL=2 CCCCC IF(ICOL.EQ.'GREE')JCOL=3 CCCCC IF(ICOL.EQ.'BLUE')JCOL=4 CCCCC IF(ICOL.EQ.'CYAN')JCOL=5 CCCCC IF(ICOL.EQ.'MAGE')JCOL=6 CCCCC IF(ICOL.EQ.'YELL')JCOL=7 C CCCCC IF(ICOL.LE.'1')JCOL=1 CCCCC IF(ICOL.EQ.'1')JCOL=1 CCCCC IF(ICOL.EQ.'2')JCOL=2 CCCCC IF(ICOL.EQ.'3')JCOL=3 CCCCC IF(ICOL.EQ.'4')JCOL=4 CCCCC IF(ICOL.EQ.'5')JCOL=5 CCCCC IF(ICOL.EQ.'6')JCOL=6 CCCCC IF(ICOL.EQ.'7')JCOL=7 CCCCC IF(ICOL.GE.'8')JCOL=8 IF(JINDEX.LT.0)JCOL=2 IF(JINDEX.GE.0)JCOL=JCGM(JINDEX+1) GOTO9000 C C *************************************************** C ** STEP 34-- ** C ** TREAT THE CGM (BINARY) CASE ** C *************************************************** C 3400 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 41-- ** C ** TREAT THE CALCOMP XXXXXX CASE ** C ** USE CALCOMP LIBRARY (ROUTINE NEWPEN SELECTS PEN)** C ** REFERENCE--XX ** C ** XX ** C ** PAGES XX AND XX ** C ****************************************************** C 4100 CONTINUE CCCCC WRITE(IGUNIT,4111) C4111 FORMAT('FIX SUBROUTINE GRTRCO TO TRANSL. COL. CALCOMP DEVICE') CCCCC ICSTR(1:52)='FIX SUBROUTINE GRTRCO TO TRANSL. COL. CALCOMP DEVICE' CCCCC NCSTR=52 CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0) C C UPDATE MAY, 1990. C 1) CHANGE DEFAULT ORDER FROM BLACK, RED, BLUE, GREEN TO BLACK, RED, C GREEN, BLUE (TO CORRESPOND TO DEFAULT ORDER IN NIST ZETA LIBRARY) C 2) DIFFERENT DEFAULT MAPPING BASED ON WHETHER 4 (OR LESS) OR MORE THAN 4 C 3) CHECK FOR USER DEFINED PEN MAPPING C IF(ICALPF.EQ.'ON')GOTO4130 C CCCCC IF(ICALCL.GT.4)GOTO4120 C CCCCC JCOL=1 CCCCC IF(ICOL.EQ.'BLAC'.OR.ICOL.EQ.'WHIT')JCOL=1 CCCCC IF(ICOL.EQ.'RED'.OR.ICOL.EQ.'ORAN'.OR.ICOL.EQ.'YELL')JCOL=2 CCCCC IF(ICOL.EQ.'BLUE'.OR.ICOL.EQ.'CYAN')JCOL=3 CCCCC IF(ICOL.EQ.'GREE'.OR.ICOL.EQ.'MAGE'.OR.ICOL.EQ.'PURP')JCOL=4 C CCCCC IF(ICOL.EQ.'1')JCOL=1 CCCCC IF(ICOL.EQ.'2')JCOL=2 CCCCC IF(ICOL.EQ.'3')JCOL=3 CCCCC IF(ICOL.EQ.'4')JCOL=4 CCCCC IF(ICOL.EQ.'5')JCOL=1 CCCCC IF(ICOL.EQ.'6')JCOL=2 CCCCC IF(ICOL.EQ.'7')JCOL=3 CCCCC IF(ICOL.EQ.'8')JCOL=4 CCCCC GOTO4199 C C4120 CONTINUE JCOL=1 CCCCC IF(ICOL.EQ.'BLAC'.OR.ICOL.EQ.'WHIT')JCOL=1 CCCCC IF(ICOL.EQ.'RED')JCOL=2 CCCCC IF(ICOL.EQ.'BLUE')JCOL=3 CCCCC IF(ICOL.EQ.'GREE')JCOL=4 CCCCC IF(ICOL.EQ.'CYAN')JCOL=5 CCCCC IF(ICOL.EQ.'MAGE'.OR.ICOL.EQ.'PURP')JCOL=6 CCCCC IF(ICOL.EQ.'YELL'.OR.ICOL.EQ.'ORAN')JCOL=7 C CCCCC IF(ICOL.EQ.'1')JCOL=1 CCCCC IF(ICOL.EQ.'2')JCOL=2 CCCCC IF(ICOL.EQ.'3')JCOL=3 CCCCC IF(ICOL.EQ.'4')JCOL=4 CCCCC IF(ICOL.EQ.'5')JCOL=5 CCCCC IF(ICOL.EQ.'6')JCOL=6 CCCCC IF(ICOL.EQ.'7')JCOL=7 CCCCC IF(ICOL.EQ.'8')JCOL=8 IF(JINDEX.LT.0)JCOL=1 IF(JINDEX.GE.0)JCOL=JPLOT8(JINDEX+1) IF(JCOL.GT.ICALCL)JCOL=MOD(JCOL-1,ICALCL)+1 GOTO4199 C 4130 CONTINUE JCOL=1 DO4139I=1,16 IF(ICOL(1:4).NE.ICALPM(I)(1:4))GOTO4139 JCOL=I GOTO4199 4139 CONTINUE C IF(ICOL.EQ.'0')JCOL=0 IF(ICOL.EQ.'1')JCOL=1 IF(ICOL.EQ.'2')JCOL=2 IF(ICOL.EQ.'3')JCOL=3 IF(ICOL.EQ.'4')JCOL=4 IF(ICOL.EQ.'5')JCOL=5 IF(ICOL.EQ.'6')JCOL=6 IF(ICOL.EQ.'7')JCOL=7 IF(ICOL.EQ.'8')JCOL=8 GOTO4199 C 4199 CONTINUE IF(JCOL.GT.ICALCL)JCOL=1 GOTO9000 C C ****************************************************** C ** STEP 46-- ** C ** TREAT THE LAHEY XXXXXX CASE ** C ** REFERENCE--Programmer's Reference, Revision C ** C ** Lahey Computer Systems, January, 1992** C ** PAGES 51 THRU 65 ** C ****************************************************** C 4600 CONTINUE IF(ILAHPF.EQ.'ON')GOTO4630 JCOL=1 IF(JINDEX.LT.0)JCOL=1 IF(JINDEX.GE.0)JCOL=JLAHEY(JINDEX+1) IF(JCOL.GT.ILAHNC)JCOL=MOD(JCOL-1,ILAHNC)+1 GOTO4699 C 4630 CONTINUE JCOL=1 DO4639I=1,16 IF(ICOL(1:4).NE.ILAHPM(I)(1:4))GOTO4639 JCOL=I GOTO4699 4639 CONTINUE C IF(ICOL.EQ.'0')JCOL=0 IF(ICOL.EQ.'1')JCOL=1 IF(ICOL.EQ.'2')JCOL=2 IF(ICOL.EQ.'3')JCOL=3 IF(ICOL.EQ.'4')JCOL=4 IF(ICOL.EQ.'5')JCOL=5 IF(ICOL.EQ.'6')JCOL=6 IF(ICOL.EQ.'7')JCOL=7 IF(ICOL.EQ.'8')JCOL=8 GOTO4699 C 4699 CONTINUE IF(JCOL.GT.ILAHNC)JCOL=1 GOTO9000 C C ****************************************************** C ** STEP 47-- ** C ** TREAT THE MICROSOFT QUICKWIN DRIVER ** C ** FOR WINDOWS 95 AND WINDOWS NT. ** C ****************************************************** C 4700 CONTINUE IF(IQWNCL.EQ.'VGA')THEN JCOL=0 IF(JINDEX.LT.0)JCOL=0 IF(JINDEX.GE.0)JCOL=JPC(JINDEX+1) ELSEIF(IQWNCL.EQ.'RGB')THEN JCOL=1 IF(JINDEX.LT.0)JCOL=JINDEX IF(JINDEX.GE.0)JCOL=JCGM(JINDEX+1) ELSE JCOL=0 IF(JINDEX.LT.0)JCOL=0 IF(JINDEX.GE.0)JCOL=JPC(JINDEX+1) ENDIF GOTO9000 C C ****************************************************** C ** STEP 48-- ** C ** TREAT THE OPEN-GL DRIVER ** C ** FOR WINDOWS 95 AND WINDOWS NT AND X11 ** C ****************************************************** C 4800 CONTINUE JCOL=0 C IF(JINDEX.LT.0)JCOL=JINDEX IF(JINDEX.GE.0)JCOL=JCGM(JINDEX+1) GOTO9000 C C ****************************************************** C ** STEP 49-- ** C ** TREAT THE LAHEY INTERACTOR CASE ** C ****************************************************** C 4900 CONTINUE JCOL=223 IF(JINDEX.LT.0)THEN JCOL=224 + INT((REAL(-JINDEX)/100.)*31. + 0.5) IF(JCOL.LT.224)JCOL=224 IF(JCOL.GT.255)JCOL=255 ENDIF IF(JINDEX.GE.0)JCOL=JWINT(JINDEX+1) GOTO9000 C C ****************************************************** C ** STEP 49B- ** C ** TREAT THE LAHEY WINTERACTOR CASE ** C ****************************************************** C 4950 CONTINUE IF(IWINCL.EQ.'VGA')THEN JCOL=223 IF(JINDEX.LT.0)THEN JCOL=224 + INT((REAL(-JINDEX)/100.)*31. + 0.5) IF(JCOL.LT.224)JCOL=224 IF(JCOL.GT.255)JCOL=255 ELSE JCOL=JWINT(JINDEX) ENDIF ELSEIF(IWINCL.EQ.'RGB')THEN JCOL=2 IF(JINDEX.LT.0)JCOL=JINDEX IF(JINDEX.GE.0)JCOL=JCGM(JINDEX+1) ELSE JCOL=223 IF(JINDEX.LT.0)THEN JCOL=224 + INT((REAL(-JINDEX)/100.)*31. + 0.5) IF(JCOL.LT.224)JCOL=224 IF(JCOL.GT.255)JCOL=255 ELSE JCOL=JWINT(JINDEX) ENDIF ENDIF GOTO9000 C C C ****************************************************** C ** STEP 51-- ** C ** TREAT THE ZETA 3600SX AND 3653SX CASES ** C ** REFERENCE--USER MANUAL FOR DIGITAL PLOTTER ** C ** MODELS 3600SX AND 3653SX ** C ** PAGES B-0 AND B-1 ** C ** USE CALCOMP LIBRARY ROUTINES ** C ****************************************************** C C UPDATE MAY, 1990. C 1) CHANGE DEFAULT ORDER FROM BLACK, RED, BLUE, GREEN TO BLACK, RED, C GREEN, BLUE (TO CORRESPOND TO DEFAULT ORDER IN NIST ZETA LIBRARY) C 2) DIFFERENT DEFAULT MAPPING BASED ON WHETHER 4 (OR LESS) OR MORE THAN 4 C 3) CHECK FOR USER DEFINED PEN MAPPING C 5100 CONTINUE CCCCC JCOL=71 CCCCC IF(ICOL.EQ.'BLAC')JCOL=71 CCCCC IF(ICOL.EQ.'RED')JCOL=72 CCCCC IF(ICOL.EQ.'BLUE')JCOL=73 CCCCC IF(ICOL.EQ.'GREE')JCOL=74 C CCCCC IF(ICOL.EQ.'1')JCOL=71 CCCCC IF(ICOL.EQ.'2')JCOL=72 CCCCC IF(ICOL.EQ.'3')JCOL=73 CCCCC IF(ICOL.EQ.'4')JCOL=74 CCCCC IF(ICOL.EQ.'5')JCOL=75 CCCCC IF(ICOL.EQ.'6')JCOL=76 CCCCC IF(ICOL.EQ.'7')JCOL=77 CCCCC IF(ICOL.EQ.'8')JCOL=78 C IF(IZETPF.EQ.'ON')GOTO5130 C CCCCC IF(IZETCL.GT.4)GOTO5120 C CCCCC JCOL=1 CCCCC IF(ICOL.EQ.'BLAC'.OR.ICOL.EQ.'WHIT')JCOL=1 CCCCC IF(ICOL.EQ.'RED'.OR.ICOL.EQ.'ORAN'.OR.ICOL.EQ.'YELL')JCOL=2 CCCCC IF(ICOL.EQ.'BLUE'.OR.ICOL.EQ.'CYAN')JCOL=3 CCCCC IF(ICOL.EQ.'GREE'.OR.ICOL.EQ.'MAGE'.OR.ICOL.EQ.'PURP')JCOL=4 C CCCCC IF(ICOL.EQ.'1')JCOL=1 CCCCC IF(ICOL.EQ.'2')JCOL=2 CCCCC IF(ICOL.EQ.'3')JCOL=3 CCCCC IF(ICOL.EQ.'4')JCOL=4 CCCCC IF(ICOL.EQ.'5')JCOL=1 CCCCC IF(ICOL.EQ.'6')JCOL=2 CCCCC IF(ICOL.EQ.'7')JCOL=3 CCCCC IF(ICOL.EQ.'8')JCOL=4 CCCCC GOTO5199 C C5120 CONTINUE JCOL=1 CCCCC IF(ICOL.EQ.'BLAC'.OR.ICOL.EQ.'WHIT')JCOL=1 CCCCC IF(ICOL.EQ.'RED')JCOL=2 CCCCC IF(ICOL.EQ.'BLUE')JCOL=3 CCCCC IF(ICOL.EQ.'GREE')JCOL=4 CCCCC IF(ICOL.EQ.'CYAN')JCOL=5 CCCCC IF(ICOL.EQ.'MAGE'.OR.ICOL.EQ.'PURP')JCOL=6 CCCCC IF(ICOL.EQ.'YELL'.OR.ICOL.EQ.'ORAN')JCOL=7 C CCCCC IF(ICOL.EQ.'1')JCOL=1 CCCCC IF(ICOL.EQ.'2')JCOL=2 CCCCC IF(ICOL.EQ.'3')JCOL=3 CCCCC IF(ICOL.EQ.'4')JCOL=4 CCCCC IF(ICOL.EQ.'5')JCOL=5 CCCCC IF(ICOL.EQ.'6')JCOL=6 CCCCC IF(ICOL.EQ.'7')JCOL=7 CCCCC IF(ICOL.EQ.'8')JCOL=8 IF(JINDEX.LT.0)JCOL=1 IF(JINDEX.GE.0)JCOL=JPLOT8(JINDEX+1) IF(JCOL.GT.IZETCL)JCOL=MOD(JCOL-1,IZETCL)+1 GOTO5199 C 5130 CONTINUE JCOL=1 DO5139I=1,16 IF(ICOL(1:4).NE.IZETPM(I)(1:4))GOTO5139 JCOL=I GOTO5199 5139 CONTINUE C IF(ICOL.EQ.'0')JCOL=0 IF(ICOL.EQ.'1')JCOL=1 IF(ICOL.EQ.'2')JCOL=2 IF(ICOL.EQ.'3')JCOL=3 IF(ICOL.EQ.'4')JCOL=4 IF(ICOL.EQ.'5')JCOL=5 IF(ICOL.EQ.'6')JCOL=6 IF(ICOL.EQ.'7')JCOL=7 IF(ICOL.EQ.'8')JCOL=8 GOTO5199 C 5199 CONTINUE IF(JCOL.GT.IZETCL)JCOL=1 GOTO9000 C C ****************************************************** C ** STEP 61-- ** C ** TREAT THE RAMTEK XXXXXX CASE ** C ** (NOT DONE) ** C ** REFERENCE--XX ** C ** XX ** C ** PAGES XX AND XX ** C ****************************************************** C 6100 CONTINUE CCCCC WRITE(IGUNIT,6111) C6111 FORMAT('FIX SUBROUTINE GRTRCO TO TRANSL. COL. RAMTEK DEVICE') ICSTR(1:51)='FIX SUBROUTINE GRTRCO TO TRANSL. COL. RAMTEK DEVICE' NCSTR=51 CALL GRWRST(ICSTR,NCSTR,ISUBN0) GOTO9000 C C ****************************************************** C ** STEP 66-- ** C ** TREAT THE SUN CASE - COLOR SUPPORTED ** C ****************************************************** C 6600 CONTINUE IF(ISUNCL.LE.0) THEN JCOL=1 ELSE CCCCC IF(ICOL.EQ.'RED')JCOL=1 CCCCC IF(ICOL.EQ.'ORAN')JCOL=1 CCCCC IF(ICOL.EQ.'GREE')JCOL=2 CCCCC IF(ICOL.EQ.'BLUE')JCOL=3 CCCCC IF(ICOL.EQ.'CYAN')JCOL=3 CCCCC IF(ICOL.EQ.'YELL')JCOL=4 CCCCC IF(ICOL.EQ.'BLAC')JCOL=5 CCCCC IF(ICOL.EQ.'PURP')JCOL=6 CCCCC IF(ICOL.EQ.'MAGE')JCOL=6 CCCCC IF(ICOL.EQ.'WHIT')JCOL=7 CCCCC IF(ICOL.EQ.'DARK')JCOL=0 C CCCCC IF(ICOL.EQ.'0')JCOL=0 CCCCC IF(ICOL.EQ.'1')JCOL=1 CCCCC IF(ICOL.EQ.'2')JCOL=2 CCCCC IF(ICOL.EQ.'3')JCOL=3 CCCCC IF(ICOL.EQ.'4')JCOL=4 CCCCC IF(ICOL.EQ.'5')JCOL=5 CCCCC IF(ICOL.EQ.'6')JCOL=6 CCCCC IF(ICOL.EQ.'7')JCOL=7 JCOL=5 IF(JINDEX.LT.0)JCOL=5 IF(JINDEX.GE.0)JCOL=JSUN(JINDEX+1) ENDIF GOTO9000 C C ****************************************************** C ** STEP 71-- ** C ** TREAT THE XXXXXX XXXXXX CASE ** C ** (NOT DONE) ** C ** REFERENCE--XX ** C ** XX ** C ** PAGES XX AND XX ** C ****************************************************** C 7100 CONTINUE CCCCC WRITE(IGUNIT,7111) C7111 FORMAT('FIX SUBROUTINE GRTRCO TO TRANSL. COL. XXXXXX DEVICE') C ICSTR(1:51)='FIX SUBROUTINE GRTRCO TO TRANSL. COL. XXXXXX DEVICE' NCSTR=51 CALL GRWRST(ICSTR,NCSTR,ISUBN0) GOTO9000 C C C ****************************************************** C ** STEP 81-- ** C ** TREAT THE REGIS CASE ** C ** NON-COLOR DEVICE ** C ** ADD COLOR SUPPORT FOR REGIS JANUARY, 1991. ** C ** NOTE THAT REGIS SUPPORTS COLOR IN TWO WAYS. ** C ** IT ALLOWS AN RGB COLOR SPECIFIED BY NAME. THIS ** C ** METHOD ALLOWS 8 DIFFERENT COLORS (BLACK, RED, ** C ** GREEN, BLUE, CYAN, YELLOW, MAGENTA, WHITE) IT ** C ** ALSO ALLOWS COLORS TO BE SPECIFIED BY HUE, ** C ** LIGHTNESS, AND SATURATION VALUES. THIS METHOD ** C ** ALLOWS 64 COLORS TO BE SPECIFIED. WE WILL USE ** C ** THE HLS METHOD SINCE IT ALLOWS MORE COLOR (ALL ** C ** THE RGB COLORS HAVE A CORRESPONDING HLS SPEC). ** C ** UNFORTUNATELY, NOT ALL THE COLORS HAVE SIMPLE 4 ** C ** CHARACTER CODES. MOST COLORS WILL HAVE TO BE ** C ** SPECIFIED BY AN INDEX. TO MAKE IT EASIER FOR ** C ** USERS, A "SHOW REGIS COLORS" COMMAND WAS ADDED. ** C ** TRANSLATION TAKEN FROM 5-32 OF VT-240 MANUAL. ** C ** NOTE THAT MONOCHROME REGIS SUPPORTS 4 INTENSITY ** C ** LEVELS (I.E., GREY SCALES). WE HAVE NOT ** C ** IMPLEMENTED GREY-SCALE REGION FILLS AS IS DONE ** C ** WITH MONOCHROME POSTSCRIPT DEVICES. ** C ****************************************************** C 8100 CONTINUE JCOL=3 IF(IGCOLO.NE.'ON')GOTO9000 C IF(JINDEX.LT.0)JCOL=3 IF(JINDEX.GE.0)JCOL=JREGIS(JINDEX+1) GOTO9000 C C C ****************************************************** C ** STEP 86-- ** C ** TREAT THE POSTSCRIPT CASE ** C ** BLACK AND WHITE DEVICE, HOWEVER CAN USE ** C ** "GREY SCALE" TO SIMULATE COLOR ** C ** USED FOR REGIONS THAT ARE SOLID FILLED ** C ** REFERENCE--POSTSCRIPT LANGUAGE TUTORIAL AND ** C ** COOKBOOK FROM ADOBE SYSTEMS ** C ** MODIFIED JANUARY, 1990 TO SUPPORT COLOR ** C ****************************************************** C C AUGUST, 1990. SUPPORT FULL GRAY SCALE WITH THE FOLLOWING SCHEME. IF C THE COLOR IS GIVEN AS A NEGATIVE INDEX FROM -1 TO -256 (I.E., -1, -2, C ... , -256), INTERPERT THE NUMBER AS AN EXPLICIT GRAY SCALE INDEX. C POSITIVE INDEX NUMBERS (0 TO 15) WILL SUPPORT SPECIFIC COLORS AND WILL C BE MAPPED TO EXPLICIT GRAY SCALES (NOT NECESSARILY SCALED BY NUMERIC VALUE) C ON MONOCHROME DEVICES. C C AUGUST 1992. ABOVE SCHEME NO LONGER APPLIES. SUPPORT ALL 67 COLORS C VIA SPECIFIC RGB VALUES, GRAY SCALE SPECIFIED VIA G0 THROUGH G100 C AS STATED IN BEGINING COMMENTS. NO LONGER USE THE NEGATIVE VALUES C SCHEME. C 8600 CONTINUE CCCCC JCOL=0 CCCCC FOLLOWING LINE COMMENTED OUT AUGUST, 1990. (B/W EMULATES COLOR CCCCC ON REGION FILLS WITH GRAY SCALE). CCCCC IF(IGCOLO.NE.'ON')GOTO9000 CCCCC IF(ICOL.EQ.'WHIT')JCOL=7 CCCCC IF(ICOL.EQ.'YELL')JCOL=3 CCCCC IF(ICOL.EQ.'ORAN')JCOL=8 CCCCC IF(ICOL.EQ.'CYAN')JCOL=6 CCCCC IF(ICOL.EQ.'GREE')JCOL=2 CCCCC IF(ICOL.EQ.'RED')JCOL=1 CCCCC IF(ICOL.EQ.'BLUE')JCOL=4 CCCCC IF(ICOL.EQ.'PURP')JCOL=12 CCCCC IF(ICOL.EQ.'MAGE')JCOL=5 CCCCC IF(ICOL.EQ.'BLAC')JCOL=0 C CCCCC IF(ICOL.EQ.'0')JCOL=0 CCCCC IF(ICOL.EQ.'1')JCOL=1 CCCCC IF(ICOL.EQ.'2')JCOL=2 CCCCC IF(ICOL.EQ.'3')JCOL=3 CCCCC IF(ICOL.EQ.'4')JCOL=4 CCCCC IF(ICOL.EQ.'5')JCOL=5 CCCCC IF(ICOL.EQ.'6')JCOL=6 CCCCC IF(ICOL.EQ.'7')JCOL=7 CCCCC IF(ICOL.EQ.'8')JCOL=8 CCCCC IF(ICOL.EQ.'9')JCOL=9 CCCCC IF(ICOL.EQ.'10')JCOL=10 CCCCC IF(ICOL.EQ.'11')JCOL=11 CCCCC IF(ICOL.EQ.'12')JCOL=12 CCCCC IF(ICOL.EQ.'13')JCOL=13 CCCCC IF(ICOL.EQ.'14')JCOL=14 CCCCC IF(ICOL.EQ.'15')JCOL=15 CCCCC IF(ICOL(1:1).EQ.'-')THEN CCCCC ICOLT(1:4)='- ' CCCCC DO8610I=2,4 CCCCC IF(ICOL(I:I).EQ.' ')GOTO8615 CCCCC IF(ICOL(I:I).EQ.'.')GOTO8615 CCCCC CALL DPCOAN(ICOL(I:I),ITEMP) CCCCC IF(ITEMP.GE.48.AND.ITEMP.LE.57)THEN CCCCC ICOLT(I:I)=ICOL(I:I) CCCCC ELSE CCCCC GOTO8619 CCCCC ENDIF C8610 CONTINUE C8615 CONTINUE CCCCC READ(ICOLT(1:4),'(I4)')JCOL CCCCC IF(JCOL.LT.-256)JCOL=-256 CCCCC IF(JCOL.GT.-1)JCOL=-1 CCCCC END IF C8619 CONTINUE JCOL=2 IF(JINDEX.LT.0)JCOL=JINDEX IF(IGCOLO.NE.'ON')GOTO9000 IF(JINDEX.GE.0)JCOL=JCGM(JINDEX+1) GOTO9000 C C ****************************************************** C ** STEP 89-- ** C ** TREAT THE DISPLAY POSTSCRIPT DRIVER ** C ****************************************************** C 8900 CONTINUE GOTO9000 C C C ****************************************************** C ** STEP 91-- ** C ** TREAT THE QUIC CASE (QMS, TELARIS LASER PRINTERS** C ** QUIC DOES NOT SUPPORT COLOR. HOWEVER, IT DOES ** C ** SUPPORT "HALF-TONES" AND "FILL PATTERNS". THESE** C ** ARE DESCRIBED IN CHAPTER 8 OF THE QMS QUIC ** C ** PROGRAMMERS MANUAL. HOWEVER, THESE WILL NOT BE ** C ** BE USED TO SIMULATE COLOR FOR REGION FILLS (AS ** C ** IN POSTSCRIPT AND PCL CASES). THE REASON IS ** C ** POSTSCRIPT SUPPORTS GREYSCALE AS A DIRECTLY ** C ** SPECIFIED PROPORTION AND PCL SUPPORTS DOT ** C ** DENSITY AS A DIRECTLY SPECIFIED PERCENT. THE ** C ** QMS HALFTONES ARE SPECIFIC PREDFINED PATTERNS, ** C ** THERE DID NOT SEEM TO BE A REASONABLE "PROGRESSION" C ** IN THE PATTERNS LISTED IN THE MANUAL. ** C ****************************************************** C 9100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 96-- ** C ** TREAT THE X11 CASE ** C ****************************************************** C 9600 CONTINUE JCOL=0 C IF(JINDEX.LT.0)JCOL=JINDEX IF(JINDEX.GE.0)JCOL=JX11(JINDEX+1) GOTO9000 C CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1991 (JJF) C ************************************************* C ** STEP 100-- ** C ** TREAT THE VGA VIA TURBO-C CASE ** C ** REFERENCE--TURBO C 1.5 ADDITIONS & ** C ** ENHANCEMENTS, PAGE 74. ** C ** REFERENCE--TURBO C 2.0 REFERENCE GUIDE, ** C ** PAGE 310. ** C ************************************************* C 10000 CONTINUE JCOL=0 CCCCC IF(ICOL.EQ.'BLAC')JCOL=0 CCCCC IF(ICOL.EQ.'BLUE')JCOL=1 CCCCC IF(ICOL.EQ.'GREE')JCOL=2 CCCCC IF(ICOL.EQ.'CYAN')JCOL=3 CCCCC IF(ICOL.EQ.'RED')JCOL=4 CCCCC IF(ICOL.EQ.'MAGE')JCOL=5 CCCCC IF(ICOL.EQ.'BROW')JCOL=6 CCCCC IF(ICOL.EQ.'GRAY')JCOL=7 CCCCC IF(ICOL.EQ.'GREY')JCOL=7 CCCCC IF(ICOL.EQ.'LGRA')JCOL=7 CCCCC IF(ICOL.EQ.'LGRE')JCOL=7 CCCCC IF(ICOL.EQ.'DGRA')JCOL=8 CCCCC IF(ICOL.EQ.'DGRE')JCOL=8 CCCCC IF(ICOL.EQ.'LBLU')JCOL=9 CCCCC IF(ICOL.EQ.'LGRE')JCOL=10 CCCCC IF(ICOL.EQ.'LCYA')JCOL=11 CCCCC IF(ICOL.EQ.'LRED')JCOL=12 CCCCC IF(ICOL.EQ.'LMAG')JCOL=13 CCCCC IF(ICOL.EQ.'YELL')JCOL=14 CCCCC IF(ICOL.EQ.'WHIT')JCOL=15 C CCCCC IF(ICOL.EQ.'0')JCOL=0 CCCCC IF(ICOL.EQ.'1')JCOL=1 CCCCC IF(ICOL.EQ.'2')JCOL=2 CCCCC IF(ICOL.EQ.'3')JCOL=3 CCCCC IF(ICOL.EQ.'4')JCOL=4 CCCCC IF(ICOL.EQ.'5')JCOL=5 CCCCC IF(ICOL.EQ.'6')JCOL=6 CCCCC IF(ICOL.EQ.'7')JCOL=7 CCCCC IF(ICOL.EQ.'8')JCOL=8 CCCCC IF(ICOL.EQ.'9')JCOL=9 CCCCC IF(ICOL.EQ.'10')JCOL=10 CCCCC IF(ICOL.EQ.'11')JCOL=11 CCCCC IF(ICOL.EQ.'12')JCOL=12 CCCCC IF(ICOL.EQ.'13')JCOL=13 CCCCC IF(ICOL.EQ.'14')JCOL=14 CCCCC IF(ICOL.EQ.'15')JCOL=15 IF(JINDEX.LT.0)JCOL=0 IF(JINDEX.GE.0)JCOL=JPC(JINDEX+1) GOTO9000 C C ****************************************************** C ** STEP 110-- ** C ** TREAT THE GKS DRIVER ** C ****************************************************** C 11000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 120-- ** C ** TREAT THE GD DRIVER ** C ** THIS LIBRARY PROVIDES SUPPORT FOR: ** C ** 1) JPEG ** C ** 2) PNG ** C ** 3) WINDOWS BMP (BLACK/WHITE ONLY) ** C ****************************************************** C 12000 CONTINUE C JCOL=0 C IF(JINDEX.LT.0)JCOL=JINDEX IF(JINDEX.GE.0)JCOL=JCGM(JINDEX+1) GOTO9000 C C ****************************************************** C ** STEP 130-- ** C ** TREAT THE MACINTOSH DRIVER ** C ** LIBRARY FROM ABSOFT COMPILER ** C ****************************************************** C 13000 CONTINUE JCOL=0 C IF(JINDEX.LT.0)JCOL=JINDEX IF(JINDEX.GE.0)JCOL=JCGM(JINDEX+1) GOTO9000 C C ****************************************************** C ** STEP 135-- ** C ** TREAT THE MAC OSX AQUATERM DRIVER ** C ****************************************************** C 13500 CONTINUE JCOL=0 C IF(JINDEX.LT.0)JCOL=JINDEX IF(JINDEX.GE.0)JCOL=JCGM(JINDEX+1) GOTO9000 C C ****************************************************** C ** STEP 140-- ** C ** TREAT THE PC PRINTER DRIVER ** C ****************************************************** C 14000 CONTINUE GOTO9000 C C C ****************************************************** C ** STEP 150-- ** C ** TREAT THE LATEX (USING EEPIC) DRIVER ** C ****************************************************** C 15000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 160-- ** C ** TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER ** C ****************************************************** C 16000 CONTINUE C JCOL=0 C IF(JINDEX.LT.0)JCOL=JINDEX IF(JINDEX.GE.0)JCOL=JCGM(JINDEX+1) GOTO9000 C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRCO')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF GRTRCO--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)IMANUF,IMODEL,IMODE2,IMODE3 9012 FORMAT('IMANUF,IMODEL,IMODE2,IMODE3 = ',A4,2X,A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)IGUNIT,IGCODE 9013 FORMAT('IGUNIT,IGCODE = ',I8,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)ISOFT,ISOFT2,ISOFT3 9014 FORMAT('ISOFT,ISOFT2,ISOFT3 = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9015)IGBAUD 9015 FORMAT('IGBAUD = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9016)ICASE 9016 FORMAT('ICASE = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9017)ICOL,JCOL 9017 FORMAT('ICOL,JCOL = ',A4,I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9018)JINDEX 9018 FORMAT('JINDEX = ',I4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9023)NCSTR 9023 FORMAT('NCSTR = ',I8) CALL DPWRST('XXX','BUG ') IF(NCSTR.LE.0)GOTO9027 DO9025I=1,NCSTR CCCCC IASCNE=ICHAR(ICSTR(I:I)) CALL DPCOAN(ICSTR(I:I),IASCNE) WRITE(ICOUT,9026)I,ICSTR(I:I),IASCNE 9026 FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8) CALL DPWRST('XXX','BUG ') 9025 CONTINUE 9027 CONTINUE WRITE(ICOUT,9029)IBUGG4,ISUBG4,IERRG4 9029 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE GRTRDI(ICASE,IDIR,ANGLE,JDIR,ANGLE2) C C PURPOSE--FOR A LINE, REGION, MARKER, OR TEXT, C TRANSLATE A DIRECTION GIVEN IN CHARACTER REPRESENTATION C INTO A NUMERIC REPRESENTATION C THAT WILL BE UNDERSTOOD BY A SPECIFIC C GRAPHICS DEVICE. C C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-3651 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL BUREAU OF STANDARDS. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--83.6 C ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY 1983. C UPDATED --MAY 1991. RENUMBER TOP BRANCHES (JJF) C UPDATED --MAY 1991. VGA/TURBOC DRIVER (JJF) C DRIVER OBSOLETE C UPDATED --JULY 1996. LAHEY DRIVER (ALAN HECKERT) C DRIVER OBSOLETE C UPDATED --OCTOBER 1996. QUICKWIN DRIVER (ALAN) C UPDATED --OCTOBER 1996. OPENGL DRIVER (ALAN) C USE BILL MITCHELLS OPENGL C BINDING FOR FORTRAN C UPDATED --OCTOBER 1996. GKS (ALAN) C CODED, NOT TESTED C UPDATED --OCTOBER 1996. BINARY CGM (ALAN) C PLACEHOLDER FOR NOW C UPDATED --OCTOBER 1996. DISPLAY POSTSCRIPT (ALAN) C PLACEHOLDER FOR NOW C UPDATED --OCTOBER 1997. LAHEY INTERACTOR (ALAN) C UPDATED --JULY 1998. LAHEY WINTERACTOR C UPDATED --JUNE 2000. GD (FOR JPEG, PNG, WINDOWS BMP) C UPDATED --JUNE 2000. MACINTOSH C PLACEHOLDER FOR NOW C UPDATED --JUNE 2000. PC PRINTER C PLACEHOLDER FOR NOW C UPDATED --MARCH 2005. SUPPORT FOR AQUATERM C C-----NON-COMMON VARIABLES (GRAPHICS)------------------------------------------- C CWINT USE WINTERACTER CINTE USE INTERACTER CHARACTER*4 ICASE CHARACTER*4 IDIR C C-----COMMON---------------------------------------------------------- C INCLUDE 'DPCOGR.INC' INCLUDE 'DPCOBE.INC' C C-----COMMON VARIABLES (GENERAL)-------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C IERRG4='NO' C IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRDI')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF GRTRDI--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)ICASE 52 FORMAT('ICASE = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)IDIR,ANGLE 53 FORMAT('IDIR,ANGLE = ',A4,2X,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,54)IMANUF,IMODEL 54 FORMAT('IMANUF,IMODEL = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,59)IBUGG4 59 FORMAT('IBUGG4 = ',A4) CALL DPWRST('XXX','BUG ') 90 CONTINUE C C ************************************* C ** STEP 0-- ** C ** DEFINE DIRECTION ** C ** FOR A GENERAL GRAPHICS DEVICE ** C ************************************* C JDIR=0 ANGLE2=ANGLE C IF(IDIR.EQ.'HORI')JDIR=0 IF(IDIR.EQ.'HORI')ANGLE2=0.0 C IF(IDIR.EQ.'VERT')JDIR=90 IF(IDIR.EQ.'VERT')ANGLE2=90.0 C IF(IDIR.EQ.'GENE')JDIR=ANGLE+0.5 IF(IDIR.EQ.'GENE')ANGLE2=ANGLE C C ******************************************** C ** STEP 1-- ** C ** BRANCH ACCORDING TO THE MANUFACTURER ** C ** AND THE MODEL ** C ******************************************** C IF(IMANUF.EQ.'TEKT')GOTO1005 IF(IMANUF.EQ.'HP')GOTO1010 IF(IMANUF.EQ.'PCL')GOTO1015 IF(IMANUF.EQ.'GENE')GOTO1020 IF(IMANUF.EQ.'CALC')GOTO1025 IF(IMANUF.EQ.'ZETA')GOTO1030 IF(IMANUF.EQ.'RAMT')GOTO1035 IF(IMANUF.EQ.'SUN ')GOTO1040 IF(IMANUF.EQ.'XXXX')GOTO1045 IF(IMANUF.EQ.'REGI')GOTO1050 IF(IMANUF.EQ.'POST')GOTO1055 IF(IMANUF.EQ.'QUIC')GOTO1060 IF(IMANUF.EQ.'X11 ')GOTO1065 IF(IMANUF.EQ.'TURB')GOTO1070 IF(IMANUF.EQ.'GKS ')GOTO1075 IF(IMANUF.EQ.'LAHE')GOTO1080 IF(IMANUF.EQ.'GD ')GOTO1085 IF(IMANUF.EQ.'QWIN')GOTO1090 IF(IMANUF.EQ.'AQUA')GOTO1091 IF(IMANUF.EQ.'OPGL')GOTO1095 IF(IMANUF.EQ.'PRIN')GOTO1096 IF(IMANUF.EQ.'MACI')GOTO1098 GOTO9000 C 1005 CONTINUE GOTO1100 C 1010 CONTINUE IF(IMODEL.EQ.'7221')GOTO2100 IF(IMODEL.EQ.'2622')GOTO2300 IF(IMODEL.EQ.'2623')GOTO2300 IF(IMODEL.EQ.'2627')GOTO2300 IF(IMODEL.EQ.'2647')GOTO2300 GOTO2200 C 1015 CONTINUE GOTO2600 C 1020 CONTINUE IF(IMODEL.EQ.'CGM')GOTO3300 IF(IMODEL.EQ.'CGMB')GOTO3400 GOTO3100 C 1025 CONTINUE GOTO4100 C 1030 CONTINUE GOTO5100 C 1035 CONTINUE GOTO6100 C 1040 CONTINUE GOTO6600 C 1045 CONTINUE GOTO7100 C 1050 CONTINUE GOTO8100 C 1055 CONTINUE IF(IMODEL.EQ.'DISP')GOTO8900 GOTO8600 C 1060 CONTINUE GOTO9100 C 1065 CONTINUE GOTO9600 C 1070 CONTINUE GOTO10000 C 1075 CONTINUE GOTO11000 C 1080 CONTINUE IF(IMODEL.EQ.'INTE')GOTO4900 IF(IMODEL.EQ.'WINT')GOTO4950 GOTO4600 C 1085 CONTINUE IF(IMODEL.EQ.'JPEG')GOTO12000 IF(IMODEL.EQ.'PNG ')GOTO12000 IF(IMODEL.EQ.'WBMP')GOTO12000 IF(IMODEL.EQ.'GIF')GOTO12000 GOTO12000 C 1090 CONTINUE GOTO4700 C 1091 CONTINUE GOTO13500 C 1095 CONTINUE GOTO4800 C 1096 CONTINUE GOTO14000 C 1098 CONTINUE GOTO13000 C C ****************************************************** C ** STEP 11-- ** C ** TREAT THE TEKTRONIX CASE ** C ****************************************************** C 1100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 21-- ** C ** TREAT THE HEWLETT-PACKARD 7221 CASE ** C ** (MULTI-COLOR PENPLOTTER) ** C ** REFERENCE--HP 7221A GRAPHICS PLOTTER ** C ** OPERATING AND PROGRAMMING MANUAL, ** C ** PAGE XX. ** C ****************************************************** C 2100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 22-- ** C ** TREAT THE HEWLETT-PACKARD HP-GL CASES ** C ** (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS) ** C ** (MULTI-COLOR PENPLOTTERS) ** C ** REFERENCE--HP 9872C GRAPHICS PLOTTER ** C ** OPERATING AND PROGRAMMING MANUAL, ** C ** PAGE XX, XXX. ** C ****************************************************** C 2200 CONTINUE GOTO9000 C C ********************************************************** C ** STEP 23-- ** C ** TREAT THE HEWLETT-PACKARD HP-2622 CASES ** C ** (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS) ** C ** (MONOCHROME DISPLAY TERMINALS) ** C ** REFERENCE--HP 2322C GRAPHICS PLOTTER ** C ** REFERENCE MANUAL, ** C ** PAGE 10-10, XXX. ** C ********************************************************** C 2300 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 26-- ** C ** TREAT THE PCL CASE (HP-LASERJET II LASER PRINTER)* C ****************************************************** C 2600 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 31-- ** C ** TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE ** C ****************************************************** C 3100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 33-- ** C ** TREAT THE CGM CASE ** C ****************************************************** C 3300 CONTINUE GOTO9000 C C *************************************************** C ** STEP 34-- ** C ** TREAT THE CGM (BINARY) CASE ** C *************************************************** C 3400 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 41-- ** C ** TREAT THE CALCOMP XXXXXX CASE ** C ** (NOT DONE) ** C ** REFERENCE--XX ** C ** XX ** C ** PAGES XX AND XX ** C ****************************************************** C 4100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 46-- ** C ** TREAT THE LAHEY XXXXXX CASE ** C ** REFERENCE--Programmer's Reference, Revision C ** C ** Lahey Computer Systems, January, 1992** C ** PAGES 51 THRU 65 ** C ****************************************************** C 4600 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 47-- ** C ** TREAT THE MICROSOFT QUICKWIN DRIVER ** C ** FOR WINDOWS 95 AND WINDOWS NT. ** C ****************************************************** C 4700 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 48-- ** C ** TREAT THE OPEN-GL DRIVER ** C ** FOR WINDOWS 95 AND WINDOWS NT AND X11 ** C ****************************************************** C 4800 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 49-- ** C ** TREAT THE LAHEY INTERACTOR CASE ** C ****************************************************** C 4900 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 49B- ** C ** TREAT THE LAHEY WINTERACTOR CASE ** C ****************************************************** C 4950 CONTINUE GOTO9000 C C C ****************************************************** C ** STEP 51-- ** C ** TREAT THE ZETA 3600SX AND 3653SX CASES ** C ** REFERENCE--USER MANUAL FOR DIGITAL PLOTTER ** C ** MODELS 3600SX AND 3653SX ** C ** PAGES B-0 AND B-1 ** C ****************************************************** C 5100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 61-- ** C ** TREAT THE RAMTEK XXXXXX CASE ** C ** (NOT DONE) ** C ** REFERENCE--XX ** C ** XX ** C ** PAGES XX AND XX ** C ****************************************************** C 6100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 66-- ** C ** TREAT THE SUN CASE ** C ****************************************************** C 6600 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 71-- ** C ** TREAT THE XXXXXX XXXXXX CASE ** C ** (NOT DONE) ** C ** REFERENCE--XX ** C ** XX ** C ** PAGES XX AND XX ** C ****************************************************** C 7100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 81-- ** C ** TREAT THE REGIS CASE ** C ****************************************************** C 8100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 86-- ** C ** TREAT THE POSTSCRIPT CASE ** C ****************************************************** C 8600 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 89-- ** C ** TREAT THE DISPLAY POSTSCRIPT DRIVER ** C ****************************************************** C 8900 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 91-- ** C ** TREAT THE QUIC CASE ** C ** SUPPORT THE PROPORTIONAL FONTS THAT ARE ** C ** "HARD-CODED" IN THE QMS. ** C ** ** C ****************************************************** C 9100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 96-- ** C ** TREAT THE X11 CASE ** C ****************************************************** C 9600 CONTINUE GOTO9000 C C ************************************************* C ** STEP 100-- ** C ** TREAT THE VGA VIA TURBO-C CASE ** C ************************************************* C 10000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 110-- ** C ** TREAT THE GKS DRIVER ** C ****************************************************** C 11000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 120-- ** C ** TREAT THE GD DRIVER ** C ** THIS LIBRARY PROVIDES SUPPORT FOR: ** C ** 1) JPEG ** C ** 2) PNG ** C ** 3) WINDOWS BMP (BLACK/WHITE ONLY) ** C ****************************************************** C 12000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 130-- ** C ** TREAT THE MACINTOSH DRIVER ** C ** LIBRARY FROM ABSOFT COMPILER ** C ****************************************************** C 13000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 135-- ** C ** TREAT THE MAC OSX AQUATERM DRIVER ** C ****************************************************** C 13500 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 140-- ** C ** TREAT THE PC PRINTER DRIVER ** C ****************************************************** C 14000 CONTINUE GOTO9000 C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRDI')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF GRTRDI--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)ICASE 9012 FORMAT('ICASE = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)IDIR,ANGLE 9013 FORMAT('IDIR,ANGLE = ',A4,2X,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)JDIR,ANGLE2 9014 FORMAT('JDIR,ANGLE2 = ',I8,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9015)IMANUF,IMODEL 9015 FORMAT('IMANUF,IMODEL = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9019)IBUGG4,ISUBG4,IERRG4 9019 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE GRTRFI(ICASE,IFILLT,JFILLT) C C PURPOSE--FOR A LINE, REGION, MARKER, OR TEXT, C TRANSLATE A FILL SPECIFICATION (ON/OFF) GIVEN IN CHARACTER REPRES C INTO A NUMERIC REPRESENTATION C THAT WILL BE UNDERSTOOD BY A SPECIFIC C GRAPHICS DEVICE. C C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-3651 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL BUREAU OF STANDARDS. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--83.6 C ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY 1983. C UPDATED --MAY 1991. RENUMBER TOP BRANCHES (JJF) C UPDATED --MAY 1991. VGA/TURBOC DRIVER (JJF) C DRIVER OBSOLETE C UPDATED --JULY 1996. LAHEY DRIVER (ALAN HECKERT) C OLD CALCOMP STYLE C DRIVER OBSOLETE C UPDATED --OCTOBER 1996. QUICKWIN DRIVER (ALAN) C UPDATED --OCTOBER 1996. OPENGL DRIVER (ALAN) C USE BILL MITCHELLS OPENGL C BINDING FOR FORTRAN C UPDATED --OCTOBER 1996. GKS (ALAN) C CODED, NOT TESTED C UPDATED --OCTOBER 1996. BINARY CGM (ALAN) C PLACEHOLDER FOR NOW C UPDATED --OCTOBER 1996. DISPLAY POSTSCRIPT (ALAN) C PLACEHOLDER FOR NOW C UPDATED --OCTOBER 1997. LAHEY INTERACTOR (ALAN) C UPDATED --JULY 1998. LAHEY WINTERACTOR C UPDATED --JUNE 2000. GD (FOR JPEG, PNG, WINDOWS BMP) C UPDATED --JUNE 2000. MACINTOSH C PLACEHOLDER FOR NOW C UPDATED --JUNE 2000. PC PRINTER C PLACEHOLDER FOR NOW C UPDATED --MARCH 2005. SUPPORT FOR AQUATERM C C-----NON-COMMON VARIABLES (GRAPHICS)------------------------------------------- C CWINT USE WINTERACTER CINTE USE INTERACTER CHARACTER*4 ICASE CHARACTER*4 IFILLT C C-----COMMON---------------------------------------------------------- C INCLUDE 'DPCOGR.INC' INCLUDE 'DPCOBE.INC' C C-----COMMON VARIABLES (GENERAL)-------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C IERRG4='NO' C IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRFI')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF GRTRFI--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)ICASE 52 FORMAT('ICASE = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)IFILLT 53 FORMAT('IFILLT = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,54)IMANUF,IMODEL 54 FORMAT('IMANUF,IMODEL = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,59)IBUGG4 59 FORMAT('IBUGG4 = ',A4) CALL DPWRST('XXX','BUG ') 90 CONTINUE C C ************************************* C ** STEP 0-- ** C ** DEFINE FILL ** C ** FOR A GENERAL GRAPHICS DEVICE ** C ************************************* C JFILLT=0 IF(IFILLT.EQ.'ON')JFILLT=1 C C ******************************************** C ** STEP 1-- ** C ** BRANCH ACCORDING TO THE MANUFACTURER ** C ** AND THE MODEL ** C ******************************************** C IF(IMANUF.EQ.'TEKT')GOTO1005 IF(IMANUF.EQ.'HP')GOTO1010 IF(IMANUF.EQ.'PCL')GOTO1015 IF(IMANUF.EQ.'GENE')GOTO1020 IF(IMANUF.EQ.'CALC')GOTO1025 IF(IMANUF.EQ.'ZETA')GOTO1030 IF(IMANUF.EQ.'RAMT')GOTO1035 IF(IMANUF.EQ.'SUN ')GOTO1040 IF(IMANUF.EQ.'XXXX')GOTO1045 IF(IMANUF.EQ.'REGI')GOTO1050 IF(IMANUF.EQ.'POST')GOTO1055 IF(IMANUF.EQ.'QUIC')GOTO1060 IF(IMANUF.EQ.'X11 ')GOTO1065 IF(IMANUF.EQ.'TURB')GOTO1070 IF(IMANUF.EQ.'GKS ')GOTO1075 IF(IMANUF.EQ.'LAHE')GOTO1080 IF(IMANUF.EQ.'GD ')GOTO1085 IF(IMANUF.EQ.'QWIN')GOTO1090 IF(IMANUF.EQ.'AQUA')GOTO1090 IF(IMANUF.EQ.'OPGL')GOTO1095 IF(IMANUF.EQ.'PRIN')GOTO1096 IF(IMANUF.EQ.'MACI')GOTO1098 GOTO9000 C 1005 CONTINUE GOTO1100 C 1010 CONTINUE IF(IMODEL.EQ.'7221')GOTO2100 IF(IMODEL.EQ.'2622')GOTO2300 IF(IMODEL.EQ.'2623')GOTO2300 IF(IMODEL.EQ.'2627')GOTO2300 IF(IMODEL.EQ.'2647')GOTO2300 GOTO2200 C 1015 CONTINUE GOTO2600 C 1020 CONTINUE IF(IMODEL.EQ.'CGM')GOTO3300 IF(IMODEL.EQ.'CGMB')GOTO3400 GOTO3100 C 1025 CONTINUE GOTO4100 C 1030 CONTINUE GOTO5100 C 1035 CONTINUE GOTO6100 C 1040 CONTINUE GOTO6600 C 1045 CONTINUE GOTO7100 C 1050 CONTINUE GOTO8100 C 1055 CONTINUE IF(IMODEL.EQ.'DISP')GOTO8900 GOTO8600 C 1060 CONTINUE GOTO9100 C 1065 CONTINUE GOTO9600 C 1070 CONTINUE GOTO10000 C 1075 CONTINUE GOTO11000 C 1080 CONTINUE IF(IMODEL.EQ.'INTE')GOTO4900 IF(IMODEL.EQ.'WINT')GOTO4950 GOTO4600 C 1085 CONTINUE IF(IMODEL.EQ.'JPEG')GOTO12000 IF(IMODEL.EQ.'PNG ')GOTO12000 IF(IMODEL.EQ.'WBMP')GOTO12000 IF(IMODEL.EQ.'GIF')GOTO12000 GOTO12000 C 1090 CONTINUE GOTO4700 C 1091 CONTINUE GOTO13500 C 1095 CONTINUE GOTO4800 C 1096 CONTINUE GOTO14000 C 1098 CONTINUE GOTO13000 C C ****************************************************** C ** STEP 11-- ** C ** TREAT THE TEKTRONIX CASE ** C ****************************************************** C 1100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 21-- ** C ** TREAT THE HEWLETT-PACKARD 7221 CASE ** C ** (MULTI-COLOR PENPLOTTER) ** C ** REFERENCE--HP 7221A GRAPHICS PLOTTER ** C ** OPERATING AND PROGRAMMING MANUAL, ** C ** PAGE XX. ** C ****************************************************** C 2100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 22-- ** C ** TREAT THE HEWLETT-PACKARD HP-GL CASES ** C ** (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS) ** C ** (MULTI-COLOR PENPLOTTERS) ** C ** REFERENCE--HP 9872C GRAPHICS PLOTTER ** C ** OPERATING AND PROGRAMMING MANUAL, ** C ** PAGE XX, XXX. ** C ****************************************************** C 2200 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 23-- ** C ** TREAT THE HP-2622 CASE ** C ****************************************************** C 2300 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 26-- ** C ** TREAT THE PCL CASE ** C ****************************************************** C 2600 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 31-- ** C ** TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE ** C ****************************************************** C 3100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 33-- ** C ** TREAT THE CGM CASE ** C ****************************************************** C 3300 CONTINUE GOTO9000 C C *************************************************** C ** STEP 34-- ** C ** TREAT THE CGM (BINARY) CASE ** C *************************************************** C 3400 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 41-- ** C ** TREAT THE CALCOMP XXXXXX CASE ** C ** (NOT DONE) ** C ** REFERENCE--XX ** C ** XX ** C ** PAGES XX AND XX ** C ****************************************************** C 4100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 46-- ** C ** TREAT THE LAHEY XXXXXX CASE ** C ** REFERENCE--Programmer's Reference, Revision C ** C ** Lahey Computer Systems, January, 1992** C ** PAGES 51 THRU 65 ** C ****************************************************** C 4600 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 47-- ** C ** TREAT THE MICROSOFT QUICKWIN DRIVER ** C ** FOR WINDOWS 95 AND WINDOWS NT. ** C ****************************************************** C 4700 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 48-- ** C ** TREAT THE OPEN-GL DRIVER ** C ** FOR WINDOWS 95 AND WINDOWS NT AND X11 ** C ****************************************************** C 4800 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 49-- ** C ** TREAT THE LAHEY INTERACTOR CASE ** C ****************************************************** C 4900 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 49B- ** C ** TREAT THE LAHEY WINTERACTOR CASE ** C ****************************************************** C 4950 CONTINUE GOTO9000 C C C ****************************************************** C ** STEP 51-- ** C ** TREAT THE ZETA 3600SX AND 3653SX CASES ** C ** REFERENCE--USER MANUAL FOR DIGITAL PLOTTER ** C ** MODELS 3600SX AND 3653SX ** C ** PAGES B-0 AND B-1 ** C ****************************************************** C 5100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 61-- ** C ** TREAT THE RAMTEK XXXXXX CASE ** C ** (NOT DONE) ** C ** REFERENCE--XX ** C ** XX ** C ** PAGES XX AND XX ** C ****************************************************** C 6100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 66-- ** C ** TREAT THE SUN CASE ** C ****************************************************** C 6600 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 71-- ** C ** TREAT THE XXXXXX XXXXXX CASE ** C ** (NOT DONE) ** C ** REFERENCE--XX ** C ** XX ** C ** PAGES XX AND XX ** C ****************************************************** C 7100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 81-- ** C ** TREAT THE REGIS CASE ** C ****************************************************** C 8100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 86-- ** C ** TREAT THE POSTSCRIPT CASE ** C ****************************************************** C 8600 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 89-- ** C ** TREAT THE DISPLAY POSTSCRIPT DRIVER ** C ****************************************************** C 8900 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 91-- ** C ** TREAT THE QUIC CASE ** C ****************************************************** C 9100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 96-- ** C ** TREAT THE X11 CASE ** C ****************************************************** C 9600 CONTINUE GOTO9000 C C ************************************************* C ** STEP 100-- ** C ** TREAT THE VGA VIA TURBO-C CASE ** C ************************************************* C 10000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 110-- ** C ** TREAT THE GKS DRIVER ** C ****************************************************** C 11000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 120-- ** C ** TREAT THE GD DRIVER ** C ** THIS LIBRARY PROVIDES SUPPORT FOR: ** C ** 1) JPEG ** C ** 2) PNG ** C ** 3) WINDOWS BMP (BLACK/WHITE ONLY) ** C ****************************************************** C 12000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 130-- ** C ** TREAT THE MACINTOSH DRIVER ** C ** LIBRARY FROM ABSOFT COMPILER ** C ****************************************************** C 13000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 135-- ** C ** TREAT THE MAC OSX AQUATERM DRIVER ** C ****************************************************** C 13500 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 140-- ** C ** TREAT THE PC PRINTER DRIVER ** C ****************************************************** C 14000 CONTINUE GOTO9000 C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRFI')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF GRTRFI--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)ICASE 9012 FORMAT('ICASE = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)IFILLT,JFILLT 9013 FORMAT('IFILLT,JFILLT = ',A4,I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)IMANUF,IMODEL 9014 FORMAT('IMANUF,IMODEL = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9019)IBUGG4,ISUBG4,IERRG4 9019 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE GRTRFO(ICASE,IFONT,JFONT) C C PURPOSE--FOR A LINE, REGION, MARKER, OR TEXT, C TRANSLATE A FONT GIVEN IN CHARACTER REPRESENTATION C INTO A NUMERIC REPRESENTATION C THAT WILL BE UNDERSTOOD BY A SPECIFIC C GRAPHICS DEVICE. C C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-3651 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL BUREAU OF STANDARDS. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--83.6 C ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY 1983. C UPDATED --MAY 1991. RENUMBER TOP BRANCHES (JJF) C UPDATED --MAY 1991. VGA/TURBOC DRIVER (JJF) C DRIVER OBSOLETE C UPDATED --JULY 1996. LAHEY DRIVER (ALAN HECKERT) C OLD, CALCOMP STYLE C DRIVER OBSOLETE C UPDATED --OCTOBER 1996. QUICKWIN DRIVER (ALAN) C UPDATED --OCTOBER 1996. OPENGL DRIVER (ALAN) C USE BILL MITCHELLS OPENGL C BINDING FOR FORTRAN C UPDATED --OCTOBER 1996. GKS (ALAN) C CODED, NOT TESTED C UPDATED --OCTOBER 1996. BINARY CGM (ALAN) C PLACEHOLDER FOR NOW C UPDATED --OCTOBER 1996. DISPLAY POSTSCRIPT (ALAN) C PLACEHOLDER FOR NOW C UPDATED --OCTOBER 1997. LAHEY INTERACTOR (ALAN) C UPDATED --JULY 1998. LAHEY WINTERACTOR C UPDATED --JUNE 2000. GD (FOR JPEG, PNG, WINDOWS BMP) C UPDATED --JUNE 2000. MACINTOSH C PLACEHOLDER FOR NOW C UPDATED --JUNE 2000. PC PRINTER C PLACEHOLDER FOR NOW C UPDATED --MARCH 2005. SUPPORT FOR AQUATERM C C-----NON-COMMON VARIABLES (GRAPHICS)------------------------------------------- C CWINT USE WINTERACTER CINTE USE INTERACTER CHARACTER*4 ICASE CHARACTER*4 IFONT C C-----COMMON---------------------------------------------------------- C INCLUDE 'DPCOGR.INC' INCLUDE 'DPCOBE.INC' C C-----COMMON VARIABLES (GENERAL)-------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C IERRG4='NO' C IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRFO')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF GRTRFO--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)ICASE 52 FORMAT('ICASE = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)IFONT 53 FORMAT('IFONT = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,54)IMANUF,IMODEL 54 FORMAT('IMANUF,IMODEL = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,59)IBUGG4 59 FORMAT('IBUGG4 = ',A4) CALL DPWRST('XXX','BUG ') 90 CONTINUE C C ************************************* C ** STEP 0-- ** C ** DEFINE FONT ** C ** FOR A GENERAL GRAPHICS DEVICE ** C ************************************* C JFONT=0 IF(IFONT.EQ.'TEKT')JFONT=0 IF(IFONT.EQ.'SIMP')JFONT=1 IF(IFONT.EQ.'DUPL')JFONT=2 IF(IFONT.EQ.'TRIP')JFONT=3 IF(IFONT.EQ.'COMP')JFONT=4 IF(IFONT.EQ.'TRII')JFONT=5 IF(IFONT.EQ.'SIMS')JFONT=6 IF(IFONT.EQ.'COMS')JFONT=7 C C ******************************************** C ** STEP 1-- ** C ** BRANCH ACCORDING TO THE MANUFACTURER ** C ** AND THE MODEL ** C ******************************************** C IF(IMANUF.EQ.'TEKT')GOTO1005 IF(IMANUF.EQ.'HP')GOTO1010 IF(IMANUF.EQ.'PCL')GOTO1015 IF(IMANUF.EQ.'GENE')GOTO1020 IF(IMANUF.EQ.'CALC')GOTO1025 IF(IMANUF.EQ.'ZETA')GOTO1030 IF(IMANUF.EQ.'RAMT')GOTO1035 IF(IMANUF.EQ.'SUN ')GOTO1040 IF(IMANUF.EQ.'XXXX')GOTO1045 IF(IMANUF.EQ.'REGI')GOTO1050 IF(IMANUF.EQ.'POST')GOTO1055 IF(IMANUF.EQ.'QUIC')GOTO1060 IF(IMANUF.EQ.'X11 ')GOTO1065 IF(IMANUF.EQ.'TURB')GOTO1070 IF(IMANUF.EQ.'GKS ')GOTO1075 IF(IMANUF.EQ.'LAHE')GOTO1080 IF(IMANUF.EQ.'GD ')GOTO1085 IF(IMANUF.EQ.'QWIN')GOTO1090 IF(IMANUF.EQ.'AQUA')GOTO1091 IF(IMANUF.EQ.'OPGL')GOTO1095 IF(IMANUF.EQ.'PRIN')GOTO1096 IF(IMANUF.EQ.'MACI')GOTO1098 GOTO9000 C 1005 CONTINUE GOTO1100 C 1010 CONTINUE IF(IMODEL.EQ.'7221')GOTO2100 IF(IMODEL.EQ.'2622')GOTO2300 IF(IMODEL.EQ.'2623')GOTO2300 IF(IMODEL.EQ.'2627')GOTO2300 IF(IMODEL.EQ.'2647')GOTO2300 GOTO2200 C 1015 CONTINUE GOTO2600 C 1020 CONTINUE IF(IMODEL.EQ.'CGM')GOTO3300 IF(IMODEL.EQ.'CGMB')GOTO3400 GOTO3100 C 1025 CONTINUE GOTO4100 C 1030 CONTINUE GOTO5100 C 1035 CONTINUE GOTO6100 C 1040 CONTINUE GOTO6600 C 1045 CONTINUE GOTO7100 C 1050 CONTINUE GOTO8100 C 1055 CONTINUE IF(IMODEL.EQ.'DISP')GOTO8900 GOTO8600 C 1060 CONTINUE GOTO9100 C 1065 CONTINUE GOTO9600 C 1070 CONTINUE GOTO10000 C 1075 CONTINUE GOTO11000 C 1080 CONTINUE IF(IMODEL.EQ.'INTE')GOTO4900 IF(IMODEL.EQ.'WINT')GOTO4950 GOTO4600 C 1085 CONTINUE IF(IMODEL.EQ.'JPEG')GOTO12000 IF(IMODEL.EQ.'PNG ')GOTO12000 IF(IMODEL.EQ.'WBMP')GOTO12000 IF(IMODEL.EQ.'GIF')GOTO12000 GOTO12000 C 1090 CONTINUE GOTO4700 C 1091 CONTINUE GOTO13500 C 1095 CONTINUE GOTO4800 C 1096 CONTINUE GOTO14000 C 1098 CONTINUE GOTO13000 C C ****************************************************** C ** STEP 11-- ** C ** TREAT THE TEKTRONIX CASE ** C ****************************************************** C 1100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 21-- ** C ** TREAT THE HEWLETT-PACKARD 7221 CASE ** C ** (MULTI-COLOR PENPLOTTER) ** C ** REFERENCE--HP 7221A GRAPHICS PLOTTER ** C ** OPERATING AND PROGRAMMING MANUAL, ** C ** PAGE XX. ** C ****************************************************** C 2100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 22-- ** C ** TREAT THE HEWLETT-PACKARD HP-GL CASES ** C ** (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS) ** C ** (MULTI-COLOR PENPLOTTERS) ** C ** REFERENCE--HP 9872C GRAPHICS PLOTTER ** C ** OPERATING AND PROGRAMMING MANUAL, ** C ** PAGE XX, XXX. ** C ****************************************************** C 2200 CONTINUE GOTO9000 C C C ****************************************************** C ** STEP 23-- ** C ** TREAT THE HP-2622 CASE ** C ****************************************************** C 2300 CONTINUE GOTO9000 C C C ****************************************************** C ** STEP 26-- ** C ** TREAT THE PCL CASE ** C ****************************************************** C 2600 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 31-- ** C ** TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE ** C ****************************************************** C 3100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 33-- ** C ** TREAT THE GENERAL CGM CASE ** C ****************************************************** C 3300 CONTINUE JFONT=JFONT+1 GOTO9000 C C *************************************************** C ** STEP 34-- ** C ** TREAT THE CGM (BINARY) CASE ** C *************************************************** C 3400 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 41-- ** C ** TREAT THE CALCOMP XXXXXX CASE ** C ** (NOT DONE) ** C ** REFERENCE--XX ** C ** XX ** C ** PAGES XX AND XX ** C ****************************************************** C 4100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 46-- ** C ** TREAT THE LAHEY XXXXXX CASE ** C ** REFERENCE--Programmer's Reference, Revision C ** C ** Lahey Computer Systems, January, 1992** C ** PAGES 51 THRU 65 ** C ****************************************************** C 4600 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 47-- ** C ** TREAT THE MICROSOFT QUICKWIN DRIVER ** C ** FOR WINDOWS 95 AND WINDOWS NT. ** C ****************************************************** C 4700 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 48-- ** C ** TREAT THE OPEN-GL DRIVER ** C ** FOR WINDOWS 95 AND WINDOWS NT AND X11 ** C ****************************************************** C 4800 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 49-- ** C ** TREAT THE LAHEY INTERACTOR CASE ** C ****************************************************** C 4900 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 49B- ** C ** TREAT THE LAHEY WINTERACTOR CASE ** C ****************************************************** C 4950 CONTINUE GOTO9000 C C C ****************************************************** C ** STEP 51-- ** C ** TREAT THE ZETA 3600SX AND 3653SX CASES ** C ** REFERENCE--USER MANUAL FOR DIGITAL PLOTTER ** C ** MODELS 3600SX AND 3653SX ** C ** PAGES B-0 AND B-1 ** C ****************************************************** C 5100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 61-- ** C ** TREAT THE RAMTEK XXXXXX CASE ** C ** (NOT DONE) ** C ** REFERENCE--XX ** C ** XX ** C ** PAGES XX AND XX ** C ****************************************************** C 6100 CONTINUE GOTO9000 C C C ****************************************************** C ** STEP 66-- ** C ** TREAT THE SUN CASE ** C ****************************************************** C 6600 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 71-- ** C ** TREAT THE XXXXXX XXXXXX CASE ** C ** (NOT DONE) ** C ** REFERENCE--XX ** C ** XX ** C ** PAGES XX AND XX ** C ****************************************************** C 7100 CONTINUE GOTO9000 C C C ****************************************************** C ** STEP 81-- ** C ** TREAT THE REGIS CASE ** C ****************************************************** C 8100 CONTINUE GOTO9000 C C C ****************************************************** C ** STEP 86-- ** C ** TREAT THE POSTSCRIPT CASE ** C ****************************************************** C 8600 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 89-- ** C ** TREAT THE DISPLAY POSTSCRIPT DRIVER ** C ****************************************************** C 8900 CONTINUE GOTO9000 C C C ****************************************************** C ** STEP 91-- ** C ** TREAT THE QUIC CASE ** C ****************************************************** C 9100 CONTINUE GOTO9000 C C C ****************************************************** C ** STEP 96-- ** C ** TREAT THE X11 CASE ** C ****************************************************** C 9600 CONTINUE GOTO9000 C C ************************************************* C ** STEP 100-- ** C ** TREAT THE VGA VIA TURBO-C CASE ** C ************************************************* C 10000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 110-- ** C ** TREAT THE GKS DRIVER ** C ****************************************************** C 11000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 120-- ** C ** TREAT THE GD DRIVER ** C ** THIS LIBRARY PROVIDES SUPPORT FOR: ** C ** 1) JPEG ** C ** 2) PNG ** C ** 3) WINDOWS BMP (BLACK/WHITE ONLY) ** C ****************************************************** C 12000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 130-- ** C ** TREAT THE MACINTOSH DRIVER ** C ** LIBRARY FROM ABSOFT COMPILER ** C ****************************************************** C 13000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 135-- ** C ** TREAT THE MAC OSX AQUATERM DRIVER ** C ****************************************************** C 13500 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 140-- ** C ** TREAT THE PC PRINTER DRIVER ** C ****************************************************** C 14000 CONTINUE GOTO9000 C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRFO')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF GRTRFO--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)ICASE 9012 FORMAT('ICASE = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)IFONT,JFONT 9013 FORMAT('IFONT,JFONT = ',A4,I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)IMANUF,IMODEL 9014 FORMAT('IMANUF,IMODEL = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9019)IBUGG4,ISUBG4,IERRG4 9019 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE GRTRJU(ICASE,IJUST,JJUST) C C PURPOSE--FOR A TEXT STRING, MARKER, LINE, OR AREA, C TRANSLATE A JUSTIFICATION GIVEN IN CHARACTER REPRESENTATION C INTO A NUMERIC REPRESENTATION C THAT WILL BE UNDERSTOOD BY A SPECIFIC C GRAPHICS DEVICE. C C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-3651 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL BUREAU OF STANDARDS. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--83.6 C ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY 1983. C UPDATED --JANUARY 1989. SUN (BY BILL ANDERSON) C DRIVER OBSOLETE C UPDATED --JANUARY 1989. POSTSCRIPT (BY ALAN HECKERT) C UPDATED --JANUARY 1989. CGM (BY ALAN HECKERT) C UPDATED --JANUARY 1989. QMS QUIC (BY ALAN HECKERT) C UPDATED --JANUARY 1989. CALCOMP (BY ALAN HECKERT) C UPDATED --JANUARY 1989. ZETA (BY ALAN HECKERT) C UPDATED --MARCH 1990. X11 (BY ALAN HECKERT) C UPDATED --MAY 1991. RENUMBER TOP BRANCHES (JJF) C UPDATED --MAY 1991. VGA/TURBOC DRIVER (JJF) C DRIVER OBSOLETE C UPDATED --JULY 1996. LAHEY DRIVER (ALAN HECKERT) C OLD CALCOMP STYLE C DRIVER OBSOLETE C UPDATED --OCTOBER 1996. QUICKWIN DRIVER (ALAN) C UPDATED --OCTOBER 1996. OPENGL DRIVER (ALAN) C USE BILL MITCHELLS OPENGL C BINDING FOR FORTRAN C UPDATED --OCTOBER 1996. GKS (ALAN) C CODED, NOT TESTED C UPDATED --OCTOBER 1996. BINARY CGM (ALAN) C PLACEHOLDER FOR NOW C UPDATED --OCTOBER 1996. DISPLAY POSTSCRIPT (ALAN) C PLACEHOLDER FOR NOW C UPDATED --OCTOBER 1997. LAHEY INTERACTOR (ALAN) C UPDATED --JULY 1998. LAHEY WINTERACTOR C UPDATED --JUNE 2000. GD (FOR JPEG, PNG, WINDOWS BMP) C UPDATED --JUNE 2000. MACINTOSH C PLACEHOLDER FOR NOW C UPDATED --JUNE 2000. PC PRINTER C PLACEHOLDER FOR NOW C UPDATED --MARCH 2005. SUPPORT FOR AQUATERM C UPDATED --FEBRUARY 2006. LATEK C C-----NON-COMMON VARIABLES (GRAPHICS)------------------------------------------- C CWINT USE WINTERACTER CINTE USE INTERACTER CHARACTER*4 ICASE CHARACTER*4 IJUST C C-----COMMON---------------------------------------------------------- C INCLUDE 'DPCOGR.INC' INCLUDE 'DPCOBE.INC' C C-----COMMON VARIABLES (GENERAL)-------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C IERRG4='NO' C IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRJU')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF GRTRJU--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)ICASE 52 FORMAT('ICASE = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)IJUST 53 FORMAT('IJUST = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,54)IMANUF,IMODEL 54 FORMAT('IMANUF,IMODEL = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,59)IBUGG4 59 FORMAT('IBUGG4 = ',A4) CALL DPWRST('XXX','BUG ') 90 CONTINUE C C ************************************* C ** STEP 0-- ** C ** DEFINE JUSTIFICATION ** C ** FOR A GENERAL GRAPHICS DEVICE ** C ************************************* C JJUST=1 IF(IJUST.EQ.'LEFT')JJUST=1 IF(IJUST.EQ.'CENT')JJUST=2 IF(IJUST.EQ.'RIGH')JJUST=3 C IF(IJUST.EQ.'LJUS')JJUST=1 IF(IJUST.EQ.'CJUS')JJUST=2 IF(IJUST.EQ.'RJUS')JJUST=3 C IF(IJUST.EQ.'LEBO')JJUST=1 IF(IJUST.EQ.'CEBO')JJUST=2 IF(IJUST.EQ.'RIBO')JJUST=3 IF(IJUST.EQ.'LECE')JJUST=4 IF(IJUST.EQ.'CECE')JJUST=5 IF(IJUST.EQ.'RICE')JJUST=6 IF(IJUST.EQ.'LETO')JJUST=7 IF(IJUST.EQ.'CETO')JJUST=8 IF(IJUST.EQ.'RITO')JJUST=9 C C ******************************************** C ** STEP 1-- ** C ** BRANCH ACCORDING TO THE MANUFACTURER ** C ** AND THE MODEL ** C ******************************************** C IF(IMANUF.EQ.'TEKT')GOTO1005 IF(IMANUF.EQ.'HP')GOTO1010 IF(IMANUF.EQ.'PCL')GOTO1015 IF(IMANUF.EQ.'GENE')GOTO1020 IF(IMANUF.EQ.'CALC')GOTO1025 IF(IMANUF.EQ.'ZETA')GOTO1030 IF(IMANUF.EQ.'RAMT')GOTO1035 IF(IMANUF.EQ.'SUN ')GOTO1040 IF(IMANUF.EQ.'XXXX')GOTO1045 IF(IMANUF.EQ.'REGI')GOTO1050 IF(IMANUF.EQ.'POST')GOTO1055 IF(IMANUF.EQ.'QUIC')GOTO1060 IF(IMANUF.EQ.'X11 ')GOTO1065 IF(IMANUF.EQ.'TURB')GOTO1070 IF(IMANUF.EQ.'GKS ')GOTO1075 IF(IMANUF.EQ.'LAHE')GOTO1080 IF(IMANUF.EQ.'GD ')GOTO1085 IF(IMANUF.EQ.'QWIN')GOTO1090 IF(IMANUF.EQ.'AQUA')GOTO1091 IF(IMANUF.EQ.'OPGL')GOTO1095 IF(IMANUF.EQ.'PRIN')GOTO1096 IF(IMANUF.EQ.'LATE')GOTO1097 IF(IMANUF.EQ.'MACI')GOTO1098 GOTO9000 C 1005 CONTINUE GOTO1100 C 1010 CONTINUE IF(IMODEL.EQ.'7221')GOTO2100 GOTO2200 C 1015 CONTINUE GOTO2600 C 1020 CONTINUE IF(IMODEL.EQ.'CGM')GOTO3300 IF(IMODEL.EQ.'CGMB')GOTO3400 GOTO3100 C 1025 CONTINUE GOTO4100 C 1030 CONTINUE GOTO5100 C 1035 CONTINUE GOTO6100 C 1040 CONTINUE GOTO6600 C 1045 CONTINUE GOTO7100 C 1050 CONTINUE GOTO8100 C 1055 CONTINUE IF(IMODEL.EQ.'DISP')GOTO8900 GOTO8600 C 1060 CONTINUE GOTO9100 C 1065 CONTINUE GOTO9600 C 1070 CONTINUE GOTO10000 C 1075 CONTINUE GOTO11000 C 1080 CONTINUE IF(IMODEL.EQ.'INTE')GOTO4900 IF(IMODEL.EQ.'WINT')GOTO4950 GOTO4600 C 1085 CONTINUE IF(IMODEL.EQ.'JPEG')GOTO12000 IF(IMODEL.EQ.'PNG ')GOTO12000 IF(IMODEL.EQ.'WBMP')GOTO12000 IF(IMODEL.EQ.'GIF')GOTO12000 GOTO12000 C 1090 CONTINUE GOTO4700 C 1091 CONTINUE GOTO13500 C 1095 CONTINUE GOTO4800 C 1096 CONTINUE GOTO14000 C 1097 CONTINUE GOTO15000 C 1098 CONTINUE GOTO13000 C C ****************************************************** C ** STEP 11-- ** C ** TREAT THE TEKTRONIX CASE ** C ****************************************************** C 1100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 21-- ** C ** TREAT THE HEWLETT-PACKARD 7221 CASE ** C ** (MULTI-COLOR PENPLOTTER) ** C ** REFERENCE--HP 7221A GRAPHICS PLOTTER ** C ** OPERATING AND PROGRAMMING MANUAL, ** C ** PAGE XX. ** C ****************************************************** C 2100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 22-- ** C ** TREAT THE HEWLETT-PACKARD HP-GL CASES ** C ** (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS) ** C ** (MULTI-COLOR PENPLOTTERS) ** C ** REFERENCE--HP 9872C GRAPHICS PLOTTER ** C ** OPERATING AND PROGRAMMING MANUAL, ** C ** PAGE XX, XXX. ** C ****************************************************** C 2200 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 26-- ** C ** TREAT THE PCL CASE ** C ****************************************************** C 2600 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 31-- ** C ** TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE ** C ****************************************************** C 3100 CONTINUE GOTO9000 C C *************************************************** C ** STEP 33-- ** C ** TREAT THE CGM (ASCII) CASE ** C *************************************************** C 3300 CONTINUE GOTO9000 C C *************************************************** C ** STEP 34-- ** C ** TREAT THE CGM (BINARY) CASE ** C *************************************************** C 3400 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 41-- ** C ** TREAT THE CALCOMP XXXXXX CASE ** C ** (NOT DONE) ** C ** REFERENCE--XX ** C ** XX ** C ** PAGES XX AND XX ** C ****************************************************** C 4100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 46-- ** C ** TREAT THE LAHEY XXXXXX CASE ** C ** REFERENCE--Programmer's Reference, Revision C ** C ** Lahey Computer Systems, January, 1992** C ** PAGES 51 THRU 65 ** C ****************************************************** C 4600 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 47-- ** C ** TREAT THE MICROSOFT QUICKWIN DRIVER ** C ** FOR WINDOWS 95 AND WINDOWS NT. ** C ****************************************************** C 4700 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 48-- ** C ** TREAT THE OPEN-GL DRIVER ** C ** FOR WINDOWS 95 AND WINDOWS NT AND X11 ** C ****************************************************** C 4800 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 49-- ** C ** TREAT THE LAHEY INTERACTOR CASE ** C ****************************************************** C 4900 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 49B- ** C ** TREAT THE LAHEY WINTERACTOR CASE ** C ****************************************************** C 4950 CONTINUE GOTO9000 C C C ****************************************************** C ** STEP 51-- ** C ** TREAT THE ZETA 3600SX AND 3653SX CASES ** C ** REFERENCE--USER MANUAL FOR DIGITAL PLOTTER ** C ** MODELS 3600SX AND 3653SX ** C ** PAGES B-0 AND B-1 ** C ****************************************************** C 5100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 61-- ** C ** TREAT THE RAMTEK XXXXXX CASE ** C ** (NOT DONE) ** C ** REFERENCE--XX ** C ** XX ** C ** PAGES XX AND XX ** C ****************************************************** C 6100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 61-- ** C ** TREAT THE SUN CASE ** C ****************************************************** C 6600 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 71-- ** C ** TREAT THE XXXXXX XXXXXX CASE ** C ** (NOT DONE) ** C ** REFERENCE--XX ** C ** XX ** C ** PAGES XX AND XX ** C ****************************************************** C 7100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 81-- ** C ** TREAT THE REGIS CASE ** C ****************************************************** C 8100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 86-- ** C ** TREAT THE POSTSCRIPT CASE ** C ****************************************************** C 8600 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 89-- ** C ** TREAT THE DISPLAY POSTSCRIPT DRIVER ** C ****************************************************** C 8900 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 91-- ** C ** TREAT THE QUIC CASE ** C ****************************************************** C 9100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 96-- ** C ** TREAT THE X11 CASE ** C ****************************************************** C 9600 CONTINUE GOTO9000 C C ************************************************* C ** STEP 100-- ** C ** TREAT THE VGA VIA TURBO-C CASE ** C ************************************************* C 10000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 110-- ** C ** TREAT THE GKS DRIVER ** C ****************************************************** C 11000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 120-- ** C ** TREAT THE GD DRIVER ** C ** THIS LIBRARY PROVIDES SUPPORT FOR: ** C ** 1) JPEG ** C ** 2) PNG ** C ** 3) WINDOWS BMP (BLACK/WHITE ONLY) ** C ****************************************************** C 12000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 130-- ** C ** TREAT THE MACINTOSH DRIVER ** C ** LIBRARY FROM ABSOFT COMPILER ** C ****************************************************** C 13000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 135-- ** C ** TREAT THE MAC OSX AQUATERM DRIVER ** C ****************************************************** C 13500 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 140-- ** C ** TREAT THE PC PRINTER DRIVER ** C ****************************************************** C 14000 CONTINUE GOTO9000 C C C ****************************************************** C ** STEP 150-- ** C ** TREAT THE LATEX (USING EEPIC) DRIVER ** C ****************************************************** C 15000 CONTINUE GOTO9000 C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRJU')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF GRTRJU--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)ICASE 9012 FORMAT('ICASE = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)IJUST,JJUST 9013 FORMAT('IJUST,JJUST = ',A4,I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)IMANUF,IMODEL 9014 FORMAT('IMANUF,IMODEL = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9019)IBUGG4,ISUBG4,IERRG4 9019 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE GRTRPA(ICASE,IPATTT,PXSPA,PYSPA, 1JPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA,PXSPA2,PYSPA2) C C PURPOSE--FOR A LINE, REGION, MARKER, OR TEXT, C TRANSLATE A PATTERN IN CHARACTER REPRESENTTION. C INTO A NUMERIC REPRESENTATION C THAT WILL BE UNDERSTOOD BY THE SPECIFIC C GRAPHICS DEVICE. C C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-3651 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL BUREAU OF STANDARDS. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--83.6 C ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY 1983. C UPDATED --JANUARY 1989. SUN (BY BILL ANDERSON) C DRIVER OBSOLETE C UPDATED --JANUARY 1989. POSTSCRIPT (BY ALAN HECKERT) C UPDATED --JANUARY 1989. CGM (BY ALAN HECKERT) C UPDATED --JANUARY 1989. QMS QUIC (BY ALAN HECKERT) C UPDATED --JANUARY 1989. CALCOMP (BY ALAN HECKERT) C UPDATED --JANUARY 1989. ZETA (BY ALAN HECKERT) C UPDATED --MARCH 1990. X11 (BY ALAN HECKERT) C UPDATED --MAY 1991. RENUMBER TOP BRANCHES (JJF) C UPDATED --MAY 1991. VGA/TURBOC DRIVER (JJF) C DRIVER OBSOLETE C UPDATED --JULY 1996. LAHEY DRIVER (ALAN HECKERT) C OLD CALCOMP STYLE C DRIVER OBSOLETE C UPDATED --OCTOBER 1996. QUICKWIN DRIVER (ALAN) C UPDATED --OCTOBER 1996. OPENGL DRIVER (ALAN) C USE BILL MITCHELLS OPENGL C BINDING FOR FORTRAN C UPDATED --OCTOBER 1996. GKS (ALAN) C CODED, NOT TESTED C UPDATED --OCTOBER 1996. BINARY CGM (ALAN) C PLACEHOLDER FOR NOW C UPDATED --OCTOBER 1996. DISPLAY POSTSCRIPT (ALAN) C PLACEHOLDER FOR NOW C UPDATED --OCTOBER 1996. SET PATTERN TO -1 FOR BLANK LINE C IF DEVICE DOESN'T ALREADY SET C UPDATED --OCTOBER 1997. LAHEY INTERACTOR (ALAN) C UPDATED --JULY 1998. LAHEY WINTERACTOR C UPDATED --JUNE 2000. GD (FOR JPEG, PNG, WINDOWS BMP) C UPDATED --JUNE 2000. MACINTOSH C PLACEHOLDER FOR NOW C --MARCH 2002. CHANGE TO QUARTZ (NEW MAC GRAPHICS C LIBRARY) C UPDATED --JUNE 2000. PC PRINTER C PLACEHOLDER FOR NOW C --MARCH 2002. CHANGE TO GHOSTSCRIPT C UPDATED --MARCH 2002. LATEX (USING EEPIC) C UPDATED --MARCH 2002. SVG (SCALABLE VECTOR GRAPHICS) C UPDATED --FEBRUARY 2006. LATEX C C-----NON-COMMON VARIABLES (GRAPHICS)------------------------------------------- C CWINT USE WINTERACTER CINTE USE INTERACTER CHARACTER*4 ICASE CHARACTER*4 IPATTT CHARACTER*4 IHORPA CHARACTER*4 IVERPA CHARACTER*4 IDUPPA CHARACTER*4 IDDOPA C C-----COMMON---------------------------------------------------------- C INCLUDE 'DPCOGR.INC' INCLUDE 'DPCOBE.INC' INCLUDE 'DPCOST.INC' INCLUDE 'DPCODV.INC' C C-----COMMON VARIABLES (GENERAL)-------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C IERRG4='NO' C IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRPA')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF GRTRPA--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)ICASE 52 FORMAT('ICASE = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)IPATTT 53 FORMAT('IPATTT = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,54)PXSPA,PYSPA 54 FORMAT('PXSPA,PYSPA = ',2E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,58)IMANUF,IMODEL 58 FORMAT('IMANUF,IMODEL = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,59)IBUGG4 59 FORMAT('IBUGG4 = ',A4) CALL DPWRST('XXX','BUG ') 90 CONTINUE C C ******************************************** C ** STEP 1-- ** C ** BRANCH ACCORDING TO THE MANUFACTURER ** C ** AND THE MODEL ** C ******************************************** C IF(IMANUF.EQ.'TEKT')GOTO1005 IF(IMANUF.EQ.'HP')GOTO1010 IF(IMANUF.EQ.'PCL')GOTO1015 IF(IMANUF.EQ.'GENE')GOTO1020 IF(IMANUF.EQ.'CALC')GOTO1025 IF(IMANUF.EQ.'ZETA')GOTO1030 IF(IMANUF.EQ.'RAMT')GOTO1035 IF(IMANUF.EQ.'SUN ')GOTO1040 IF(IMANUF.EQ.'XXXX')GOTO1045 IF(IMANUF.EQ.'REGI')GOTO1050 IF(IMANUF.EQ.'POST')GOTO1055 IF(IMANUF.EQ.'QUIC')GOTO1060 IF(IMANUF.EQ.'X11 ')GOTO1065 IF(IMANUF.EQ.'TURB')GOTO1070 IF(IMANUF.EQ.'GKS ')GOTO1075 IF(IMANUF.EQ.'LAHE')GOTO1080 IF(IMANUF.EQ.'GD ')GOTO1085 IF(IMANUF.EQ.'QWIN')GOTO1090 IF(IMANUF.EQ.'OPGL')GOTO1095 IF(IMANUF.EQ.'PRIN')GOTO1096 IF(IMANUF.EQ.'LATE')GOTO1097 IF(IMANUF.EQ.'MACI')GOTO1098 IF(IMANUF.EQ.'SVG ')GOTO1099 GOTO9000 C 1005 CONTINUE IF(IMODEL.EQ.'4020')GOTO1200 IF(IMODEL.EQ.'4022')GOTO1200 IF(IMODEL.EQ.'4025')GOTO1200 IF(IMODEL.EQ.'4027')GOTO1200 C IF(IMODEL.EQ.'4105')GOTO1300 IF(IMODEL.EQ.'4107')GOTO1300 IF(IMODEL.EQ.'4109')GOTO1300 IF(IMODEL.EQ.'4115')GOTO1300 IF(IMODEL.EQ.'4107')GOTO1300 IF(IMODEL.EQ.'4113')GOTO1300 C GOTO1100 C 1010 CONTINUE IF(IMODEL.EQ.'7221')GOTO2100 IF(IMODEL.EQ.'2622')GOTO2300 IF(IMODEL.EQ.'2623')GOTO2300 IF(IMODEL.EQ.'2627')GOTO2300 IF(IMODEL.EQ.'2647')GOTO2300 GOTO2200 C 1015 CONTINUE GOTO2600 C 1020 CONTINUE IF(IMODEL.EQ.'CGM')GOTO3300 IF(IMODEL.EQ.'CGMB')GOTO3400 GOTO3100 C 1025 CONTINUE GOTO4100 C 1030 CONTINUE GOTO5100 C 1035 CONTINUE GOTO6100 C 1040 CONTINUE GOTO6600 C 1045 CONTINUE GOTO7100 C 1050 CONTINUE GOTO8100 C 1055 CONTINUE IF(IMODEL.EQ.'DISP')GOTO8900 GOTO8600 C 1060 CONTINUE GOTO9100 C 1065 CONTINUE GOTO9600 C 1070 CONTINUE GOTO10000 C 1075 CONTINUE GOTO11000 C 1080 CONTINUE IF(IMODEL.EQ.'INTE')GOTO4900 IF(IMODEL.EQ.'WINT')GOTO4950 GOTO4600 C 1085 CONTINUE IF(IMODEL.EQ.'JPEG')GOTO12000 IF(IMODEL.EQ.'PNG ')GOTO12000 IF(IMODEL.EQ.'WBMP')GOTO12000 GOTO12000 C 1090 CONTINUE GOTO4700 C 1095 CONTINUE GOTO4800 C 1096 CONTINUE GOTO14000 C 1097 CONTINUE GOTO15000 C 1098 CONTINUE GOTO13000 C 1099 CONTINUE GOTO16000 C C ******************************** C ** STEP 11-- ** C ** TREAT THE TEKTRONIX 4014 ** C ** REFERENCE--40Z105 MANUAL, PAGE 5-52 ** C ******************************** C 1100 CONTINUE IF(ICASE.EQ.'LINE')GOTO1110 IF(ICASE.EQ.'REGI')GOTO1120 IF(ICASE.EQ.'MARK')GOTO1130 IF(ICASE.EQ.'TEXT')GOTO1140 GOTO1110 C 1110 CONTINUE JPATTT=96 IF(IPATTT.EQ.'SOLI')JPATTT=96 IF(IPATTT.EQ.'SO')JPATTT=96 IF(IPATTT.EQ.'DOTT')JPATTT=97 IF(IPATTT.EQ.'DOT')JPATTT=97 IF(IPATTT.EQ.'DO')JPATTT=97 IF(IPATTT.EQ.'DASH')JPATTT=99 IF(IPATTT.EQ.'DA')JPATTT=99 IF(IPATTT.EQ.'DA1')JPATTT=100 IF(IPATTT.EQ.'DA2')JPATTT=98 IF(IPATTT.EQ.'DA3')JPATTT=102 IF(IPATTT.EQ.'DA4')JPATTT=101 IF(IPATTT.EQ.'DA5')JPATTT=103 CCCCC ADD FOLLOWING 5 LINES OCTOBER 1996 IF(IPATTT.EQ.'BLAN')JPATTT=-1 IF(IPATTT.EQ.'BL ')JPATTT=-1 IF(IPATTT.EQ.'NONE')JPATTT=-1 IF(IPATTT.EQ.'NO ')JPATTT=-1 IF(IPATTT.EQ.' ')JPATTT=-1 GOTO9000 C 1120 CONTINUE CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA) PXSPA2=PXSPA PYSPA2=PYSPA IF(IPATTT.EQ.'SOLI')PXSPA2=0.1 IF(IPATTT.EQ.'SOLI')PYSPA2=0.1 IF(IPATTT.EQ.'FILL')PXSPA2=0.1 IF(IPATTT.EQ.'FILL')PYSPA2=0.1 GOTO9000 C 1130 CONTINUE GOTO9000 C 1140 CONTINUE GOTO9000 C C **************************************************** C ** STEP 12-- ** C ** TREAT THE TEKTRONIX 4027 ** C ** (COLOR RASTER DEVICE). ** C ** TO SET LINE PATTERN, ** C ** XXX ** C ** REFERENCE--4027 OPERATOR'S MANUAL, PAGE XXX. ** C **************************************************** C 1200 CONTINUE IF(ICASE.EQ.'LINE')GOTO1210 IF(ICASE.EQ.'REGI')GOTO1220 IF(ICASE.EQ.'MARK')GOTO1230 IF(ICASE.EQ.'TEXT')GOTO1240 GOTO1240 C 1210 CONTINUE JPATTT=1 IF(IPATTT.EQ.'SOLI')JPATTT=1 IF(IPATTT.EQ.'SO')JPATTT=1 IF(IPATTT.EQ.'DASH')JPATTT=2 IF(IPATTT.EQ.'DA')JPATTT=2 IF(IPATTT.EQ.'DOTT')JPATTT=3 IF(IPATTT.EQ.'DOT')JPATTT=3 IF(IPATTT.EQ.'DO')JPATTT=3 IF(IPATTT.EQ.'DA1')JPATTT=4 IF(IPATTT.EQ.'DA2')JPATTT=5 IF(IPATTT.EQ.'DA3')JPATTT=6 IF(IPATTT.EQ.'DA4')JPATTT=7 IF(IPATTT.EQ.'DA5')JPATTT=8 CCCCC ADD FOLLOWING 5 LINES OCTOBER 1996 IF(IPATTT.EQ.'BLAN')JPATTT=-1 IF(IPATTT.EQ.'BL ')JPATTT=-1 IF(IPATTT.EQ.'NONE')JPATTT=-1 IF(IPATTT.EQ.'NO ')JPATTT=-1 IF(IPATTT.EQ.' ')JPATTT=-1 GOTO9000 C 1220 CONTINUE CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA) PXSPA2=PXSPA PYSPA2=PYSPA IF(IPATTT.EQ.'SOLI')PXSPA2=0.1 IF(IPATTT.EQ.'SOLI')PYSPA2=0.1 IF(IPATTT.EQ.'FILL')PXSPA2=0.1 IF(IPATTT.EQ.'FILL')PYSPA2=0.1 GOTO9000 C 1230 CONTINUE GOTO9000 C 1240 CONTINUE GOTO9000 C C ************************************* C ** STEP 13-- ** C ** TREAT THE TEKTRONIX 4105 CASE ** C ** (COLOR RASTER DEVICE) ** C ** REFERENCE--XXX ** C ************************************* C 1300 CONTINUE IF(ICASE.EQ.'LINE')GOTO1310 IF(ICASE.EQ.'REGI')GOTO1320 IF(ICASE.EQ.'MARK')GOTO1330 IF(ICASE.EQ.'TEXT')GOTO1340 GOTO1310 C 1310 CONTINUE JPATTT=96 IF(IPATTT.EQ.'SOLI')JPATTT=96 IF(IPATTT.EQ.'SO')JPATTT=96 IF(IPATTT.EQ.'DOTT')JPATTT=97 IF(IPATTT.EQ.'DOT')JPATTT=97 IF(IPATTT.EQ.'DO')JPATTT=97 IF(IPATTT.EQ.'DASH')JPATTT=99 IF(IPATTT.EQ.'DA')JPATTT=99 IF(IPATTT.EQ.'DA1')JPATTT=100 IF(IPATTT.EQ.'DA2')JPATTT=98 IF(IPATTT.EQ.'DA3')JPATTT=102 IF(IPATTT.EQ.'DA4')JPATTT=101 IF(IPATTT.EQ.'DA5')JPATTT=103 CCCCC ADD FOLLOWING 5 LINES OCTOBER 1996 IF(IPATTT.EQ.'BLAN')JPATTT=-1 IF(IPATTT.EQ.'BL ')JPATTT=-1 IF(IPATTT.EQ.'NONE')JPATTT=-1 IF(IPATTT.EQ.'NO ')JPATTT=-1 IF(IPATTT.EQ.' ')JPATTT=-1 GOTO9000 C 1320 CONTINUE CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA) PXSPA2=PXSPA PYSPA2=PYSPA CCCCC IF(IPATTT.EQ.'SOLI')PXSPA2=0.1 CCCCC IF(IPATTT.EQ.'SOLI')PYSPA2=0.1 CCCCC IF(IPATTT.EQ.'FILL')PXSPA2=0.1 CCCCC IF(IPATTT.EQ.'FILL')PYSPA2=0.1 GOTO9000 C 1330 CONTINUE GOTO9000 C 1340 CONTINUE GOTO9000 C **************************************************** C ** STEP 21-- ** C ** TREAT THE HEWLETT-PACKARD 7221 CASE ** C ** (MULTI-COLOR PENPLOTTER) ** C ** REFERENCE--HP 7221A GRAPHICS PLOTTER ** C ** OPERATING AND PROGRAMMING MANUAL, ** C ** PAGE XX. ** C **************************************************** C 2100 CONTINUE IF(ICASE.EQ.'LINE')GOTO2110 IF(ICASE.EQ.'REGI')GOTO2120 IF(ICASE.EQ.'MARK')GOTO2130 IF(ICASE.EQ.'TEXT')GOTO2140 GOTO2110 C 2110 CONTINUE GOTO9000 C 2120 CONTINUE CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA) PXSPA2=PXSPA PYSPA2=PYSPA IF(IPATTT.EQ.'SOLI')PXSPA2=0.1 IF(IPATTT.EQ.'SOLI')PYSPA2=0.1 IF(IPATTT.EQ.'FILL')PXSPA2=0.1 IF(IPATTT.EQ.'FILL')PYSPA2=0.1 GOTO9000 C 2130 CONTINUE GOTO9000 C 2140 CONTINUE GOTO9000 C **************************************************** C ** STEP 22-- ** C ** TREAT THE HEWLETT-PACKARD HP-GL CASE ** C ** (MULTI-COLOR PENPLOTTER) ** C ** REFERENCE-- ** C ** ** C ** PAGE XX. ** C **************************************************** C 2200 CONTINUE IF(ICASE.EQ.'LINE')GOTO2210 IF(ICASE.EQ.'REGI')GOTO2220 IF(ICASE.EQ.'MARK')GOTO2230 IF(ICASE.EQ.'TEXT')GOTO2240 GOTO2210 C 2210 CONTINUE JPATTT=-1 IF(IPATTT.EQ.'BLAN')JPATTT=0 IF(IPATTT.EQ.'BL ')JPATTT=0 IF(IPATTT.EQ.'NONE')JPATTT=0 IF(IPATTT.EQ.'NO ')JPATTT=0 IF(IPATTT.EQ.' ')JPATTT=0 IF(IPATTT.EQ.'SOLI')JPATTT=-1 IF(IPATTT.EQ.'SO ')JPATTT=-1 IF(IPATTT.EQ.'DOTT')JPATTT=1 IF(IPATTT.EQ.'DOT ')JPATTT=1 IF(IPATTT.EQ.'DO ')JPATTT=1 IF(IPATTT.EQ.'DASH')JPATTT=2 IF(IPATTT.EQ.'DA ')JPATTT=2 IF(IPATTT.EQ.'DA1 ')JPATTT=3 IF(IPATTT.EQ.'DA2 ')JPATTT=4 IF(IPATTT.EQ.'DA3 ')JPATTT=5 IF(IPATTT.EQ.'DA4 ')JPATTT=6 GOTO9000 C 2220 CONTINUE CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA) PXSPA2=PXSPA PYSPA2=PYSPA IF(IPATTT.EQ.'SOLI')PXSPA2=0.1 IF(IPATTT.EQ.'SOLI')PYSPA2=0.1 IF(IPATTT.EQ.'FILL')PXSPA2=0.1 IF(IPATTT.EQ.'FILL')PYSPA2=0.1 GOTO9000 C 2230 CONTINUE GOTO9000 C 2240 CONTINUE GOTO9000 C C ********************************************************** C ** STEP 23-- ** C ** TREAT THE HEWLETT-PACKARD HP-2622 CASES ** C ** (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS) ** C ** (MONOCHROME DISPLAY TERMINALS) ** C ** REFERENCE--HP 2322C GRAPHICS PLOTTER ** C ** REFERENCE MANUAL, ** C ** PAGE 10-6, 10-7. ** C ********************************************************** C 2300 CONTINUE IF(ICASE.EQ.'LINE')GOTO2310 IF(ICASE.EQ.'REGI')GOTO2320 IF(ICASE.EQ.'MARK')GOTO2330 IF(ICASE.EQ.'TEXT')GOTO2340 GOTO2310 C 2310 CONTINUE JPATTT=1 IF(IPATTT.EQ.'BLAN')JPATTT=11 IF(IPATTT.EQ.'BL ')JPATTT=11 IF(IPATTT.EQ.'NONE')JPATTT=11 IF(IPATTT.EQ.'NO ')JPATTT=11 IF(IPATTT.EQ.' ')JPATTT=11 IF(IPATTT.EQ.'SOLI')JPATTT=1 IF(IPATTT.EQ.'SO ')JPATTT=1 IF(IPATTT.EQ.'DOTT')JPATTT=7 IF(IPATTT.EQ.'DOT ')JPATTT=7 IF(IPATTT.EQ.'DO ')JPATTT=7 IF(IPATTT.EQ.'DASH')JPATTT=6 IF(IPATTT.EQ.'DA ')JPATTT=6 IF(IPATTT.EQ.'DA1 ')JPATTT=5 IF(IPATTT.EQ.'DA2 ')JPATTT=4 IF(IPATTT.EQ.'DA3 ')JPATTT=10 IF(IPATTT.EQ.'DA4 ')JPATTT=8 C 2320 CONTINUE CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA) PXSPA2=PXSPA PYSPA2=PYSPA IF(IPATTT.EQ.'SOLI')PXSPA2=0.1 IF(IPATTT.EQ.'SOLI')PYSPA2=0.1 IF(IPATTT.EQ.'FILL')PXSPA2=0.1 IF(IPATTT.EQ.'FILL')PYSPA2=0.1 GOTO9000 C 2330 CONTINUE GOTO9000 C 2340 CONTINUE GOTO9000 C C ********************************************************** C ** STEP 26-- ** C ** TREAT THE HEWLETT-PACKARD PCL CASES ** C ********************************************************** C 2600 CONTINUE IF(ICASE.EQ.'LINE')GOTO2610 IF(ICASE.EQ.'REGI')GOTO2620 IF(ICASE.EQ.'MARK')GOTO2630 IF(ICASE.EQ.'TEXT')GOTO2640 GOTO2610 C 2610 CONTINUE C 2620 CONTINUE CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA) PXSPA2=PXSPA PYSPA2=PYSPA GOTO9000 C 2630 CONTINUE GOTO9000 C 2640 CONTINUE GOTO9000 C C *************************************************** C ** STEP 31-- ** C ** TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE ** C *************************************************** C 3100 CONTINUE IF(ICASE.EQ.'LINE')GOTO3110 IF(ICASE.EQ.'REGI')GOTO3120 IF(ICASE.EQ.'MARK')GOTO3130 IF(ICASE.EQ.'TEXT')GOTO3140 GOTO3110 C 3110 CONTINUE GOTO9000 C 3120 CONTINUE CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA) PXSPA2=PXSPA PYSPA2=PYSPA C MARCH, 1988 CCCCC IF(IPATTT.EQ.'SOLI')PXSPA2=0.1 CCCCC IF(IPATTT.EQ.'SOLI')PYSPA2=0.1 CCCCC IF(IPATTT.EQ.'FILL')PXSPA2=0.1 CCCCC IF(IPATTT.EQ.'FILL')PYSPA2=0.1 IF(IPATTT.EQ.'SOLI')PXSPA2=PPENSW IF(IPATTT.EQ.'SOLI')PYSPA2=PPENSW IF(IPATTT.EQ.'FILL')PXSPA2=PPENSW IF(IPATTT.EQ.'FILL')PYSPA2=PPENSW GOTO9000 C 3130 CONTINUE GOTO9000 C 3140 CONTINUE GOTO9000 C C C ****************************************************** C ** STEP 33-- ** C ** TREAT THE CGM CASE ** C ** LINE ** C ** 1 - SOLID ** C ** 2 - DASH ** C ** 3 - DOT ** C ** 4 - DASH-DOT ** C ** 5 - DASH-DOT-DOT ** C ** REGION ** C ** 1 - PARALLEL HORIZONTAL LINES ** C ** 2 - PARALLEL VERTICAL LINES ** C ** 3 - 45 DEGREE LINES ** C ** 4 - 135 DEGREE LINES ** C ** 5 - CROSS-HATCH WITH 45 AND 135 DEGREE LINES ** C ** MARKERS AND TEXT PATTERNS NOT CURRENTLY ** C ** UTILIZED BY DATAPLOT ** C ****************************************************** C 3300 CONTINUE IF(ICASE.EQ.'LINE')GOTO3310 IF(ICASE.EQ.'REGI')GOTO3320 IF(ICASE.EQ.'MARK')GOTO3330 IF(ICASE.EQ.'TEXT')GOTO3340 GOTO3310 C 3310 CONTINUE JPATT=1 IF(IPATTT.EQ.'BLAN')JPATTT=0 IF(IPATTT.EQ.'BL ')JPATTT=0 IF(IPATTT.EQ.'NONE')JPATTT=0 IF(IPATTT.EQ.'NO ')JPATTT=0 IF(IPATTT.EQ.' ')JPATTT=0 IF(IPATTT.EQ.'SOLI')JPATTT=1 IF(IPATTT.EQ.'SO ')JPATTT=1 IF(IPATTT.EQ.'DOTT')JPATTT=3 IF(IPATTT.EQ.'DOT ')JPATTT=3 IF(IPATTT.EQ.'DO ')JPATTT=3 IF(IPATTT.EQ.'DASH')JPATTT=2 IF(IPATTT.EQ.'DA ')JPATTT=2 IF(IPATTT.EQ.'DA1 ')JPATTT=4 IF(IPATTT.EQ.'DA2 ')JPATTT=5 IF(IPATTT.EQ.'DA3 ')JPATTT=4 IF(IPATTT.EQ.'DA4 ')JPATTT=5 GOTO9000 C C NOTE: PPENSW IS THE WIDTH OF A SINGLE LINE FOR METAFILES. C USER SETTABLE VIA "SET GENERAL PEN WIDTH " C 3320 CONTINUE CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA) JPATTT=0 IF(IPATTT.EQ.'SOLI')JPATTT=0 IF(IPATTT.EQ.'FILL')JPATTT=0 IF(IPATTT.EQ.'HORI')JPATTT=1 IF(IPATTT.EQ.'VERT')JPATTT=2 IF(IPATTT.EQ.'D1')JPATTT=3 IF(IPATTT.EQ.'D2')JPATTT=4 IF(IPATTT.EQ.'HV')JPATTT=5 IF(IPATTT.EQ.'D1D2')JPATTT=6 IF(IPATTT.EQ.'HD1')JPATTT=6 IF(IPATTT.EQ.'HD2')JPATTT=6 IF(IPATTT.EQ.'VD1')JPATTT=6 IF(IPATTT.EQ.'VD2')JPATTT=6 IF(IPATTT.EQ.'HVD1')JPATTT=6 IF(IPATTT.EQ.'HVD2')JPATTT=6 IF(IPATTT.EQ.'ALL')JPATTT=6 PXSPA2=PXSPA PYSPA2=PYSPA IF(IPATTT.EQ.'SOLI')PXSPA2=PPENSW IF(IPATTT.EQ.'SOLI')PYSPA2=PPENSW IF(IPATTT.EQ.'FILL')PXSPA2=PPENSW IF(IPATTT.EQ.'FILL')PYSPA2=PPENSW GOTO9000 C 3330 CONTINUE GOTO9000 C 3340 CONTINUE GOTO9000 C C *************************************************** C ** STEP 34-- ** C ** TREAT THE CGM (BINARY) CASE ** C *************************************************** C 3400 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 41-- ** C ** TREAT THE CALCOMP XXXXXX CASE ** C ** (NOT DONE) ** C ** REFERENCE--XX ** C ** XX ** C ** PAGES XX AND XX ** C ****************************************************** C 4100 CONTINUE IF(ICASE.EQ.'LINE')GOTO4110 IF(ICASE.EQ.'REGI')GOTO4120 IF(ICASE.EQ.'MARK')GOTO4130 IF(ICASE.EQ.'TEXT')GOTO4140 GOTO4110 C 4110 CONTINUE JPATTT=0 IF(IPATTT.EQ.'SOLI')JPATTT=0 IF(IPATTT.EQ.'SO')JPATTT=0 IF(IPATTT.EQ.'DOTT')JPATTT=2 IF(IPATTT.EQ.'DOT')JPATTT=2 IF(IPATTT.EQ.'DO')JPATTT=2 IF(IPATTT.EQ.'DASH')JPATTT=1 IF(IPATTT.EQ.'DA')JPATTT=1 IF(IPATTT.EQ.'DA1')JPATTT=3 IF(IPATTT.EQ.'DA2')JPATTT=4 IF(IPATTT.EQ.'DA3')JPATTT=5 IF(IPATTT.EQ.'DA4')JPATTT=6 IF(IPATTT.EQ.'DA5')JPATTT=7 CCCCC ADD FOLLOWING 5 LINES OCTOBER 1996 IF(IPATTT.EQ.'BLAN')JPATTT=-1 IF(IPATTT.EQ.'BL ')JPATTT=-1 IF(IPATTT.EQ.'NONE')JPATTT=-1 IF(IPATTT.EQ.'NO ')JPATTT=-1 IF(IPATTT.EQ.' ')JPATTT=-1 GOTO9000 C 4120 CONTINUE CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA) PXSPA2=PXSPA PYSPA2=PYSPA IF(IPATTT.EQ.'SOLI')PXSPA2=PCALTH IF(IPATTT.EQ.'SOLI')PYSPA2=PCALTH IF(IPATTT.EQ.'FILL')PXSPA2=PCALTH IF(IPATTT.EQ.'FILL')PYSPA2=PCALTH GOTO9000 C 4130 CONTINUE GOTO9000 C 4140 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 46-- ** C ** TREAT THE LAHEY XXXXXX CASE ** C ** REFERENCE--Programmer's Reference, Revision C ** C ** Lahey Computer Systems, January, 1992** C ** PAGES 51 THRU 65 ** C ****************************************************** C 4600 CONTINUE IF(ICASE.EQ.'LINE')GOTO4610 IF(ICASE.EQ.'REGI')GOTO4620 IF(ICASE.EQ.'MARK')GOTO4630 IF(ICASE.EQ.'TEXT')GOTO4640 GOTO4610 C 4610 CONTINUE JPATTT=0 IF(IPATTT.EQ.'SOLI')JPATTT=0 IF(IPATTT.EQ.'SO')JPATTT=0 IF(IPATTT.EQ.'DOTT')JPATTT=2 IF(IPATTT.EQ.'DOT')JPATTT=2 IF(IPATTT.EQ.'DO')JPATTT=2 IF(IPATTT.EQ.'DASH')JPATTT=1 IF(IPATTT.EQ.'DA')JPATTT=1 IF(IPATTT.EQ.'DA1')JPATTT=3 IF(IPATTT.EQ.'DA2')JPATTT=4 IF(IPATTT.EQ.'DA3')JPATTT=5 IF(IPATTT.EQ.'DA4')JPATTT=6 IF(IPATTT.EQ.'DA5')JPATTT=7 CCCCC ADD FOLLOWING 5 LINES OCTOBER 1996 IF(IPATTT.EQ.'BLAN')JPATTT=-1 IF(IPATTT.EQ.'BL ')JPATTT=-1 IF(IPATTT.EQ.'NONE')JPATTT=-1 IF(IPATTT.EQ.'NO ')JPATTT=-1 IF(IPATTT.EQ.' ')JPATTT=-1 GOTO9000 C 4620 CONTINUE CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA) PXSPA2=PXSPA PYSPA2=PYSPA IF(IPATTT.EQ.'SOLI')PXSPA2=PCALTH IF(IPATTT.EQ.'SOLI')PYSPA2=PCALTH IF(IPATTT.EQ.'FILL')PXSPA2=PCALTH IF(IPATTT.EQ.'FILL')PYSPA2=PCALTH GOTO9000 C 4630 CONTINUE GOTO9000 C 4640 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 47-- ** C ** TREAT THE MICROSOFT QUICKWIN DRIVER ** C ** FOR WINDOWS 95 AND WINDOWS NT. ** C ****************************************************** C 4700 CONTINUE IF(ICASE.EQ.'LINE')GOTO4710 IF(ICASE.EQ.'REGI')GOTO4720 IF(ICASE.EQ.'MARK')GOTO4730 IF(ICASE.EQ.'TEXT')GOTO4740 GOTO4710 C 4710 CONTINUE JPATTT=0 IF(IPATTT.EQ.'SOLI')JPATTT=1 IF(IPATTT.EQ.'SO')JPATTT=1 IF(IPATTT.EQ.'DOTT')JPATTT=2 IF(IPATTT.EQ.'DOT')JPATTT=2 IF(IPATTT.EQ.'DO')JPATTT=2 IF(IPATTT.EQ.'DASH')JPATTT=3 IF(IPATTT.EQ.'DA')JPATTT=3 IF(IPATTT.EQ.'DA1')JPATTT=3 IF(IPATTT.EQ.'DA2')JPATTT=4 IF(IPATTT.EQ.'DA3')JPATTT=5 IF(IPATTT.EQ.'DA4')JPATTT=6 IF(IPATTT.EQ.'DA5')JPATTT=7 IF(IPATTT.EQ.'BLAN')JPATTT=-1 IF(IPATTT.EQ.'BL ')JPATTT=-1 IF(IPATTT.EQ.'NONE')JPATTT=-1 IF(IPATTT.EQ.'NO ')JPATTT=-1 IF(IPATTT.EQ.' ')JPATTT=-1 GOTO9000 C 4720 CONTINUE CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA) PXSPA2=PXSPA PYSPA2=PYSPA IF(IPATTT.EQ.'SOLI')PXSPA2=0.1 IF(IPATTT.EQ.'SOLI')PYSPA2=0.1 IF(IPATTT.EQ.'FILL')PXSPA2=0.1 IF(IPATTT.EQ.'FILL')PYSPA2=0.1 GOTO9000 C 4730 CONTINUE GOTO9000 C 4740 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 48-- ** C ** TREAT THE OPEN-GL DRIVER ** C ** FOR WINDOWS 95 AND WINDOWS NT AND X11 ** C ****************************************************** C 4800 CONTINUE IF(ICASE.EQ.'LINE')GOTO4810 IF(ICASE.EQ.'REGI')GOTO4820 IF(ICASE.EQ.'MARK')GOTO4830 IF(ICASE.EQ.'TEXT')GOTO4840 GOTO4810 C 4810 CONTINUE JPATTT=0 IF(IPATTT.EQ.'SOLI')JPATTT=1 IF(IPATTT.EQ.'SO')JPATTT=1 IF(IPATTT.EQ.'DOTT')JPATTT=2 IF(IPATTT.EQ.'DOT')JPATTT=2 IF(IPATTT.EQ.'DO')JPATTT=2 IF(IPATTT.EQ.'DASH')JPATTT=3 IF(IPATTT.EQ.'DA')JPATTT=3 IF(IPATTT.EQ.'DA1')JPATTT=3 IF(IPATTT.EQ.'DA2')JPATTT=4 IF(IPATTT.EQ.'DA3')JPATTT=5 IF(IPATTT.EQ.'DA4')JPATTT=6 IF(IPATTT.EQ.'DA5')JPATTT=7 IF(IPATTT.EQ.'BLAN')JPATTT=-1 IF(IPATTT.EQ.'BL ')JPATTT=-1 IF(IPATTT.EQ.'NONE')JPATTT=-1 IF(IPATTT.EQ.'NO ')JPATTT=-1 IF(IPATTT.EQ.' ')JPATTT=-1 GOTO9000 C 4820 CONTINUE CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA) PXSPA2=PXSPA PYSPA2=PYSPA IF(IPATTT.EQ.'SOLI')PXSPA2=0.1 IF(IPATTT.EQ.'SOLI')PYSPA2=0.1 IF(IPATTT.EQ.'FILL')PXSPA2=0.1 IF(IPATTT.EQ.'FILL')PYSPA2=0.1 GOTO9000 C 4830 CONTINUE GOTO9000 C 4840 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 49-- ** C ** TREAT THE LAHEY INTERACTOR CASE ** C ****************************************************** C 4900 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 49B- ** C ** TREAT THE LAHEY WINTERACTOR CASE ** C ****************************************************** C 4950 CONTINUE IF(ICASE.EQ.'LINE')GOTO4960 IF(ICASE.EQ.'REGI')GOTO4970 IF(ICASE.EQ.'MARK')GOTO4980 IF(ICASE.EQ.'TEXT')GOTO4990 GOTO4960 C 4960 CONTINUE JPATTT=0 IF(IPATTT.EQ.'SOLI')JPATTT=0 IF(IPATTT.EQ.'SO')JPATTT=0 IF(IPATTT.EQ.'DOTT')JPATTT=1 IF(IPATTT.EQ.'DOT')JPATTT=1 IF(IPATTT.EQ.'DO')JPATTT=1 IF(IPATTT.EQ.'DASH')JPATTT=2 IF(IPATTT.EQ.'DA')JPATTT=2 IF(IPATTT.EQ.'DA1')JPATTT=3 IF(IPATTT.EQ.'DA2')JPATTT=4 IF(IPATTT.EQ.'DA3')JPATTT=3 IF(IPATTT.EQ.'DA4')JPATTT=4 IF(IPATTT.EQ.'DA5')JPATTT=3 IF(IPATTT.EQ.'BLAN')JPATTT=-1 IF(IPATTT.EQ.'BL ')JPATTT=-1 IF(IPATTT.EQ.'NONE')JPATTT=-1 IF(IPATTT.EQ.'NO ')JPATTT=-1 IF(IPATTT.EQ.' ')JPATTT=-1 GOTO9000 C 4970 CONTINUE CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA) PXSPA2=PXSPA PYSPA2=PYSPA IF(IPATTT.EQ.'SOLI')PXSPA2=0.1 IF(IPATTT.EQ.'SOLI')PYSPA2=0.1 IF(IPATTT.EQ.'FILL')PXSPA2=0.1 IF(IPATTT.EQ.'FILL')PYSPA2=0.1 GOTO9000 C 4980 CONTINUE GOTO9000 C 4990 CONTINUE GOTO9000 C C C ****************************************************** C ** STEP 51-- ** C ** TREAT THE ZETA 3600SX AND 3653SX CASES ** C ** REFERENCE--USER MANUAL FOR DIGITAL PLOTTER ** C ** MODELS 3600SX AND 3653SX ** C ** PAGES B-0 AND B-1 ** C ** USE ZETA EXTENSION TO STANDARD CALCOMP LIBRARY ** C ** ALTHOUGH USER CAN DEFINE THE DASH PATTERN, USE ** C ** THE 6 PRE-DEFINED DASH PATTERNS ** C ****************************************************** C 5100 CONTINUE IF(ICASE.EQ.'LINE')GOTO5110 IF(ICASE.EQ.'REGI')GOTO5120 IF(ICASE.EQ.'MARK')GOTO5130 IF(ICASE.EQ.'TEXT')GOTO5140 GOTO5110 C 5110 CONTINUE JPATTT=0 IF(IPATTT.EQ.'SOLI')JPATTT=0 IF(IPATTT.EQ.'SO')JPATTT=0 IF(IPATTT.EQ.'DOTT')JPATTT=2 IF(IPATTT.EQ.'DOT')JPATTT=2 IF(IPATTT.EQ.'DO')JPATTT=2 IF(IPATTT.EQ.'DASH')JPATTT=1 IF(IPATTT.EQ.'DA')JPATTT=1 IF(IPATTT.EQ.'DA1')JPATTT=3 IF(IPATTT.EQ.'DA2')JPATTT=4 IF(IPATTT.EQ.'DA3')JPATTT=5 IF(IPATTT.EQ.'DA4')JPATTT=6 IF(IPATTT.EQ.'DA5')JPATTT=1 CCCCC ADD FOLLOWING 5 LINES OCTOBER 1996 IF(IPATTT.EQ.'BLAN')JPATTT=-1 IF(IPATTT.EQ.'BL ')JPATTT=-1 IF(IPATTT.EQ.'NONE')JPATTT=-1 IF(IPATTT.EQ.'NO ')JPATTT=-1 IF(IPATTT.EQ.' ')JPATTT=-1 GOTO9000 C 5120 CONTINUE CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA) PXSPA2=PXSPA PYSPA2=PYSPA IF(IPATTT.EQ.'SOLI')PXSPA2=PZETTH IF(IPATTT.EQ.'SOLI')PYSPA2=PZETTH IF(IPATTT.EQ.'FILL')PXSPA2=PZETTH IF(IPATTT.EQ.'FILL')PYSPA2=PZETTH GOTO9000 C 5130 CONTINUE GOTO9000 C 5140 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 61-- ** C ** TREAT THE RAMTEK XXXXXX CASE ** C ** (NOT DONE) ** C ** REFERENCE--XX ** C ** XX ** C ** PAGES XX AND XX ** C ****************************************************** C 6100 CONTINUE IF(ICASE.EQ.'LINE')GOTO6110 IF(ICASE.EQ.'REGI')GOTO6120 IF(ICASE.EQ.'MARK')GOTO6130 IF(ICASE.EQ.'TEXT')GOTO6140 GOTO6110 C 6110 CONTINUE GOTO9000 C 6120 CONTINUE GOTO9000 C 6130 CONTINUE GOTO9000 C 6140 CONTINUE GOTO9000 C C C ****************************************************** C ** STEP 66-- ** C ** TREAT THE SUN CASE ** C ****************************************************** C 6600 CONTINUE IF(ICASE.EQ.'LINE')GOTO6610 IF(ICASE.EQ.'REGI')GOTO6620 IF(ICASE.EQ.'MARK')GOTO6630 IF(ICASE.EQ.'TEXT')GOTO6640 GOTO6610 C 6610 CONTINUE JPATTT=0 IF(IPATTT.EQ.'BLAN')JPATTT=-1 IF(IPATTT.EQ.'BL ')JPATTT=-1 IF(IPATTT.EQ.'NONE')JPATTT=-1 IF(IPATTT.EQ.'NO ')JPATTT=-1 IF(IPATTT.EQ.' ')JPATTT=-1 IF(IPATTT.EQ.'SOLI')JPATTT=0 IF(IPATTT.EQ.'SO ')JPATTT=0 IF(IPATTT.EQ.'DOTT')JPATTT=1 IF(IPATTT.EQ.'DOT ')JPATTT=1 IF(IPATTT.EQ.'DO ')JPATTT=1 IF(IPATTT.EQ.'DASH')JPATTT=2 IF(IPATTT.EQ.'DA ')JPATTT=2 IF(IPATTT.EQ.'DA1 ')JPATTT=3 IF(IPATTT.EQ.'DA2 ')JPATTT=4 IF(IPATTT.EQ.'DA3 ')JPATTT=5 GOTO9000 C 6620 CONTINUE CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA) PXSPA2=PXSPA PYSPA2=PYSPA IF(IPATTT.EQ.'SOLI')PXSPA2=0.1 IF(IPATTT.EQ.'SOLI')PYSPA2=0.1 IF(IPATTT.EQ.'FILL')PXSPA2=0.1 IF(IPATTT.EQ.'FILL')PYSPA2=0.1 GOTO9000 C 6630 CONTINUE GOTO9000 C 6640 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 71-- ** C ** TREAT THE XXXXXX XXXXXX CASE ** C ** (NOT DONE) ** C ** REFERENCE--XX ** C ** XX ** C ** PAGES XX AND XX ** C ****************************************************** C 7100 CONTINUE IF(ICASE.EQ.'LINE')GOTO7110 IF(ICASE.EQ.'REGI')GOTO7120 IF(ICASE.EQ.'MARK')GOTO7130 IF(ICASE.EQ.'TEXT')GOTO7140 GOTO7110 C 7110 CONTINUE GOTO9000 C 7120 CONTINUE GOTO9000 C 7130 CONTINUE GOTO9000 C 7140 CONTINUE GOTO9000 C C C ****************************************************** C ** STEP 81-- ** C ** TREAT THE REGIS CASE ** C ****************************************************** C 8100 CONTINUE IF(ICASE.EQ.'LINE')GOTO8110 IF(ICASE.EQ.'REGI')GOTO8120 IF(ICASE.EQ.'MARK')GOTO8130 IF(ICASE.EQ.'TEXT')GOTO8140 GOTO8110 C 8110 CONTINUE JPATTT=1 IF(IPATTT.EQ.'BLAN')JPATTT=0 IF(IPATTT.EQ.'BL ')JPATTT=0 IF(IPATTT.EQ.'NONE')JPATTT=0 IF(IPATTT.EQ.'NO ')JPATTT=0 IF(IPATTT.EQ.' ')JPATTT=0 IF(IPATTT.EQ.'SOLI')JPATTT=1 IF(IPATTT.EQ.'SO')JPATTT=1 IF(IPATTT.EQ.'DOTT')JPATTT=4 IF(IPATTT.EQ.'DOT')JPATTT=4 IF(IPATTT.EQ.'DO')JPATTT=4 IF(IPATTT.EQ.'DASH')JPATTT=2 IF(IPATTT.EQ.'DA')JPATTT=2 IF(IPATTT.EQ.'DA1')JPATTT=3 IF(IPATTT.EQ.'DA2')JPATTT=5 IF(IPATTT.EQ.'DA3')JPATTT=6 IF(IPATTT.EQ.'DA4')JPATTT=6 IF(IPATTT.EQ.'DA5')JPATTT=6 GOTO9000 C 8120 CONTINUE CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA) PXSPA2=PXSPA PYSPA2=PYSPA IF(IPATTT.EQ.'SOLI')PXSPA2=0.1 IF(IPATTT.EQ.'SOLI')PYSPA2=0.1 IF(IPATTT.EQ.'FILL')PXSPA2=0.1 IF(IPATTT.EQ.'FILL')PYSPA2=0.1 GOTO9000 C 8130 CONTINUE GOTO9000 C 8140 CONTINUE GOTO9000 C C C ****************************************************** C ** STEP 86-- ** C ** TREAT THE POSTSCRIPT CASE ** C ****************************************************** C 8600 CONTINUE IF(ICASE.EQ.'LINE')GOTO8610 IF(ICASE.EQ.'REGI')GOTO8620 IF(ICASE.EQ.'MARK')GOTO8630 IF(ICASE.EQ.'TEXT')GOTO8640 GOTO8610 C 8610 CONTINUE JPATTT=1 IF(IPATTT.EQ.'BLAN')JPATTT=0 IF(IPATTT.EQ.'BL ')JPATTT=0 IF(IPATTT.EQ.'NONE')JPATTT=0 IF(IPATTT.EQ.'NO ')JPATTT=0 IF(IPATTT.EQ.' ')JPATTT=0 IF(IPATTT.EQ.'SOLI')JPATTT=1 IF(IPATTT.EQ.'SO')JPATTT=1 IF(IPATTT.EQ.'DOTT')JPATTT=2 IF(IPATTT.EQ.'DOT')JPATTT=2 IF(IPATTT.EQ.'DO')JPATTT=2 IF(IPATTT.EQ.'DASH')JPATTT=3 IF(IPATTT.EQ.'DA')JPATTT=3 IF(IPATTT.EQ.'DA1')JPATTT=4 IF(IPATTT.EQ.'DA2')JPATTT=5 IF(IPATTT.EQ.'DA3')JPATTT=6 IF(IPATTT.EQ.'DA4')JPATTT=7 IF(IPATTT.EQ.'DA5')JPATTT=7 GOTO9000 C 8620 CONTINUE CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA) PXSPA2=PXSPA PYSPA2=PYSPA GOTO9000 C 8630 CONTINUE GOTO9000 C 8640 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 89-- ** C ** TREAT THE DISPLAY POSTSCRIPT DRIVER ** C ****************************************************** C 8900 CONTINUE IF(ICASE.EQ.'LINE')GOTO8910 IF(ICASE.EQ.'REGI')GOTO8920 IF(ICASE.EQ.'MARK')GOTO8930 IF(ICASE.EQ.'TEXT')GOTO8940 GOTO8910 C 8910 CONTINUE JPATTT=1 IF(IPATTT.EQ.'BLAN')JPATTT=0 IF(IPATTT.EQ.'BL ')JPATTT=0 IF(IPATTT.EQ.'NONE')JPATTT=0 IF(IPATTT.EQ.'NO ')JPATTT=0 IF(IPATTT.EQ.' ')JPATTT=0 IF(IPATTT.EQ.'SOLI')JPATTT=1 IF(IPATTT.EQ.'SO')JPATTT=1 IF(IPATTT.EQ.'DOTT')JPATTT=2 IF(IPATTT.EQ.'DOT')JPATTT=2 IF(IPATTT.EQ.'DO')JPATTT=2 IF(IPATTT.EQ.'DASH')JPATTT=3 IF(IPATTT.EQ.'DA')JPATTT=3 IF(IPATTT.EQ.'DA1')JPATTT=4 IF(IPATTT.EQ.'DA2')JPATTT=5 IF(IPATTT.EQ.'DA3')JPATTT=6 IF(IPATTT.EQ.'DA4')JPATTT=7 IF(IPATTT.EQ.'DA5')JPATTT=7 GOTO9000 C 8920 CONTINUE CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA) PXSPA2=PXSPA PYSPA2=PYSPA GOTO9000 C 8930 CONTINUE GOTO9000 C 8940 CONTINUE GOTO9000 C C C ****************************************************** C ** STEP 91-- ** C ** TREAT THE QUIC CASE ** C ** USE THE PREDEFINED PATTERNS ** C ** REFERENCE--QUIC PROGRAMMING MANUAL FROM QMS ** C ** P 14-7 ** C ****************************************************** C 9100 CONTINUE IF(ICASE.EQ.'LINE')GOTO9110 IF(ICASE.EQ.'REGI')GOTO9120 IF(ICASE.EQ.'MARK')GOTO9130 IF(ICASE.EQ.'TEXT')GOTO9140 GOTO9110 C 9110 CONTINUE JPATTT=0 IF(IPATTT.EQ.'SOLI')JPATTT=0 IF(IPATTT.EQ.'SO')JPATTT=0 IF(IPATTT.EQ.'DOTT')JPATTT=2 IF(IPATTT.EQ.'DOT')JPATTT=2 IF(IPATTT.EQ.'DO')JPATTT=2 IF(IPATTT.EQ.'DASH')JPATTT=1 IF(IPATTT.EQ.'DA')JPATTT=1 IF(IPATTT.EQ.'DA1')JPATTT=3 IF(IPATTT.EQ.'DA2')JPATTT=4 IF(IPATTT.EQ.'DA3')JPATTT=5 IF(IPATTT.EQ.'DA4')JPATTT=6 IF(IPATTT.EQ.'DA5')JPATTT=7 CCCCC ADD FOLLOWING 5 LINES OCTOBER 1996 IF(IPATTT.EQ.'BLAN')JPATTT=-1 IF(IPATTT.EQ.'BL ')JPATTT=-1 IF(IPATTT.EQ.'NONE')JPATTT=-1 IF(IPATTT.EQ.'NO ')JPATTT=-1 IF(IPATTT.EQ.' ')JPATTT=-1 GOTO9000 C 9120 CONTINUE CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA) C C LINE WILL BE 3 PIXELS WIDE. BASE SPACING FOR SOLID FILL ON C NUMBER OF HORIZONTAL PICTURE POINTS. C PXSPA2=PXSPA PYSPA2=PYSPA IF(IPATTT.EQ.'SOLI')PXSPA2=100.*(3./ANUMHP) IF(IPATTT.EQ.'SOLI')PYSPA2=100.*(3./ANUMVP) IF(IPATTT.EQ.'FILL')PXSPA2=100.*(3./ANUMHP) IF(IPATTT.EQ.'FILL')PYSPA2=100.*(3./ANUMVP) GOTO9000 C 9130 CONTINUE GOTO9000 C 9140 CONTINUE GOTO9000 C C C ****************************************************** C ** STEP 96-- ** C ** TREAT THE X11 CASE ** C ** NOTE THAT FOR LINE PATTERNS, A SOLID, DASH, DOT,** C ** AND DASH-DOT PATTERNS ARE DEFINED IN THE C ** C ** LIBRARY. CURRENTLY, DASH1-DASH5 ALL SET THE SAME* C ** DASH-DOT PATTERN. HOWEVER, THE NUMBER OF DASH ** C ** PATTERNS MAY BE INCREASED IN THE FUTURE (THE ** C ** CAN DEFINE ARBITRARY DASH PATTERNS). ** C ** X11 DOES NOT DEFINE ANY HATCH PATTERNS. IT DOES** C ** ALLOW PRE-BUILT BIT ARRAYS (USUALLY 8X8 OR 16X16** C ** PIXELS) TO FILL REGIONS WITH PATTERNS. HOWEVER,** C ** THIS IS NOT CONSISTENT WITH HOW DATAPLOT DEFINES** C ** PATTERNS, SO LET DATAPLOT DO REGION FILLS IN ** C ** SOFTWARE. ** C ****************************************************** C 9600 CONTINUE IF(ICASE.EQ.'LINE')GOTO9610 IF(ICASE.EQ.'REGI')GOTO9620 IF(ICASE.EQ.'MARK')GOTO9630 IF(ICASE.EQ.'TEXT')GOTO9640 GOTO9610 C 9610 CONTINUE JPATTT=0 IF(IPATTT.EQ.'SOLI')JPATTT=0 IF(IPATTT.EQ.'SO')JPATTT=0 IF(IPATTT.EQ.'DOTT')JPATTT=2 IF(IPATTT.EQ.'DOT')JPATTT=2 IF(IPATTT.EQ.'DO')JPATTT=2 IF(IPATTT.EQ.'DASH')JPATTT=1 IF(IPATTT.EQ.'DA')JPATTT=1 IF(IPATTT.EQ.'DA1')JPATTT=3 IF(IPATTT.EQ.'DA2')JPATTT=4 IF(IPATTT.EQ.'DA3')JPATTT=5 IF(IPATTT.EQ.'DA4')JPATTT=6 IF(IPATTT.EQ.'DA5')JPATTT=7 CCCCC ADD FOLLOWING 5 LINES OCTOBER 1996 IF(IPATTT.EQ.'BLAN')JPATTT=-1 IF(IPATTT.EQ.'BL ')JPATTT=-1 IF(IPATTT.EQ.'NONE')JPATTT=-1 IF(IPATTT.EQ.'NO ')JPATTT=-1 IF(IPATTT.EQ.' ')JPATTT=-1 GOTO9000 C 9620 CONTINUE CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA) PXSPA2=PXSPA PYSPA2=PYSPA IF(IPATTT.EQ.'SOLI')PXSPA2=0.1 IF(IPATTT.EQ.'SOLI')PYSPA2=0.1 IF(IPATTT.EQ.'FILL')PXSPA2=0.1 IF(IPATTT.EQ.'FILL')PYSPA2=0.1 GOTO9000 C 9630 CONTINUE GOTO9000 C 9640 CONTINUE GOTO9000 C CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1991 (JJF) C ************************************************* C ** STEP 100-- ** C ** TREAT THE VGA VIA TURBO-C CASE ** C ** REFERENCE--TURBO C 1.5 ADDITIONS & ** C ** ENHANCEMENTS, PAGE 83. ** C ** REFERENCE--TURBO C 2.0 REFERENCE GUIDE, ** C ** PAGE 320. ** C ** REFERENCE--WEISKAMP, POWER GRAPHICS ** C ** USING TURBO C, PAGE 29. ** C ************************************************* C 10000 CONTINUE IF(ICASE.EQ.'LINE')GOTO10610 IF(ICASE.EQ.'REGI')GOTO10620 IF(ICASE.EQ.'MARK')GOTO10630 IF(ICASE.EQ.'TEXT')GOTO10640 GOTO10610 C 10610 CONTINUE JPATTT=0 IF(IPATTT.EQ.'SOLI')JPATTT=0 IF(IPATTT.EQ.'SO')JPATTT=0 IF(IPATTT.EQ.'DOTT')JPATTT=1 IF(IPATTT.EQ.'DOT')JPATTT=1 IF(IPATTT.EQ.'DO')JPATTT=1 IF(IPATTT.EQ.'DASH')JPATTT=3 IF(IPATTT.EQ.'DA')JPATTT=3 IF(IPATTT.EQ.'DA1')JPATTT=2 IF(IPATTT.EQ.'DA2')JPATTT=2 IF(IPATTT.EQ.'DA3')JPATTT=2 IF(IPATTT.EQ.'DA4')JPATTT=2 IF(IPATTT.EQ.'DA5')JPATTT=2 CCCCC ADD FOLLOWING 5 LINES OCTOBER 1996 IF(IPATTT.EQ.'BLAN')JPATTT=-1 IF(IPATTT.EQ.'BL ')JPATTT=-1 IF(IPATTT.EQ.'NONE')JPATTT=-1 IF(IPATTT.EQ.'NO ')JPATTT=-1 IF(IPATTT.EQ.' ')JPATTT=-1 GOTO9000 C 10620 CONTINUE CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA) PXSPA2=PXSPA PYSPA2=PYSPA IF(IPATTT.EQ.'SOLI')PXSPA2=0.1 IF(IPATTT.EQ.'SOLI')PYSPA2=0.1 IF(IPATTT.EQ.'FILL')PXSPA2=0.1 IF(IPATTT.EQ.'FILL')PYSPA2=0.1 GOTO9000 C 10630 CONTINUE GOTO9000 C 10640 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 110-- ** C ** TREAT THE GKS DRIVER ** C ****************************************************** C 11000 CONTINUE IF(ICASE.EQ.'LINE')GOTO11010 IF(ICASE.EQ.'REGI')GOTO11020 IF(ICASE.EQ.'MARK')GOTO11030 IF(ICASE.EQ.'TEXT')GOTO11040 GOTO11010 C 11010 CONTINUE JPATTT=0 IF(IPATTT.EQ.'SOLI')JPATTT=1 IF(IPATTT.EQ.'SO')JPATTT=1 IF(IPATTT.EQ.'DOTT')JPATTT=3 IF(IPATTT.EQ.'DOT')JPATTT=3 IF(IPATTT.EQ.'DO')JPATTT=3 IF(IPATTT.EQ.'DASH')JPATTT=2 IF(IPATTT.EQ.'DA')JPATTT=2 IF(IPATTT.EQ.'DA1')JPATTT=2 IF(IPATTT.EQ.'DA2')JPATTT=4 IF(IPATTT.EQ.'DA3')JPATTT=5 IF(IPATTT.EQ.'DA4')JPATTT=6 IF(IPATTT.EQ.'DA5')JPATTT=7 CCCCC ADD FOLLOWING 5 LINES OCTOBER 1996 IF(IPATTT.EQ.'BLAN')JPATTT=-1 IF(IPATTT.EQ.'BL ')JPATTT=-1 IF(IPATTT.EQ.'NONE')JPATTT=-1 IF(IPATTT.EQ.'NO ')JPATTT=-1 IF(IPATTT.EQ.' ')JPATTT=-1 GOTO9000 C 11020 CONTINUE CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA) PXSPA2=PXSPA PYSPA2=PYSPA IF(IPATTT.EQ.'SOLI')PXSPA2=0.1 IF(IPATTT.EQ.'SOLI')PYSPA2=0.1 IF(IPATTT.EQ.'FILL')PXSPA2=0.1 IF(IPATTT.EQ.'FILL')PYSPA2=0.1 GOTO9000 C 11030 CONTINUE GOTO9000 C 11040 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 120-- ** C ** TREAT THE GD DRIVER ** C ** THIS LIBRARY PROVIDES SUPPORT FOR: ** C ** 1) JPEG ** C ** 2) PNG ** C ** 3) WINDOWS BMP (BLACK/WHITE ONLY) ** C ****************************************************** C 12000 CONTINUE IF(ICASE.EQ.'LINE')GOTO12010 IF(ICASE.EQ.'REGI')GOTO12020 IF(ICASE.EQ.'MARK')GOTO12030 IF(ICASE.EQ.'TEXT')GOTO12040 GOTO12010 C 12010 CONTINUE JPATTT=0 IF(IPATTT.EQ.'SOLI')JPATTT=1 IF(IPATTT.EQ.'SO')JPATTT=1 IF(IPATTT.EQ.'DOTT')JPATTT=3 IF(IPATTT.EQ.'DOT')JPATTT=3 IF(IPATTT.EQ.'DO')JPATTT=3 IF(IPATTT.EQ.'DASH')JPATTT=2 IF(IPATTT.EQ.'DA')JPATTT=2 IF(IPATTT.EQ.'DA1')JPATTT=2 IF(IPATTT.EQ.'DA2')JPATTT=4 IF(IPATTT.EQ.'DA3')JPATTT=5 IF(IPATTT.EQ.'DA4')JPATTT=6 IF(IPATTT.EQ.'DA5')JPATTT=7 IF(IPATTT.EQ.'BLAN')JPATTT=-1 IF(IPATTT.EQ.'BL ')JPATTT=-1 IF(IPATTT.EQ.'NONE')JPATTT=-1 IF(IPATTT.EQ.'NO ')JPATTT=-1 IF(IPATTT.EQ.' ')JPATTT=-1 GOTO9000 C 12020 CONTINUE CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA) PXSPA2=PXSPA PYSPA2=PYSPA IF(IPATTT.EQ.'SOLI')PXSPA2=0.1 IF(IPATTT.EQ.'SOLI')PYSPA2=0.1 IF(IPATTT.EQ.'FILL')PXSPA2=0.1 IF(IPATTT.EQ.'FILL')PYSPA2=0.1 GOTO9000 C 12030 CONTINUE GOTO9000 C 12040 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 130-- ** C ** TREAT THE MACINTOSH DRIVER ** C ** LIBRARY FROM ABSOFT COMPILER ** C ****************************************************** C 13000 CONTINUE IF(ICASE.EQ.'LINE')GOTO13010 IF(ICASE.EQ.'REGI')GOTO13020 IF(ICASE.EQ.'MARK')GOTO13030 IF(ICASE.EQ.'TEXT')GOTO13040 GOTO13010 C 13010 CONTINUE JPATTT=0 IF(IPATTT.EQ.'SOLI')JPATTT=1 IF(IPATTT.EQ.'SO')JPATTT=1 IF(IPATTT.EQ.'DOTT')JPATTT=3 IF(IPATTT.EQ.'DOT')JPATTT=3 IF(IPATTT.EQ.'DO')JPATTT=3 IF(IPATTT.EQ.'DASH')JPATTT=2 IF(IPATTT.EQ.'DA')JPATTT=2 IF(IPATTT.EQ.'DA1')JPATTT=2 IF(IPATTT.EQ.'DA2')JPATTT=4 IF(IPATTT.EQ.'DA3')JPATTT=5 IF(IPATTT.EQ.'DA4')JPATTT=6 IF(IPATTT.EQ.'DA5')JPATTT=7 IF(IPATTT.EQ.'BLAN')JPATTT=-1 IF(IPATTT.EQ.'BL ')JPATTT=-1 IF(IPATTT.EQ.'NONE')JPATTT=-1 IF(IPATTT.EQ.'NO ')JPATTT=-1 IF(IPATTT.EQ.' ')JPATTT=-1 GOTO9000 C 13020 CONTINUE CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA) PXSPA2=PXSPA PYSPA2=PYSPA IF(IPATTT.EQ.'SOLI')PXSPA2=0.1 IF(IPATTT.EQ.'SOLI')PYSPA2=0.1 IF(IPATTT.EQ.'FILL')PXSPA2=0.1 IF(IPATTT.EQ.'FILL')PYSPA2=0.1 GOTO9000 C 13030 CONTINUE GOTO9000 C 13040 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 140-- ** C ** TREAT THE PC PRINTER DRIVER ** C ****************************************************** C 14000 CONTINUE IF(ICASE.EQ.'LINE')GOTO14010 IF(ICASE.EQ.'REGI')GOTO14020 IF(ICASE.EQ.'MARK')GOTO14030 IF(ICASE.EQ.'TEXT')GOTO14040 GOTO14010 C 14010 CONTINUE JPATTT=0 IF(IPATTT.EQ.'SOLI')JPATTT=1 IF(IPATTT.EQ.'SO')JPATTT=1 IF(IPATTT.EQ.'DOTT')JPATTT=3 IF(IPATTT.EQ.'DOT')JPATTT=3 IF(IPATTT.EQ.'DO')JPATTT=3 IF(IPATTT.EQ.'DASH')JPATTT=2 IF(IPATTT.EQ.'DA')JPATTT=2 IF(IPATTT.EQ.'DA1')JPATTT=2 IF(IPATTT.EQ.'DA2')JPATTT=4 IF(IPATTT.EQ.'DA3')JPATTT=5 IF(IPATTT.EQ.'DA4')JPATTT=6 IF(IPATTT.EQ.'DA5')JPATTT=7 IF(IPATTT.EQ.'BLAN')JPATTT=-1 IF(IPATTT.EQ.'BL ')JPATTT=-1 IF(IPATTT.EQ.'NONE')JPATTT=-1 IF(IPATTT.EQ.'NO ')JPATTT=-1 IF(IPATTT.EQ.' ')JPATTT=-1 GOTO9000 C 14020 CONTINUE CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA) PXSPA2=PXSPA PYSPA2=PYSPA IF(IPATTT.EQ.'SOLI')PXSPA2=0.1 IF(IPATTT.EQ.'SOLI')PYSPA2=0.1 IF(IPATTT.EQ.'FILL')PXSPA2=0.1 IF(IPATTT.EQ.'FILL')PYSPA2=0.1 GOTO9000 C 14030 CONTINUE GOTO9000 C 14040 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 150-- ** C ** TREAT THE LATEX (USING EEPIC) DRIVER ** C ****************************************************** 15000 CONTINUE IF(ICASE.EQ.'LINE')GOTO15010 IF(ICASE.EQ.'REGI')GOTO15020 IF(ICASE.EQ.'MARK')GOTO15030 IF(ICASE.EQ.'TEXT')GOTO15040 GOTO15010 C 15010 CONTINUE JPATTT=0 IF(IPATTT.EQ.'SOLI')JPATTT=1 IF(IPATTT.EQ.'SO')JPATTT=1 IF(IPATTT.EQ.'DOTT')JPATTT=3 IF(IPATTT.EQ.'DOT')JPATTT=3 IF(IPATTT.EQ.'DO')JPATTT=3 IF(IPATTT.EQ.'DASH')JPATTT=2 IF(IPATTT.EQ.'DA')JPATTT=2 IF(IPATTT.EQ.'DA1')JPATTT=2 IF(IPATTT.EQ.'DA2')JPATTT=4 IF(IPATTT.EQ.'DA3')JPATTT=5 IF(IPATTT.EQ.'DA4')JPATTT=6 IF(IPATTT.EQ.'DA5')JPATTT=7 IF(IPATTT.EQ.'BLAN')JPATTT=-1 IF(IPATTT.EQ.'BL ')JPATTT=-1 IF(IPATTT.EQ.'NONE')JPATTT=-1 IF(IPATTT.EQ.'NO ')JPATTT=-1 IF(IPATTT.EQ.' ')JPATTT=-1 GOTO9000 C 15020 CONTINUE CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA) PXSPA2=PXSPA PYSPA2=PYSPA IF(IPATTT.EQ.'SOLI')PXSPA2=0.1 IF(IPATTT.EQ.'SOLI')PYSPA2=0.1 IF(IPATTT.EQ.'FILL')PXSPA2=0.1 IF(IPATTT.EQ.'FILL')PYSPA2=0.1 GOTO9000 C 15030 CONTINUE GOTO9000 C 15040 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 160-- ** C ** TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER ** C ****************************************************** C 16000 CONTINUE IF(ICASE.EQ.'LINE')GOTO16010 IF(ICASE.EQ.'REGI')GOTO16020 IF(ICASE.EQ.'MARK')GOTO16030 IF(ICASE.EQ.'TEXT')GOTO16040 GOTO16010 C 16010 CONTINUE JPATTT=0 IF(IPATTT.EQ.'SOLI')JPATTT=1 IF(IPATTT.EQ.'SO')JPATTT=1 IF(IPATTT.EQ.'DOTT')JPATTT=3 IF(IPATTT.EQ.'DOT')JPATTT=3 IF(IPATTT.EQ.'DO')JPATTT=3 IF(IPATTT.EQ.'DASH')JPATTT=2 IF(IPATTT.EQ.'DA')JPATTT=2 IF(IPATTT.EQ.'DA1')JPATTT=4 IF(IPATTT.EQ.'DA2')JPATTT=5 IF(IPATTT.EQ.'DA3')JPATTT=6 IF(IPATTT.EQ.'DA4')JPATTT=7 IF(IPATTT.EQ.'DA5')JPATTT=8 IF(IPATTT.EQ.'BLAN')JPATTT=-1 IF(IPATTT.EQ.'BL ')JPATTT=-1 IF(IPATTT.EQ.'NONE')JPATTT=-1 IF(IPATTT.EQ.'NO ')JPATTT=-1 IF(IPATTT.EQ.' ')JPATTT=-1 GOTO9000 C 16020 CONTINUE CALL GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA) PXSPA2=PXSPA PYSPA2=PYSPA IF(IPATTT.EQ.'SOLI')PXSPA2=0.1 IF(IPATTT.EQ.'SOLI')PYSPA2=0.1 IF(IPATTT.EQ.'FILL')PXSPA2=0.1 IF(IPATTT.EQ.'FILL')PYSPA2=0.1 GOTO9000 C 16030 CONTINUE GOTO9000 C 16040 CONTINUE GOTO9000 C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRPA')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF GRTRPA--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)ICASE 9012 FORMAT('ICASE = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)IPATTT,JPATTT 9013 FORMAT('IPATTT,JPATTT = ',A4,I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)PXSPA,PYSPA,PXSPA2,PYSPA2 9014 FORMAT('PXSPA,PYSPA,PXSPA2,PYSPA2 = ',4E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9015)IHORPA,IVERPA,IDUPPA,IDDOPA 9015 FORMAT('IHORPA,IVERPA,IDUPPA,IDDOPA = ',A4,2X,A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9018)IMANUF,IMODEL 9018 FORMAT('IMANUF,IMODEL = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9019)IBUGG4,ISUBG4,IERRG4 9019 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE GRTRSI(ICASE,IFONT,PHEIGH,PWIDTH,PVEGAP,PHOGAP, 1JSIZE, 1JHEIG2,JWIDT2,JVEGA2,JHOGA2, 1PHEIG2,PWIDT2,PVEGA2,PHOGA2) C C PURPOSE--FOR A LINE, REGION, MARKER, OR TEXT, C TRANSLATE A DESIRED SIZE (E.G., A CHARACTER SIZE) C (HEIGHT, WIDTH, C VERTICAL GAP, HORIZONTAL GAP9 C GIVEN IN (0.0 TO 100.0) REPRESENTATION C INTO AN INTEGER NUMERIC REPRESENTATION (IN JSIZE) C THAT WILL BE UNDERSTOOD BY THE TEKTRONIX C GRAPHICS DEVICE BEING USED. C ALSO, CREATE OTHER VARIABLES WHICH CONTAIN C THE CLOSEST ALLOWABLE SIZES C (IN 0.0 TO 100.0 UNITS) THAT IS PERMITTED ON C THE TEKTRONIX GRAPHICS DEVICE BEING USED. C C NOTE--PHEIGH IS IN RAW 0 TO 100 UNITS. C PHEIG2 IS ALSO IN 0 TO 100 UNITS BUT IS SCALED DOWN C TO REFLECT A SMALLER WINDOW (IF ONE EXISTS). C EXAMPLE--IF PHEIGH=3.0 C AND WINDOW IS FROM Y = 0 TO Y = 50, C THEN PHEIG2=1.5 C C NOTE--THE ONLY VARIABLES IN THE PLOT CONTROL COMMON C THAT ARE USED HEREIN ARE THE ONES IN /RWIND/ C C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PVONE--301-921-3651 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL BUREAU OF STANDARDS. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--83.6 C ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY 1983. C UPDATED --JANUARY 1989. SUN (BY BILL ANDERSON) C DRIVER OBSOLETE C UPDATED --JANUARY 1989. POSTSCRIPT (BY ALAN HECKERT) C UPDATED --JANUARY 1989. CGM (BY ALAN HECKERT) C UPDATED --JANUARY 1989. QMS QUIC (BY ALAN HECKERT) C UPDATED --JANUARY 1989. CALCOMP (BY ALAN HECKERT) C UPDATED --JANUARY 1989. ZETA (BY ALAN HECKERT) C UPDATED --MARCH 1990. X11 (BY ALAN HECKERT) C UPDATED --MARCH 1991. REGIS FIX (BY ALAN HECKERT) C UPDATED --MAY 1991. RENUMBER TOP BRANCHES (JJF) C UPDATED --MAY 1991. VGA/TURBOC DRIVER (JJF) C DRIVER OBSOLETE C UPDATED --JULY 1996. LAHEY DRIVER (ALAN HECKERT) C OLD, CALCOMP STYLE C DRIVER OBSOLETE C UPDATED --OCTOBER 1996. QUICKWIN DRIVER (ALAN) C UPDATED --OCTOBER 1996. OPENGL DRIVER (ALAN) C USE BILL MITCHELLS OPENGL C BINDING FOR FORTRAN C UPDATED --OCTOBER 1996. GKS (ALAN) C CODED, NOT TESTED C UPDATED --OCTOBER 1996. BINARY CGM (ALAN) C PLACEHOLDER FOR NOW C UPDATED --OCTOBER 1996. DISPLAY POSTSCRIPT (ALAN) C PLACEHOLDER FOR NOW C UPDATED --OCTOBER 1997. LAHEY INTERACTOR (ALAN) C UPDATED --JULY 1998. LAHEY WINTERACTOR C UPDATED --SEPTEMBER1998. MULTIPLOT SCALE FACTOR C UPDATED --AUGUST 1999. BUG FIX FOR MULTIPLOT SCALE C FACTOR C UPDATED --JUNE 2000. GD (FOR JPEG, PNG, WINDOWS BMP) C UPDATED --JUNE 2000. MACINTOSH C PLACEHOLDER FOR NOW C UPDATED --JUNE 2000. PC PRINTER C PLACEHOLDER FOR NOW C UPDATED --MARCH 2002. LATEX (USING EEPIC) C PLACEHOLDER FOR NOW C UPDATED --MARCH 2002. SVG (SCALABLE VECTOR GRAPHICS) C UPDATED --MARCH 2005. SUPPORT FOR AQUATERM C UPDATED --FEBRUARY 2006. IMPLEMENT LATEX DRIVER C C-----NON-COMMON VARIABLES (GRAPHICS)------------------------------------------- C CWINT USE WINTERACTER CINTE USE INTERACTER CHARACTER*4 ICASE CHARACTER*4 IFONT C C-----COMMON---------------------------------------------------------- C INCLUDE 'DPCOPA.INC' INCLUDE 'DPCOPC.INC' INCLUDE 'DPCOGR.INC' INCLUDE 'DPCOBE.INC' INCLUDE 'DPCODV.INC' INCLUDE 'DPCOST.INC' C C-----COMMON VARIABLES (GENERAL)-------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C IERRG4='NO' C PHEIPP=(-999.0) PWIDPP=(-999.0) PVEGPP=(-999.0) PHOGPP=(-999.0) C IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRSI')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF GRTRSI--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)ICASE,IFONT 52 FORMAT('ICASE,IFONT = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)PHEIGH,PWIDTH,PVEGAP,PHOGAP 53 FORMAT('PHEIGH,PWIDTH,PVEGAP,PHOGAP = ',4E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,57)IMANUF,IMODEL 57 FORMAT('IMANUF,IMODEL = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,59)IBUGG4 59 FORMAT('IBUGG4 = ',A4) CALL DPWRST('XXX','BUG ') 90 CONTINUE C CCCCC PHEIG2=PHEIGH CCCCC PWIDT2=PWIDTH CCCCC PVEGA2=PVEGAP CCCCC PHOGA2=PHOGAP CCCCC AUGMENT FOLLOWING LINES TO SUPPORT MULTIPLOT SCALE FACTOR AFACTH=1.0 AFACTW=1.0 IF(IMPSW2.EQ.'ON'.AND.IFONT.EQ.'TEKT')THEN AFACTH=AMPSCH AFACTW=AMPSCW ENDIF C CCCCC DON'T ADJUST PHEIGH, ETC., ADJUST PHEIG2, ETC. AUGUST 1999 CCCCC PHEIGH=PHEIGH*AFACTH CCCCC PVEGAP=PVEGAP*AFACTH CCCCC PWIDTH=PWIDTH*AFACTW CCCCC PHOGAP=PHOGAP*AFACTW C CCCCC PHEIG2=PHEIGH*(PWYMAX-PWYMIN)/100.0 CCCCC PVEGA2=PVEGAP*(PWYMAX-PWYMIN)/100.0 CCCCC PWIDT2=PWIDTH*(PWXMAX-PWXMIN)/100.0 CCCCC PHOGA2=PHOGAP*(PWXMAX-PWXMIN)/100.0 C PHEIG2=(AFACTH*PHEIGH)*(PWYMAX-PWYMIN)/100.0 PVEGA2=(AFACTH*PVEGAP)*(PWYMAX-PWYMIN)/100.0 PWIDT2=(AFACTW*PWIDTH)*(PWXMAX-PWXMIN)/100.0 PHOGA2=(AFACTW*PHOGAP)*(PWXMAX-PWXMIN)/100.0 C RATIVH=ANUMVP/ANUMHP RATIV1=ANUMVP/100.0 IF(IFONT.NE.'TEKT')GOTO9000 C C ******************************************** C ** STEP 1-- ** C ** BRANCH ACCORDING TO THE MANUFACTURER ** C ** AND THE MODEL ** C ******************************************** C IF(IMANUF.EQ.'TEKT')GOTO1005 IF(IMANUF.EQ.'HP')GOTO1010 IF(IMANUF.EQ.'PCL')GOTO1015 IF(IMANUF.EQ.'GENE')GOTO1020 IF(IMANUF.EQ.'CALC')GOTO1025 IF(IMANUF.EQ.'ZETA')GOTO1030 IF(IMANUF.EQ.'RAMT')GOTO1035 IF(IMANUF.EQ.'SUN ')GOTO1040 IF(IMANUF.EQ.'XXXX')GOTO1045 IF(IMANUF.EQ.'REGI')GOTO1050 IF(IMANUF.EQ.'POST')GOTO1055 IF(IMANUF.EQ.'QUIC')GOTO1060 IF(IMANUF.EQ.'X11 ')GOTO1065 IF(IMANUF.EQ.'TURB')GOTO1070 IF(IMANUF.EQ.'GKS ')GOTO1075 IF(IMANUF.EQ.'LAHE')GOTO1080 IF(IMANUF.EQ.'GD ')GOTO1085 IF(IMANUF.EQ.'QWIN')GOTO1090 IF(IMANUF.EQ.'AQUA')GOTO1091 IF(IMANUF.EQ.'OPGL')GOTO1095 IF(IMANUF.EQ.'PRIN')GOTO1096 IF(IMANUF.EQ.'LATE')GOTO1097 IF(IMANUF.EQ.'MACI')GOTO1098 IF(IMANUF.EQ.'SVG ')GOTO1099 GOTO9000 C 1005 CONTINUE IF(IMODEL.EQ.'4006')GOTO1100 IF(IMODEL.EQ.'4010')GOTO1100 IF(IMODEL.EQ.'4050')GOTO1100 IF(IMODEL.EQ.'4052')GOTO1100 C IF(IMODEL.EQ.'4012')GOTO1200 IF(IMODEL.EQ.'4013')GOTO1200 IF(IMODEL.EQ.'4014')GOTO1200 IF(IMODEL.EQ.'4016')GOTO1200 IF(IMODEL.EQ.'4054')GOTO1200 C IF(IMODEL.EQ.'4020')GOTO1300 IF(IMODEL.EQ.'4022')GOTO1300 IF(IMODEL.EQ.'4025')GOTO1300 IF(IMODEL.EQ.'4027')GOTO1300 C IF(IMODEL.EQ.'4105')GOTO1100 IF(IMODEL.EQ.'4107')GOTO1100 IF(IMODEL.EQ.'4109')GOTO1100 IF(IMODEL.EQ.'4115')GOTO1100 IF(IMODEL.EQ.'4107')GOTO1100 IF(IMODEL.EQ.'4109')GOTO1100 C IF(IMODEL.EQ.'4113')GOTO1200 IF(IMODEL.EQ.'4114')GOTO1200 C IF(IMODEL.EQ.'4662')GOTO1200 C GOTO1100 C 1010 CONTINUE IF(IMODEL.EQ.'7221')GOTO2100 IF(IMODEL.EQ.'2622')GOTO2300 IF(IMODEL.EQ.'2623')GOTO2300 IF(IMODEL.EQ.'2627')GOTO2300 IF(IMODEL.EQ.'2647')GOTO2300 GOTO2200 C 1015 CONTINUE GOTO2600 C 1020 CONTINUE IF(IMODEL.EQ.'CGM')GOTO3300 IF(IMODEL.EQ.'CGMB')GOTO3400 GOTO3100 C 1025 CONTINUE GOTO4100 C 1030 CONTINUE GOTO5100 C 1035 CONTINUE GOTO6100 C 1040 CONTINUE GOTO6600 C 1045 CONTINUE GOTO7100 C 1050 CONTINUE GOTO8100 C 1055 CONTINUE IF(IMODEL.EQ.'DISP')GOTO8900 GOTO8600 C 1060 CONTINUE GOTO9100 C 1065 CONTINUE GOTO9600 C 1070 CONTINUE GOTO10000 C 1075 CONTINUE GOTO11000 C 1080 CONTINUE IF(IMODEL.EQ.'INTE')GOTO4900 IF(IMODEL.EQ.'WINT')GOTO4950 GOTO4600 C 1085 CONTINUE IF(IMODEL.EQ.'JPEG')GOTO12000 IF(IMODEL.EQ.'PNG ')GOTO12000 IF(IMODEL.EQ.'WBMP')GOTO12000 IF(IMODEL.EQ.'GIF')GOTO12000 GOTO12000 C 1090 CONTINUE GOTO4700 C 1091 CONTINUE GOTO13500 C 1095 CONTINUE GOTO4800 C 1096 CONTINUE GOTO14000 C 1097 CONTINUE GOTO15000 C 1098 CONTINUE GOTO13000 C 1099 CONTINUE GOTO16000 C C ******************************************************* C ** STEP 11-- ** C ** TREAT THE TEKTRONIX 4006, 4010, 4050, AND 4052 ** C ** (THESE ARE ALL NON-COLOR (= MONOCHROME) DEVICES ** C ** WHICH ARE SMALL SCREEN AND SO HAVE ONLY ** C ** 1 CHARCTER SIZE). ** C ** REFERENCE--IGL MANUAL, PAGE 6-22 ** C ******************************************************* C 1100 CONTINUE JSIZE=1 PWIDPP=1.410*RATIV1 PHOGPP=0.385*RATIV1 PHEIPP=1.795*RATIV1 PVEGPP=1.026*RATIV1 JWIDT2=PWIDPP+0.5 JHOGA2=PHOGPP+0.5 JHEIG2=PHEIPP+0.5 JVEGA2=PVEGPP+0.5 PWIDT2=1.410*RATIVH PHOGA2=0.385*RATIVH PHEIG2=1.795 PVEGA2=1.026 GOTO9000 C C **************************************************************** C ** STEP 12-- C ** TREAT THE TEKTRONIX 4012, 4013, 4014, 4016, 4054, AND 4114 C ** (THESE ARE ALL NON-COLOR (= MONOCHROME) DEVICES C ** WHICH ARE LARGE SCREEN AND SO HAVE C ** 4 CHARCTER SIZES.) C ** REFERENCE--IGL MANUAL, PAGE 6-22 C **************************************************************** C 1200 CONTINUE CCCCC IF(PHEIGH.LT.1.75)GOTO1211 CCCCC IF(1.75.LT.PHEIGH.AND.PHEIGH.LE.2.25)GOTO1212 CCCCC IF(2.25.LT.PHEIGH.AND.PHEIGH.LE.2.75)GOTO1213 IF(PHEIG2.LT.0.75)GOTO1211 IF(0.75.LT.PHEIG2.AND.PHEIG2.LE.1.25)GOTO1212 IF(1.25.LT.PHEIG2.AND.PHEIG2.LE.1.75)GOTO1213 GOTO1214 C 1211 CONTINUE JSIZE=1 PWIDPP=0.776*RATIV1 PHOGPP=0.212*RATIV1 PHEIPP=0.987*RATIV1 PVEGPP=0.564*RATIV1 JWIDT2=PWIDPP+0.5 JHOGA2=PHOGPP+0.5 JHEIG2=PHEIPP+0.5 JVEGA2=PVEGPP+0.5 PWIDT2=0.776*RATIVH PHOGA2=0.212*RATIVH PHEIG2=0.987 PVEGA2=0.564 GOTO9000 C 1212 CONTINUE JSIZE=2 PWIDPP=0.856*RATIV1 PHOGPP=0.233*RATIV1 PHEIPP=1.089*RATIV1 PVEGPP=0.623*RATIV1 JWIDT2=PWIDPP+0.5 JHOGA2=PHOGPP+0.5 JHEIG2=PHEIPP+0.5 JVEGA2=PVEGPP+0.5 PWIDT2=0.856*RATIVH PHOGA2=0.233*RATIVH PHEIG2=1.089 PVEGA2=0.623 GOTO9000 C 1213 CONTINUE JSIZE=3 PWIDPP=1.283*RATIV1 PHOGPP=0.350*RATIV1 PHEIPP=1.633*RATIV1 PVEGPP=0.933*RATIV1 JWIDT2=PWIDPP+0.5 JHOGA2=PHOGPP+0.5 JHEIG2=PHEIPP+0.5 JVEGA2=PVEGPP+0.5 PWIDT2=1.283*RATIVH PHOGA2=0.350*RATIVH PHEIG2=1.633 PVEGA2=0.933 GOTO9000 C 1214 CONTINUE JSIZE=4 PWIDPP=1.410*RATIV1 PHOGPP=0.385*RATIV1 PHEIPP=1.795*RATIV1 PVEGPP=1.026*RATIV1 JWIDT2=PWIDPP+0.5 JHOGA2=PHOGPP+0.5 JHEIG2=PHEIPP+0.5 JVEGA2=PVEGPP+0.5 PWIDT2=1.410*RATIVH PHOGA2=0.385*RATIVH PHEIG2=1.795 PVEGA2=1.026 GOTO9000 C C ************************************************************** C ** STEP 13-- ** C ** TREAT THE TEKTRONIX 402X CASES ** C ** REFERENCE--IGL MANUAL, PAGE 6-22 C ************************************************************** C 1300 CONTINUE JSIZE=1 PWIDPP=1.667*RATIV1 PHOGPP=0.238*RATIV1 PHEIPP=2.143*RATIV1 PVEGPP=1.190*RATIV1 JWIDT2=PWIDPP+0.5 JHOGA2=PHOGPP+0.5 JHEIG2=PHEIPP+0.5 JVEGA2=PVEGPP+0.5 PWIDT2=1.667*RATIVH PHOGA2=0.238*RATIVH PHEIG2=2.143 PVEGA2=1.190 GOTO9000 C C ****************************************************** C ** STEP 21-- ** C ** TREAT THE HEWLETT-PACKARD 7221 CASE ** C ** (MULTI-COLOR PENPLOTTER) ** C ** REFERENCE--HP 7221A GRAPHICS PLOTTER ** C ** OPERATING AND PROGRAMMING MANUAL, ** C ** PAGE XX. ** C ****************************************************** C 2100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 22-- ** C ** TREAT THE HEWLETT-PACKARD HP-GL CASES ** C ** (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS) ** C ** (MULTI-COLOR PENPLOTTERS) ** C ****************************************************** C 2200 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 23-- ** C ** TREAT THE HEWLETT-PACKARD 2622 CASES ** C ****************************************************** C 2300 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 26-- ** C ** TREAT THE HEWLETT-PACKARD PCL CASES ** C ** HP LASERJET PRINTERS ** C ** SIZE DETERMINED BY THE FONT BEING USED ** C ** PCL FONTS USE POINT SIZE. (POINT=1/72IN) ** C ** CURRENTLY, ONLY THE 3 INTERNAL FONTS ARE ** C ** SUPPORTED. NOTE THAT THESE ARE ALL FIXED SPACE ** C ** FONTS. C ****************************************************** C 2600 CONTINUE PPI=PCLPPI JSIZE=2 IF(IPCLFN.EQ.'CMED')JSIZE=2 IF(IPCLFN.EQ.'CBOL')JSIZE=2 IF(IPCLFN.EQ.'COND')JSIZE=1 IF(JSIZE.EQ.2)GOTO2610 C APOINT=8.5 ACPI=16.66 GOTO2619 2610 CONTINUE APOINT=12. ACPI=10. GOTO2619 C 2619 CONTINUE PHEIPP=(APOINT/72.)*PPI PVEGPP=0. PWIDPP=PPI/ACPI PHOGPP=0. JHEIGH2=PHEIPP+0.5 JVEGA2=0 JWIDT2=PWIDPP+0.5 JHOGA2=0 PHEIG2=PHEIPP*100./ANUMVP PVEGA2=0. PWIDT2=PWIDPP*100./ANUMHP PHOGA2=0. GOTO9000 C C ****************************************************** C ** STEP 31-- ** C ** TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE ** C ****************************************************** C 3100 CONTINUE GOTO9000 C C ******************************************************* C ** STEP 33-- ** C ** TREAT THE CGM CASE ** C ******************************************************* C 3300 CONTINUE GOTO9000 C C *************************************************** C ** STEP 34-- ** C ** TREAT THE CGM (BINARY) CASE ** C *************************************************** C 3400 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 41-- ** C ** TREAT THE CALCOMP XXXXXX CASE ** C ** (NOT DONE) ** C ** REFERENCE--XX ** C ** XX ** C ** PAGES XX AND XX ** C ** THE DEFAULT WIDTH OF A CALCOMP CHARACTER IS THE ** C ** SAME AS THE HEIGHT (BUT WIDTH = CHARACTER PLUS ** C ** SPACING WHILE HEIGHT = CHARACTER ONLY). THERE IS* C ** "SETCHR" CALL FOR SOME CALCOMP PLOTTERS THAT ** C ** ALLOWS THE ASPECT RATIO TO BE SET, BUT NOT ** C ** IMPLEMENTED HERE SINCE NOT SUPPORTED BY ALL ** C ** CALCOMP PLOTTERS (PARTICULARLY EMULATION PACKAGES* C ****************************************************** C 4100 CONTINUE PWIDPP=RATIV1*PWIDT2 PWIDT2=PHEIG2*RATIVH PHOGPP=0. PHEIPP=RATIV1*PHEIG2 PVEGPP=0.0 JWIDT2=PWIDPP+0.5 JHOGA2=PHOGPP+0.5 JHEIG2=PHEIPP+0.5 JVEGA2=PVEGPP+0.5 PHOGA2=0.0 PVEGA2=0.0 GOTO9000 C C ****************************************************** C ** STEP 46-- ** C ** TREAT THE LAHEY XXXXXX CASE ** C ** REFERENCE--Programmer's Reference, Revision C ** C ** Lahey Computer Systems, January, 1992** C ** PAGES 51 THRU 65 ** C ****************************************************** C 4600 CONTINUE PWIDPP=RATIV1*PWIDT2 PWIDT2=PHEIG2*RATIVH PHOGPP=0. PHEIPP=RATIV1*PHEIG2 PVEGPP=0.0 JWIDT2=PWIDPP+0.5 JHOGA2=PHOGPP+0.5 JHEIG2=PHEIPP+0.5 JVEGA2=PVEGPP+0.5 PHOGA2=0.0 PVEGA2=0.0 GOTO9000 C C ****************************************************** C ** STEP 47-- ** C ** TREAT THE MICROSOFT QUICKWIN DRIVER ** C ** FOR WINDOWS 95 AND WINDOWS NT. ** C ****************************************************** C 4700 CONTINUE PHEIPP=ANUMVP*PHEIG2/100. PVEGPP=ANUMVP*PVEGA2/100. PWIDPP=PHEIPP*0.6 PHOGPP=PVEGPP*0.6 JHEIG2=PHEIPP+0.5 JVEGA2=PVEGPP+0.5 JWIDT2=PWIDPP+0.5 JHOGA2=PHOGPP+0.5 PHEIG2=REAL(JHEIG2)*100./ANUMVP PVEGA2=REAL(JVEGA2)*100./ANUMVP PWIDT2=REAL(JWIDT2)*100./ANUMVP PHOGA2=REAL(JHOGA2)*100./ANUMVP GOTO9000 C C ****************************************************** C ** STEP 48-- ** C ** TREAT THE OPEN-GL DRIVER ** C ** FOR WINDOWS 95 AND WINDOWS NT AND X11 ** C ****************************************************** C 4800 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 49-- ** C ** TREAT THE LAHEY INTERACTOR CASE ** C ****************************************************** C 4900 CONTINUE PWIDPP=0.0 PHOGPP=0.0 PHEIPP=0.0 PVEGPP=0.0 JWIDT2=0 JHOGA2=0 JHEIG2=0 JVEGA2=0 PHEIG2=(25.0/100.0)*PHEIG2 PWIDT2=(75.0/100.0)*PWIDT2 PHOGA2=0.0 PVEGA2=0.0 GOTO9000 C C ****************************************************** C ** STEP 49B- ** C ** TREAT THE LAHEY WINTERACTOR CASE ** C ****************************************************** C 4950 CONTINUE PWIDPP=0.0 PHOGPP=0.0 PHEIPP=0.0 PVEGPP=0.0 JWIDT2=0 JHOGA2=0 JHEIG2=0 JVEGA2=0 GOTO9000 C C C ****************************************************** C ** STEP 51-- ** C ** TREAT THE ZETA 3600SX AND 3653SX CASES ** C ** REFERENCE--USER MANUAL FOR DIGITAL PLOTTER ** C ** MODELS 3600SX AND 3653SX ** C ** PAGES B-0 AND B-1 ** C ** NOTE: ZETA LIBRARY HAS ASPECT RATIO TO CONTROL ** C ** WIDTH/HEIGHT RATIO. THE WIDTH ** C ** INCLUDES BOTH THE CHARACTER WIDTH AND** C ** THE INTERCHARACTER SPACING WHILE THE ** C ** HEIGHT ONLY INCLUDES THE CHARACTER. ** C ** ALSO, BASE THE WIDTH ON THE VERTICAL ** C ** AXIS (FOR CONSISTENCY) AND THEN ** C ** RECALCULATE PWIDT2 (BASED ON ** C ** HORIZONTAL SIZE) ** C ****************************************************** C 5100 CONTINUE PTEMP=PWIDT2+PHOGA2 PRATIO=PTEMP/PHEIG2 CCCCC CALL ASPECT(PRATIO) PWIDPP=PTEMP*RATIV1 PHOGPP=0. PHEIPP=RATIV1*PHEIG2 PVEGPP=0.0 JWIDT2=PWIDPP+0.5 JHOGA2=PHOGPP+0.5 JHEIG2=PHEIPP+0.5 JVEGA2=PVEGPP+0.5 PWIDT2=PTEMP*RATIVH PHOGA2=0. PVEGA2=0. GOTO9000 C C ****************************************************** C ** STEP 61-- ** C ** TREAT THE RAMTEK XXXXXX CASE ** C ** (NOT DONE) ** C ** REFERENCE--XX ** C ** XX ** C ** PAGES XX AND XX ** C ****************************************************** C 6100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 66-- ** C ** TREAT THE SUN CASE ** C ****************************************************** C 6600 CONTINUE PWIDPP=0.50*RATIV1*PHEIG2 PHOGPP=0.214*RATIV1*PHEIG2 PHEIPP=1.000*RATIV1*PHEIG2 PVEGPP=0.750*RATIV1*PHEIG2 JWIDT2=PWIDPP+0.5 JHOGA2=PHOGPP+0.5 JHEIG2=PHEIPP+0.5 JVEGA2=PVEGPP+0.5 PWIDT2=0.50*RATIVH*PHEIG2 PHOGA2=0.214*RATIVH*PHEIG2 PVEGA2=0.750*PHEIG2 GOTO9000 C C ****************************************************** C ** STEP 71-- ** C ** TREAT THE XXXXXX XXXXXX CASE ** C ** (NOT DONE) ** C ** REFERENCE--XX ** C ** XX ** C ** PAGES XX AND XX ** C ****************************************************** C 7100 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 81-- ** C ** TREAT THE REGIS CASE ** C ****************************************************** C C MARCH, 1991. HANDLE VARIOUS CHARACTER SIZES CORRECTLY. C C THE SIZE OF THE DEFAULT FONT IN TURBO-C IS 8 BY 8 C PIXELS. THIS STANDARD SIZE MAY BE SCALED UP BY C FACTORS OF 1, 2, ..., UP TO 10. THE DISPLAY CELL C SIZE IS THE SIZE OF THE CHARACTER CELL (CHARACTER C + MARGIN), WHILE THE UNIT CELL SIZE IS THE SIZE OF C THE CHARACTER ONLY. THE DIFFERENCE BETWEEN THEM C DEFINES THE HORIZONTAL GAP. NOTE THAT THE C VERTICAL GAP IS BUILT INTO THE CHARACTER ITSELF C (I.E., PVEGA2=0.). THE FOLLOWING TABLE GIVES THE C AVAILABLE CHARACTER SIZES: C SET NUMBER CELL SIZE CHARACTER SIZE C (JSIZE) WIDTH BY HEIGHT WIDTH BY HEIGHT C 0 GET FROM ALAN C 1 [ 9, 20] [ 8, 20] C 2 [ 18, 30] [ 16, 30] C 3 [ 27, 45] [ 24, 45] C 4 [ 36, 60] [ 32, 60] C 5 [ 45, 75] [ 40, 75] C 6 [ 54, 90] [ 48, 90] C 7 [ 63,105] [ 56,105] C 8 [ 72,120] [ 64,120] C 9 [ 81,135] [ 72,135] C 10 [ 90,150] [ 90,150] C 11 [ 99,165] [ 88,165] C 12 [108,180] [ 96,180] C 13 [117,195] [104,195] C 14 [126,210] [112,210] C 15 [135,225] [120,225] C 16 [144,240] [128,240] C C RATIV1*PHEIG2 IS THE HEIGHT (IN PIXELS C REQUESTED). THIS SIZE WILL BE ROUNDED TO THE C CLOSEST PIXEL HEIGHT IN THE ABOVE TABLE. C 8100 CONTINUE ATEMP=PHEIG2*RATIV1 IF(ATEMP.LE.15.0)THEN JSIZE=0 PWIDPP=8.0 PHOGPP=1.0 PHEIPP=10.0 PVEGPP=0.0 ELSE IF(ATEMP.LE.25.0)THEN JSIZE=1 PWIDPP=8.0 PHOGPP=1.0 PHEIPP=20.0 PVEGPP=0.0 ELSE IF(ATEMP.LE.37.5)THEN JSIZE=2 PWIDPP=16.0 PHOGPP=2.0 PHEIPP=30.0 PVEGPP=0.0 ELSE IF(ATEMP.LE.52.5)THEN JSIZE=3 PWIDPP=24.0 PHOGPP=3.0 PHEIPP=45.0 PVEGPP=0.0 ELSE IF(ATEMP.LE.67.5)THEN JSIZE=4 PWIDPP=32.0 PHOGPP=4.0 PHEIPP=60.0 PVEGPP=0.0 ELSE IF(ATEMP.LE.82.5)THEN JSIZE=5 PWIDPP=40.0 PHOGPP=5.0 PHEIPP=75.0 PVEGPP=0.0 ELSE IF(ATEMP.LE.97.5)THEN JSIZE=6 PWIDPP=48.0 PHOGPP=6.0 PHEIPP=90.0 PVEGPP=0.0 ELSE IF(ATEMP.LE.112.5)THEN JSIZE=7 PWIDPP=56.0 PHOGPP=7.0 PHEIPP=105.0 PVEGPP=0.0 ELSE IF(ATEMP.LE.127.5)THEN JSIZE=8 PWIDPP=64.0 PHOGPP=8.0 PHEIPP=120.0 PVEGPP=0.0 ELSE IF(ATEMP.LE.142.5)THEN JSIZE=9 PWIDPP=72.0 PHOGPP=9.0 PHEIPP=135.0 PVEGPP=0.0 ELSE IF(ATEMP.LE.157.5)THEN JSIZE=10 PWIDPP=80.0 PHOGPP=10.0 PHEIPP=150.0 PVEGPP=0.0 ELSE IF(ATEMP.LE.172.5)THEN JSIZE=11 PWIDPP=88.0 PHOGPP=11.0 PHEIPP=165.0 PVEGPP=0.0 ELSE IF(ATEMP.LE.187.5)THEN JSIZE=12 PWIDPP=96.0 PHOGPP=12.0 PHEIPP=180.0 PVEGPP=0.0 ELSE IF(ATEMP.LE.202.5)THEN JSIZE=13 PWIDPP=104.0 PHOGPP=13.0 PHEIPP=195.0 PVEGPP=0.0 ELSE IF(ATEMP.LE.217.5)THEN JSIZE=14 PWIDPP=112.0 PHOGPP=14.0 PHEIPP=210.0 PVEGPP=0.0 ELSE IF(ATEMP.LE.232.5)THEN JSIZE=15 PWIDPP=120.0 PHOGPP=15.0 PHEIPP=225.0 PVEGPP=0.0 ELSE JSIZE=16 PWIDPP=128.0 PHOGPP=16.0 PHEIPP=240.0 PVEGPP=0.0 END IF JWIDT2=PWIDPP+0.5 JHOGA2=PHOGPP+0.5 JHEIG2=PHEIPP+0.5 JVEGA2=PVEGPP+0.5 PWIDT2=(PWIDPP/ANUMHP)*100.0 PHOGA2=(PHOGPP/ANUMHP)*100.0 PHEIG2=(PHEIPP/ANUMVP)*100.0 PVEGA2=0.0 GOTO9000 C C ****************************************************** C ** STEP 86-- ** C ** TREAT THE POSTSCRIPT CASES ** C ** SIZE IS IN POSTSCRIPT UNITS (1/72 = 1 POINT BY ** C ** DEFAULT). DATAPLOT SCALES UNITS BY POINTS PER ** C ** INCH, SO 1 UNIT IS (1/POINTS PER INCH) = 1 PIXEL** C ** FOR DATAPLOT. ** C ** NOTE THAT POSTSCRIPT FONTS ARE PROPORTIONALLY ** C ** SPACED, SO USE 0.6 OF HEIGHT AS DUMMY VALUE. ** C ****************************************************** C 8600 CONTINUE PPI=PSTPPI PHEIPP=ANUMVP*PHEIG2/100. PVEGPP=ANUMVP*PVEGA2/100. PWIDPP=PHEIPP*0.6 PHOGPP=PVEGPP*0.6 JHEIG2=PHEIPP+0.5 JVEGA2=PVEGPP+0.5 JWIDT2=PWIDPP+0.5 JHOGA2=PHOGPP+0.5 PHEIG2=REAL(JHEIG2)*100./ANUMVP PVEGA2=REAL(JVEGA2)*100./ANUMVP PWIDT2=REAL(JWIDT2)*100./ANUMVP PHOGA2=REAL(JHOGA2)*100./ANUMVP GOTO9000 C C ****************************************************** C ** STEP 89-- ** C ** TREAT THE DISPLAY POSTSCRIPT DRIVER ** C ****************************************************** C 8900 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 91-- ** C ** TREAT THE QUIC CASES ** C ** QMS AND TALARIS LASER PRINTERS ** C ** SIZE DETERMINED BY THE FONT BEING USED ** C ** QUIC FONTS USE POINT SIZE. (POINT=1/72IN) ** C ** 10 - EDP FONT, 8 POINT, 14 CPI (21 DOT/CHAR) ** C ** LANDSCAPE, PORTRAIT ** C ** 104 - STANDARD ROMAN MEDIUM, 10 POINT, PROPORT.** C ** LANDSCAPE, PORTRAIT ** C ** 124 - STANDARD ROMAN BOLD, 10 POINT, PROPORT. ** C ** PORTRAIT ** C ** 144 - STANDARD ROMAN ITALIC, 10 POINT, PROPORT.** C ** PORTRAIT ** C ** 16 - SIMPLEX ROMAN, 5 POINT PROPORTIONAL ** C ** PORTRAIT ** C ** 204 - APOLLO MEDIUM, 10 POINT, PROPORTIONAL ** C ** LANDSCAPE, PORTRAIT ** C ** 328 - COMPLEX ROMAN BOLD, PROPORTIONAL 15 POINT** C ** PORTRAIT ** C ** 404 - Q-TYPEWRITER, 10 POINT, (30 DOT/CHAR) ** C ** PORTRAIT ** C ** 444 - Q-TYPEWRITER ITALIC, 30 DOTS WIDE ** C ** PORTRAIT ** C ** NOTE: THE ABOVE ARE "HARDWARE" FONTS. THE ** C ** FOLLOWING ARE "DOWNLOADABLE" FONTS THAT ** C ** MAY NOT BE AVAILABLE ON A GIVEN MACHINE ** C ** ** C ** 521 - TEKTRONIX SMALL, 12 CPI (25 DOT/CHAR) 8.0 POINT C ** LANDSCAPE ** C ** 522 - TEKTRONIX MEDIU, 10 CPI (30 DOT/CHAR)10.3 POINT C ** LANDSCAPE ** C ** 523 - TEKTRONIX BIG, 7.9 CPI (38 DOT/CHAR)12.3 POINT C ** LANDSCAPE ** C ** 524 - TEKTRONIX XBIG, 7.3 CPI (41 DOT/CHAR)13.7 POINT C ** LANDSCAPE ** C ** 532 - UNION 10 POINT, 12 CPI (25 DOTS/CHAR) ** C ** PORTRAIT ** C ** 517 - Q-GREEK 10 POINT, 10 CPI (30 DOTS/CHAR) ** C ** LANDSCAPE, PORTRAIT ** C ** 536 - Q-GREEK 10 POINT, 12 CPI (25 DOTS/CHAR) ** C ** LANDSCAPE, PORTRAIT ** C ** 904 - Q-GOTHIC 10 POINT, 12 CPI (25 DOTS/CHAR) ** C ** LANDSCAPE, PORTRAIT ** C ** 924 - Q-GOTHIC ITALIC, 10 POINT, 12 CPI (25 DOTS) C ** LANDSCAPE, PORTRAIT ** C ** IF THE REQUESTED FONT IS NOT AVAILABLE IN THE ** C ** GIVEN ORIENTATION (LANDSCAPE OR PORTRAIT), THE ** C ** EDP FONT WILL BE USED (BUT VALUE OF IQUIFN NOT ** C ** MODIFIED). ** C ** THE CPI GIVEN FOR THE PROPORTIONAL FONTSIS JUST ** C ** A GUIDE, TABLES ARE USED TO FIND LENGTH OF STRING* C ** REFERENCE--QUIC PROGRAMMERS MANUAL, ** C ** APPENDIX B ** C ****************************************************** C 9100 CONTINUE PPI=QUIPPI IFONTT=IQUIFN IF(IORNSW.EQ.'PORT'.AND.( 1IFONTT.EQ.521.OR. 1IFONTT.EQ.522.OR. 1IFONTT.EQ.523.OR. 1IFONTT.EQ.524))IFONTT=10 IF(IORNSW.NE.'PORT'.AND.( 1IFONTT.EQ.124.OR. 1IFONTT.EQ.144.OR. 1IFONTT.EQ.16.OR. 1IFONTT.EQ.328.OR. 1IFONTT.EQ.998.OR. 1IFONTT.EQ.404.OR. 1IFONTT.EQ.444.OR. 1IFONTT.EQ.532))IFONTT=10 IF(IFONTT.EQ.16) THEN APOINT=5.0 AWIDTH=21. ELSE IF(IFONTT.EQ.10) THEN APOINT=8. AWIDTH=21. ELSE IF(IFONTT.EQ.104)THEN APOINT=10. AWIDTH=21. ELSE IF(IFONTT.EQ.124)THEN APOINT=10. AWIDTH=21. ELSE IF(IFONTT.EQ.144)THEN APOINT=10. AWIDTH=21. ELSE IF(IFONTT.EQ.204)THEN APOINT=10. AWIDTH=21. ELSE IF(IFONTT.EQ.404)THEN APOINT=10. AWIDTH=30. ELSE IF(IFONTT.EQ.444)THEN APOINT=10. AWIDTH=30. ELSE IF(IFONTT.EQ.328)THEN APOINT=15. AWIDTH=21. ELSE IF(IFONTT.EQ.998)THEN APOINT=15. AWIDTH=21. ELSE IF(IFONTT.EQ.521)THEN APOINT=8. AWIDTH=25. ELSE IF(IFONTT.EQ.522)THEN APOINT=10.3 AWIDTH=30. ELSE IF(IFONTT.EQ.523)THEN APOINT=12.3 AWIDTH=38. ELSE IF(IFONTT.EQ.524)THEN APOINT=13.7 AWIDTH=41. ELSE IF(IFONTT.EQ.532)THEN APOINT=10. AWIDTH=25. ELSE IF(IFONTT.EQ.517)THEN APOINT=10. AWIDTH=30. ELSE IF(IFONTT.EQ.536)THEN APOINT=10. AWIDTH=25. ELSE IF(IFONTT.EQ.664)THEN APOINT=10. AWIDTH=25. ELSE IF(IFONTT.EQ.904)THEN APOINT=10. AWIDTH=25. ELSE IF(IFONTT.EQ.924)THEN APOINT=10. AWIDTH=25. ELSE APOINT=8. AWIDTH=21. IFONTT=10 END IF PHEIPP=(APOINT/72.)*PPI PVEGPP=0. PWIDPP=AWIDTH PHOGPP=0. JHEIG2=PHEIPP+0.5 JVEGA2=0 JWIDT2=PWIDPP+0.5 JHOGA2=0 PHEIG2=PHEIPP*100./ANUMVP PVEGA2=0. PWIDT2=PWIDPP*100./ANUMHP PHOGA2=0. GOTO9000 C C ****************************************************** C ** STEP 96-- ** C ** TREAT THE X11 CASE ** C ** THE UNDERLYING C LIBRARY WILL HANDLE CHARACTER ** C ** SIZE, JUSTIFICATION, AND POSITIONING VIA XLIB ** C ** CALLS. THEREFORE, THIS IS A NULL ROUTINE. ** C ****************************************************** C 9600 CONTINUE GOTO9000 C CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1991 (JJF) C ************************************************* C ** STEP 100-- ** C ** TREAT THE VGA VIA TURBO-C CASE ** C ** REFERENCE--TURBO C 1.5 ADDITIONS & ** C ** ENHANCEMENTS, PAGE 93. ** C ** REFERENCE--TURBO C 2.0 REFERENCE GUIDE, ** C ** PAGE 327. ** C ** REFERENCE--WEISKAMP, POWER GRAPHICS C ** USING TURBO C, PAGE 52. ** C ************************************************* C C THE CELL SIZE OF THE DEFAULT FONT IN TURBO-C IS 8 BY 8 C PIXELS. THIS STANDARD SIZE MAY BE SCALED UP BY C FACTORS OF 1, 2, ..., UP TO 10. THE CELL SIZE IS C THE SIZE OF THE CHARACTER + MARGIN. THE CHARACTER C SIZE IS THE SIZE OF THE CHARACTER ONLY. NOTE THAT C THE VERTICAL GAP AND HORIZONTAL GAP IS BUILT INTO ????? C THE CHARACTER ONLY (I.E., PVEGA2 = PHOGA2 = 0). C THE FOLLOWING TABLE GIVES THE AVAILABLE CHARACTER C SIZES: C SET NUMBER CELL SIZE CHARACTER SIZE C (JSIZE) HEIGHT BY WIDTH HEIGHT BY WIDTH C 1 8,8 7,7 C 2 16,16 14,14 C 3 24,24 21,21 C 4 32,32 28,28 C 5 40,40 35,35 C 6 48,48 42,42 C 7 56,56 49,49 C 8 64,64 56,56 C 9 72,72 63,63 C 10 80,80 70,70 C C RATIV1*PHEIG2 IS THE HEIGHT (IN PIXELS C REQUESTED). THIS SIZE WILL BE ROUNDED TO THE C CLOSEST PIXEL HEIGHT IN THE ABOVE TABLE. C 10000 CONTINUE ATEMP=PHEIG2*RATIV1 IF(ATEMP.LE.12.0)THEN JSIZE=1 PWIDPP=8.0 PHOGPP=0.0 PHEIPP=8.0 PVEGPP=0.0 ELSE IF(ATEMP.LE.20.0)THEN JSIZE=2 PWIDPP=16.0 PHOGPP=0.0 PHEIPP=16.0 PVEGPP=0.0 ELSE IF(ATEMP.LE.28.0)THEN JSIZE=3 PWIDPP=24.0 PHOGPP=0.0 PHEIPP=24.0 PVEGPP=0.0 ELSE IF(ATEMP.LE.36.0)THEN JSIZE=4 PWIDPP=32.0 PHOGPP=0.0 PHEIPP=32.0 PVEGPP=0.0 ELSE IF(ATEMP.LE.44.0)THEN JSIZE=5 PWIDPP=40.0 PHOGPP=0.0 PHEIPP=40.0 PVEGPP=0.0 ELSE IF(ATEMP.LE.52.0)THEN JSIZE=6 PWIDPP=48.0 PHOGPP=0.0 PHEIPP=48.0 PVEGPP=0.0 ELSE IF(ATEMP.LE.60.0)THEN JSIZE=7 PWIDPP=56.0 PHOGPP=0.0 PHEIPP=56.0 PVEGPP=0.0 ELSE IF(ATEMP.LE.68.0)THEN JSIZE=8 PWIDPP=64.0 PHOGPP=0.0 PHEIPP=64.0 PVEGPP=0.0 ELSE IF(ATEMP.LE.76.0)THEN JSIZE=9 PWIDPP=72.0 PHOGPP=0.0 PHEIPP=72.0 PVEGPP=0.0 ELSE JSIZE=10 PWIDPP=80.0 PHOGPP=0.0 PHEIPP=80.0 PVEGPP=0.0 END IF JWIDT2=PWIDPP+0.5 JHOGA2=PHOGPP+0.5 JHEIG2=PHEIPP+0.5 JVEGA2=PVEGPP+0.5 PWIDT2=(PWIDPP/ANUMHP)*100.0 PHOGA2=0.0 PHEIG2=(PHEIPP/ANUMVP)*100.0 PVEGA2=0.0 GOTO9000 C C ****************************************************** C ** STEP 110-- ** C ** TREAT THE GKS DRIVER ** C ****************************************************** C 11000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 120-- ** C ** TREAT THE GD DRIVER ** C ** THIS LIBRARY PROVIDES SUPPORT FOR: ** C ** 1) JPEG ** C ** 2) PNG ** C ** 3) WINDOWS BMP (BLACK/WHITE ONLY) ** C ****************************************************** C 12000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 130-- ** C ** TREAT THE MACINTOSH DRIVER ** C ** LIBRARY FROM ABSOFT COMPILER ** C ****************************************************** C 13000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 135-- ** C ** TREAT THE MAC OSX AQUATERM DRIVER ** C ****************************************************** C 13500 CONTINUE PHEIPP=ANUMVP*PHEIG2/100. PVEGPP=ANUMVP*PVEGA2/100. PWIDPP=PHEIPP*0.6 PHOGPP=PVEGPP*0.6 JHEIG2=PHEIPP+0.5 JVEGA2=PVEGPP+0.5 JWIDT2=PWIDPP+0.5 JHOGA2=PHOGPP+0.5 PHEIG2=REAL(JHEIG2) PVEGA2=REAL(JVEGA2) PWIDT2=REAL(JWIDT2) PHOGA2=REAL(JHOGA2) GOTO9000 C C ****************************************************** C ** STEP 140-- ** C ** TREAT THE PC PRINTER DRIVER ** C ****************************************************** C 14000 CONTINUE GOTO9000 C C C ****************************************************** C ** STEP 150-- ** C ** TREAT THE LATEX (USING EEPIC) DRIVER ** C ****************************************************** C C LATEX SUPPORTS 10 SIZES. NOTE THAT THE SPECIFIC SIZE USED WILL C DEPEND ON THE FONT SELECTED AND THE DEFAULT DOCUMENT POINT SIZE. C THE FOLLOWING POINT SIZES ARE BASED ON THE DEFAULT CMR FONT AND C A DEFAULT DOCUMENT SIZE OF 12PT. C C WE ARE USING A 300DPI COORDINATE SCALE AND THERE ARE 72 POINTS PER INCH. C THIS IMPLIES 4.16 PIXELS PER POINT (APPROXIMATELY). C C 1. \tiny = 6 POINT = 25 PIXELS C 2. \scriptsize = 8 POINT = 33 PIXELS C 3. \footnotesize = 10 POINT = 42 PIXELS C 4. \small = 10 POINT = 42 PIXELS C 5. \normalsize = 12 POINT = 50 PIXELS C 6. \large = 12 POINT = 50 PIXELS C 7. \Large = 17 POINT = 71 PIXELS C 8. \LARGE = 17 POINT = 71 PIXELS C 9. \huge = 17 POINT = 71 PIXELS C 10. \Huge = 17 POINT = 71 PIXELS C C 15000 CONTINUE PHEIPP=ANUMVP*PHEIG2/100. IF(PHEIPP.LE.29.0)THEN JSIZE=1 APNT=6.0 ELSEIF(PHEIPP.LE.37.0)THEN JSIZE=2 APNT=8.0 ELSEIF(PHEIPP.LE.42.0)THEN JSIZE=3 APNT=10.0 ELSEIF(PHEIPP.LE.46.0)THEN JSIZE=4 APNT=10.0 ELSEIF(PHEIPP.LE.58.0)THEN JSIZE=5 APNT=12.0 ELSEIF(PHEIPP.LE.70.0)THEN JSIZE=6 APNT=12.0 ELSEIF(PHEIPP.LE.75.0)THEN JSIZE=7 APNT=17.0 ELSEIF(PHEIPP.LE.80.0)THEN JSIZE=8 APNT=17.0 ELSEIF(PHEIPP.LE.85.0)THEN JSIZE=9 APNT=17.0 ELSE JSIZE=10 APNT=17.0 ENDIF PHEIPP=APNT*4.16 PVEGPP=0.0 PWIDPP=PHEIPP*0.6 PHOGPP=0.0 JHEIG2=PHEIPP+0.5 JVEGA2=PVEGPP+0.5 JWIDT2=PWIDPP+0.5 JHOGA2=PHOGPP+0.5 PWIDT2=(PWIDPP/ANUMHP)*100.0 PHOGA2=0.0 PHEIG2=0.75*(PHEIPP/ANUMVP)*100.0 PVEGA2=0.25*(PHEIPP/ANUMVP)*100.0 GOTO9000 C C ****************************************************** C ** STEP 160-- ** C ** TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER ** C ****************************************************** C 16000 CONTINUE PWIDPP=RATIV1*PWIDT2 PWIDT2=PHEIG2*RATIVH PHOGPP=0. PHEIPP=RATIV1*PHEIG2 PVEGPP=0.0 JWIDT2=PWIDPP+0.5 JHOGA2=PHOGPP+0.5 JHEIG2=PHEIPP+0.5 JVEGA2=PVEGPP+0.5 PHOGA2=0.0 PVEGA2=0.0 GOTO9000 C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRSI')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF GRTRSI--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)ICASE,IFONT 9012 FORMAT('ICASE,IFONT = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)PHEIGH,PWIDTH,PVEGAP,PHOGAP 9013 FORMAT('PHEIGH,PWIDTH,PVEGAP,PHOGAP = ',4E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)JSIZE 9014 FORMAT('JSIZE = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9015)JHEIG2,JWIDT2,JVEGA2,JHOGA2 9015 FORMAT('JHEIG2,JWIDT2,JVEGA2,JHOGA2 = ',4I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9016)PHEIG2,PWIDT2,PVEGA2,PHOGA2 9016 FORMAT('PHEIG2,PWIDT2,PVEGA2,PHOGA2 = ',4E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9017)PHEIPP,PWIDPP,PVEGPP,PHOGPP 9017 FORMAT('PHEIPP,PWIDPP,PVEGPP,PHOGPP = ',4E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9018)IMANUF,IMODEL 9018 FORMAT('IMANUF,IMODEL = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9019)IBUGG4 9019 FORMAT('IBUGG4 = ',A4) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE GRTRTH(ICASE,PTHICK,JTHICK,PTHIC2) C C PURPOSE--FOR A LINE, REGION, MARKER, OR TEXT, C TRANSLATE A DESIRED LINE THICKNESS (IN PTHICK) C GIVEN IN (0.0 TO 100.0) REPRESENTATION C INTO AN INTEGER NUMERIC REPRESENTATION (IN JTHICK) C THAT WILL BE UNDERSTOOD BY THE SPECIFIC C GRAPHICS DEVICE BEING USED. C ALSO, CREATE A SECOND VARIABLE (PTHIC2) WHICH CONTAINS C THE CLOSEST ALLOWABLE LINE THICKNESS VALUE C (IN 0.0 TO 100.0 UNITS) THAT IS PERMITTED ON C THE TEKTRONIX GRAPHICS DEVICE BEING USED. C C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-3651 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL BUREAU OF STANDARDS. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--83.6 C ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY 1983. C UPDATED --JANUARY 1989. SUN (BY BILL ANDERSON) C DRIVER OBSOLETE C UPDATED --JANUARY 1989. POSTSCRIPT (BY ALAN HECKERT) C UPDATED --JANUARY 1989. CGM (BY ALAN HECKERT) C UPDATED --JANUARY 1989. QMS QUIC (BY ALAN HECKERT) C UPDATED --JANUARY 1989. CALCOMP (BY ALAN HECKERT) C UPDATED --JANUARY 1989. ZETA (BY ALAN HECKERT) C UPDATED --MARCH 1990. X11 (BY ALAN HECKERT) C UPDATED --MAY 1991. RENUMBER TOP BRANCHES (JJF) C UPDATED --MAY 1991. VGA/TURBOC DRIVER (JJF) C DRIVER OBSOLETE C UPDATED --JULY 1996. LAHEY DRIVER (ALAN HECKERT) C OLD, CALCOMP STYLE C DRIVER OBSOLETE C UPDATED --OCTOBER 1996. QUICKWIN DRIVER (ALAN) C UPDATED --OCTOBER 1996. OPENGL DRIVER (ALAN) C USE BILL MITCHELLS OPENGL C BINDING FOR FORTRAN C UPDATED --OCTOBER 1996. GKS (ALAN) C CODED, NOT TESTED C UPDATED --OCTOBER 1996. BINARY CGM (ALAN) C PLACEHOLDER FOR NOW C UPDATED --OCTOBER 1996. DISPLAY POSTSCRIPT (ALAN) C PLACEHOLDER FOR NOW C UPDATED --OCTOBER 1997. LAHEY INTERACTOR (ALAN) C UPDATED --JULY 1998. LAHEY WINTERACTOR C UPDATED --JUNE 2000. GD (FOR JPEG, PNG, WINDOWS BMP) C UPDATED --JUNE 2000. MACINTOSH C PLACEHOLDER FOR NOW C UPDATED --JUNE 2000. PC PRINTER C PLACEHOLDER FOR NOW C UPDATED --MARCH 2002. LATEX (USING EEPIC) C PLACEHOLDER FOR NOW C UPDATED --MARCH 2002. SVG (SCALABLE VECTOR GRAPHICS) C UPDATED --MARCH 2005. SUPPORT FOR AQUATERM C UPDATED --FEBRUARY 2006. IMPLEMENT LATEX C C-----NON-COMMON VARIABLES (GRAPHICS)------------------------------------------- C CWINT USE WINTERACTER CINTE USE INTERACTER CHARACTER*4 ICASE C C-----COMMON---------------------------------------------------------- C INCLUDE 'DPCOGR.INC' INCLUDE 'DPCOBE.INC' INCLUDE 'DPCOST.INC' INCLUDE 'DPCODV.INC' C C-----COMMON VARIABLES (GENERAL)-------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C C-----START POINT----------------------------------------------------- C IERRG4='NO' C IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRTH')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF GRTRTH--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,52)ICASE 52 FORMAT('ICASE = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)PTHICK 53 FORMAT('PTHICK = ',E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,54)IMANUF,IMODEL 54 FORMAT('IMANUF,IMODEL = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,59)IBUGG4 59 FORMAT('IBUGG4 = ',A4) CALL DPWRST('XXX','BUG ') 90 CONTINUE C C ************************************************ C ** STEP 0-- ** C ** DEFINE THICKNESS ** C ** FOR A GENERAL GRAPHICS DEVICE ** C ** THICKNESS WILL BE SET IN ** C ** HARDWARE IF THE DEVICE SUPPORTS ** C ** THIS CAPABILITY. OTHERWISE THE ** C ** FOLLOWING ALGORITHIM IS USED. ** C ** 1) DRAW A LINE WITH THE REQUESETED COORD.** C ** 2) PDELTA=(PTHICK/PDEVTH)/2. ** C ** 3) AINC = PDELTA/PDEVTH ** C ** 4) NINC = AINC+0.9 ** C ** 5) JTHICK=NINC ** C ** PTHIC2=PDELTA/REAL(NINC) ** C ** WHERE ** C ** PTHICK IS THE USER REQUESTED THICKNESS** C ** PDEVTH IS ONE LINE THICKNESS FOR A ** C ** SPECIFIC DEVICE. ** C ** "DPDRPL" WILL DRAW THE MIDDLE LINE. ** C ** IT THEN SPLITS THE REMAINING THICKNESS** C ** INTO AN "ABOVE" AND "BELOW" PART. ** C ** NINC IS THE NUMBER OF ADDITIONAL LINES** C ** REQUIRED (BOTH ABOVE AND BELOW THE ** C ** INITIAL LINE). THE DISTANCE IS THEN ** C ** DIVIDED BY NINC TO GET THE "DELTA" ** C ** USED BY "DPDRPL", I.E., THE AMOUNT ** C ** ADDED TO THE COORDINATES TO DRAW THE ** C ** NEXT LINE. THE 0.9 IS "FUDGE FACTOR".** C ** FOR EXAMPLE, ON A TEKTRONIX WITH A ** C ** LINE THICKNESS OF 0.1, A USER REQUESTED* C ** THICKNESS OF 0.12 IS REQUIRED BEFORE ** C ** ADDITIONAL LINES WILL BE DRAWN. ** C ************************************************ C C ******************************************** C ** STEP 1-- ** C ** BRANCH ACCORDING TO THE MANUFACTURER ** C ** AND THE MODEL ** C ******************************************** C IF(IMANUF.EQ.'TEKT')GOTO1005 IF(IMANUF.EQ.'HP')GOTO1010 IF(IMANUF.EQ.'PCL')GOTO1015 IF(IMANUF.EQ.'GENE')GOTO1020 IF(IMANUF.EQ.'CALC')GOTO1025 IF(IMANUF.EQ.'ZETA')GOTO1030 IF(IMANUF.EQ.'RAMT')GOTO1035 IF(IMANUF.EQ.'SUN ')GOTO1040 IF(IMANUF.EQ.'XXXX')GOTO1045 IF(IMANUF.EQ.'REGI')GOTO1050 IF(IMANUF.EQ.'POST')GOTO1055 IF(IMANUF.EQ.'QUIC')GOTO1060 IF(IMANUF.EQ.'X11 ')GOTO1065 IF(IMANUF.EQ.'TURB')GOTO1070 IF(IMANUF.EQ.'GKS ')GOTO1075 IF(IMANUF.EQ.'LAHE')GOTO1080 IF(IMANUF.EQ.'GD ')GOTO1085 IF(IMANUF.EQ.'QWIN')GOTO1090 IF(IMANUF.EQ.'AQUA')GOTO1091 IF(IMANUF.EQ.'OPGL')GOTO1095 IF(IMANUF.EQ.'PRIN')GOTO1096 IF(IMANUF.EQ.'LATE')GOTO1097 IF(IMANUF.EQ.'MACI')GOTO1098 IF(IMANUF.EQ.'SVG ')GOTO1099 GOTO9000 C 1005 CONTINUE GOTO1100 C 1010 CONTINUE IF(IMODEL.EQ.'7221')GOTO2100 GOTO2200 C 1015 CONTINUE GOTO2600 C 1020 CONTINUE GOTO3100 C 1025 CONTINUE GOTO4100 C 1030 CONTINUE GOTO5100 C 1035 CONTINUE GOTO6100 C 1040 CONTINUE GOTO6600 C 1045 CONTINUE GOTO7100 C 1050 CONTINUE GOTO8100 C 1055 CONTINUE IF(IMODEL.EQ.'DISP')GOTO8900 GOTO8600 C 1060 CONTINUE GOTO9100 C 1065 CONTINUE GOTO9600 C 1070 CONTINUE GOTO10000 C 1075 CONTINUE GOTO11000 C 1080 CONTINUE IF(IMODEL.EQ.'INTE')GOTO4900 GOTO4600 C 1085 CONTINUE IF(IMODEL.EQ.'JPEG')GOTO12000 IF(IMODEL.EQ.'PNG ')GOTO12000 IF(IMODEL.EQ.'WBMP')GOTO12000 IF(IMODEL.EQ.'GIF')GOTO12000 GOTO12000 C 1090 CONTINUE GOTO4700 C 1091 CONTINUE GOTO13500 C 1095 CONTINUE GOTO4800 C 1096 CONTINUE GOTO14000 C 1097 CONTINUE GOTO15000 C 1098 CONTINUE GOTO13000 C 1099 CONTINUE GOTO16000 C C ****************************************************** C ** STEP 11-- ** C ** TREAT THE TEKTRONIX CASE ** C ****************************************************** C 1100 CONTINUE C PPENTH=PTEKTH PDELTA=(PTHICK-PPENTH)/2. IF(PDELTA.GT.0.0.AND.PPENTH.GT.0.0)GOTO1110 JTHICK=0 PTHIC2=PTHICK GOTO1190 1110 CONTINUE AINC=PDELTA/PPENTH NINC=AINC+0.9 JTHICK=NINC PTHIC2=PTHICK IF(NINC.GE.1)PTHIC2=PDELTA/REAL(NINC) 1190 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 21-- ** C ** TREAT THE HEWLETT-PACKARD 7221 CASE ** C ** (MULTI-COLOR PENPLOTTER) ** C ** REFERENCE--HP 7221A GRAPHICS PLOTTER ** C ** OPERATING AND PROGRAMMING MANUAL, ** C ** PAGE XX. ** C ****************************************************** C 2100 CONTINUE C PPENTH=P722TH PDELTA=(PTHICK-PPENTH)/2. IF(PDELTA.GT.0.0.AND.PPENTH.GT.0.0)GOTO1110 JTHICK=0 PTHIC2=PTHICK GOTO2190 2110 CONTINUE AINC=PDELTA/PPENTH NINC=AINC+0.9 JTHICK=NINC PTHIC2=PTHICK IF(NINC.GE.1)PTHIC2=PDELTA/REAL(NINC) 2190 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 22-- ** C ** TREAT THE HEWLETT-PACKARD HP-GL CASES ** C ** (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS) ** C ** (MULTI-COLOR PENPLOTTERS) ** C ** REFERENCE--HP 9872C GRAPHICS PLOTTER ** C ** OPERATING AND PROGRAMMING MANUAL, ** C ** PAGE XX, XXX. ** C ****************************************************** C 2200 CONTINUE C PPENTH=PHPGTH PDELTA=(PTHICK-PPENTH)/2. IF(PDELTA.GT.0.0.AND.PPENTH.GT.0.0)GOTO1110 JTHICK=0 PTHIC2=PTHICK GOTO2290 2210 CONTINUE AINC=PDELTA/PPENTH NINC=AINC+0.9 JTHICK=NINC PTHIC2=PTHICK IF(NINC.GE.1)PTHIC2=PDELTA/REAL(NINC) 2290 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 23-- ** C ** TREAT THE HEWLETT-PACKARD 2622 CASES ** C ****************************************************** C 2300 CONTINUE C PPENTH=P262TH PDELTA=(PTHICK-PPENTH)/2. IF(PDELTA.GT.0.0.AND.PPENTH.GT.0.0)GOTO2310 JTHICK=0 PTHIC2=PTHICK GOTO2390 2310 CONTINUE AINC=PDELTA/PPENTH NINC=AINC+0.9 JTHICK=NINC PTHIC2=PTHICK IF(NINC.GE.1)PTHIC2=PDELTA/REAL(NINC) 2390 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 11-- ** C ** TREAT THE PCL CASE ** C ****************************************************** C 2600 CONTINUE C C PTHIC2 WILL BE THE NUMBER OF "PIXELS" WIDE TO DRAW THE LINE C SHOULD BE ODD INTEGER C JTHICK=0 ATEMP=PTHICK*ANUMVP/100. ITEMP=ATEMP+0.5 IF(MOD(ITEMP,2).EQ.0)ITEMP=ITEMP+1 IF(ITEMP.LT.1)ITEMP=1 IF(ITEMP.GT.50)ITEMP=50 PTHIC2=REAL(ITEMP) GOTO9000 C C ****************************************************** C ** STEP 31-- ** C ** TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE ** C ** 2 CASES: LET THE POST-PROCESSOR DO THE LINE ** C ** THICKNESS (IPTHSW='OFF') OR HAVE ** C ** DATAPLOT DO BY DRAWING MULTIPLE LINES ** C ** IF DATAPLOT DOES IT, THE LINE THICKNESS** C ** IS TAKEN FROM (PPENSW). ** C ****************************************************** C 3100 CONTINUE IF(IPTHSW.EQ.'ON')GOTO3120 PTHIC2=PTHICK JTHICK=0 GOTO3190 C 3120 CONTINUE PPENTH=PPENSW PDELTA=(PTHICK-PPENTH)/2. IF(PDELTA.GT.0.0.AND.PPENTH.GT.0.0)GOTO3160 JTHICK=0 PTHIC2=PTHICK GOTO3190 3160 CONTINUE AINC=PDELTA/PPENTH NINC=AINC+0.9 JTHICK=NINC PTHIC2=PTHICK IF(NINC.GE.1)PTHIC2=PDELTA/REAL(NINC) C 3190 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 41-- ** C ** TREAT THE CALCOMP XXXXXX CASE ** C ** (NOT DONE) ** C ** REFERENCE--XX ** C ** XX ** C ** PAGES XX AND XX ** C ****************************************************** C 4100 CONTINUE PPENTH=PCALTH PDELTA=(PTHICK-PPENTH)/2. IF(PDELTA.GT.0.0.AND.PPENTH.GT.0.0)GOTO4110 JTHICK=0 PTHIC2=PTHICK GOTO4190 4110 CONTINUE AINC=PDELTA/PPENTH NINC=AINC+0.9 JTHICK=NINC PTHIC2=PTHICK IF(NINC.GE.1)PTHIC2=PDELTA/REAL(NINC) 4190 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 46-- ** C ** TREAT THE LAHEY XXXXXX CASE ** C ** REFERENCE--Programmer's Reference, Revision C ** C ** Lahey Computer Systems, January, 1992** C ** PAGES 51 THRU 65 ** C ****************************************************** C 4600 CONTINUE PPENTH=PLAHTH PDELTA=(PTHICK-PPENTH)/2. IF(PDELTA.GT.0.0.AND.PPENTH.GT.0.0)GOTO4610 JTHICK=0 PTHIC2=PTHICK GOTO4690 4610 CONTINUE AINC=PDELTA/PPENTH NINC=AINC+0.9 JTHICK=NINC PTHIC2=PTHICK IF(NINC.GE.1)PTHIC2=PDELTA/REAL(NINC) 4690 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 47-- ** C ** TREAT THE MICROSOFT QUICKWIN DRIVER ** C ** FOR WINDOWS 95 AND WINDOWS NT. ** C ****************************************************** C 4700 CONTINUE PPENTH=100.*(1./ANUMVP) PDELTA=(PTHICK-PPENTH)/2. IF(PDELTA.GT.0.0.AND.PPENTH.GT.0.0)GOTO4710 JTHICK=0 PTHIC2=PTHICK GOTO4790 4710 CONTINUE AINC=PDELTA/PPENTH NINC=AINC+0.9 JTHICK=NINC PTHIC2=PTHICK IF(NINC.GE.1)PTHIC2=PPENTH*REAL(NINC) 4790 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 48-- ** C ** TREAT THE OPEN-GL DRIVER ** C ** FOR WINDOWS 95 AND WINDOWS NT AND X11 ** C ****************************************************** C 4800 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 49-- ** C ** TREAT THE LAHEY INTERACTOR CASE ** C ****************************************************** C 4900 CONTINUE PPENTH=100.*(1./ANUMVP) PDELTA=(PTHICK-PPENTH)/2. IF(PDELTA.GT.0.0.AND.PPENTH.GT.0.0)GOTO4910 JTHICK=0 PTHIC2=PTHICK GOTO4940 4910 CONTINUE AINC=PDELTA/PPENTH NINC=AINC+0.9 JTHICK=NINC PTHIC2=PTHICK IF(NINC.GE.1)PTHIC2=PPENTH*REAL(NINC) 4940 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 49B- ** C ** TREAT THE LAHEY WINTERACTOR CASE ** C ****************************************************** C 4950 CONTINUE PPENTH=100.*(1./ANUMVP) PDELTA=(PTHICK-PPENTH)/2. IF(PDELTA.GT.0.0.AND.PPENTH.GT.0.0)GOTO4960 JTHICK=0 PTHIC2=PTHICK GOTO4990 4960 CONTINUE AINC=PDELTA/PPENTH NINC=AINC+0.9 JTHICK=NINC PTHIC2=PTHICK IF(NINC.GE.1)PTHIC2=PPENTH*REAL(NINC) 4990 CONTINUE GOTO9000 C C C ****************************************************** C ** STEP 51-- ** C ** TREAT THE ZETA 3600SX AND 3653SX CASES ** C ** REFERENCE--USER MANUAL FOR DIGITAL PLOTTER ** C ** MODELS 3600SX AND 3653SX ** C ** PAGES B-0 AND B-1 ** C ****************************************************** C 5100 CONTINUE PPENTH=PZETTH PDELTA=(PTHICK-PPENTH)/2. IF(PDELTA.GT.0.0.AND.PPENTH.GT.0.0)GOTO5110 JTHICK=0 PTHIC2=PTHICK GOTO5190 5110 CONTINUE AINC=PDELTA/PPENTH NINC=AINC+0.9 JTHICK=NINC PTHIC2=PTHICK IF(NINC.GE.1)PTHIC2=PDELTA/REAL(NINC) 5190 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 61-- ** C ** TREAT THE RAMTEK XXXXXX CASE ** C ** (NOT DONE) ** C ** REFERENCE--XX ** C ** XX ** C ** PAGES XX AND XX ** C ****************************************************** C 6100 CONTINUE PPENTH=0.1 PDELTA=(PTHICK-PPENTH)/2. IF(PDELTA.GT.0.0.AND.PPENTH.GT.0.0)GOTO1110 JTHICK=0 PTHIC2=PTHICK GOTO6190 6110 CONTINUE AINC=PDELTA/PPENTH NINC=AINC+0.9 JTHICK=NINC PTHIC2=PTHICK IF(NINC.GE.1)PTHIC2=PDELTA/REAL(NINC) 6190 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 66-- ** C ** TREAT THE SUN CASE ** C ****************************************************** C 6600 CONTINUE C PPENTH=PSUNTH PDELTA=(PTHICK-PPENTH)/2. IF(PDELTA.GT.0.0.AND.PPENTH.GT.0.0)GOTO6610 JTHICK=0 PTHIC2=PTHICK GOTO6690 6610 CONTINUE AINC=PDELTA/PPENTH NINC=AINC+0.9 JTHICK=NINC PTHIC2=PTHICK IF(NINC.GE.1)PTHIC2=PDELTA/REAL(NINC) 6690 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 71-- ** C ** TREAT THE XXXXXX XXXXXX CASE ** C ** (NOT DONE) ** C ** REFERENCE--XX ** C ** XX ** C ** PAGES XX AND XX ** C ****************************************************** C 7100 CONTINUE PPENTH=0.1 PDELTA=(PTHICK-PPENTH)/2. IF(PDELTA.GT.0.0.AND.PPENTH.GT.0.0)GOTO7110 JTHICK=0 PTHIC2=PTHICK GOTO7190 7110 CONTINUE AINC=PDELTA/PPENTH NINC=AINC+0.9 JTHICK=NINC PTHIC2=PTHICK IF(NINC.GE.1)PTHIC2=PDELTA/REAL(NINC) 7190 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 81-- ** C ** TREAT THE REGIS CASE ** C ****************************************************** C 8100 CONTINUE C PPENTH=PREGTH PDELTA=(PTHICK-PPENTH)/2. IF(PDELTA.GT.0.0.AND.PPENTH.GT.0.0)GOTO8110 JTHICK=0 PTHIC2=PTHICK GOTO8190 8110 CONTINUE AINC=PDELTA/PPENTH NINC=AINC+0.9 JTHICK=NINC PTHIC2=PTHICK IF(NINC.GE.1)PTHIC2=PDELTA/REAL(NINC) 8190 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 86-- ** C ** TREAT THE POSTSCRIPT CASE ** C ****************************************************** C 8600 CONTINUE C C THE POSTSCRIPT PROTOCOL LETS THE HARDWARE LINE THICKNESS BE SET C IN USER COORDINATES. BASE THE THICKNESS ON THE VERTICAL SIZE. C TYPICALLY, 8.5*300. UNLIKE THE QUIC PROTOCOL, POSTSCRIPT SUPPORTS C RESOLUTIONS OTHER THAN 300 DPI, SO DO NOT "HARD CODE" AS IN THE C QUIC CASE. C PTHIC2 WILL BE SET TO THE NUMBER OF PIXELS WIDE THE LINE WILL BE. C (PTHICK/100.)=(PIXELS/(ANUMVP)) IMPLIES PIXELS=PTHICK*ANUMVP/100. C ATEMP=PTHICK*ANUMVP/100. ITEMP=ATEMP+0.5 IF(ITEMP.LT.1)ITEMP=1 IF(ITEMP.GT.50)ITEMP=50 PTHIC2=REAL(ITEMP) JTHICK=0 GOTO9000 C C ****************************************************** C ** STEP 89-- ** C ** TREAT THE DISPLAY POSTSCRIPT DRIVER ** C ****************************************************** C 8900 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 91-- ** C ** TREAT THE QUIC CASE ** C ****************************************************** C 9100 CONTINUE C C THE QUIC PROTOCOL LETS THE HARDWARE LINE THICKNESS BE SET FROM C 1 TO 31 PIXELS WIDE. BASE THE THICKNESS ON 8.5 INCHES HEIGHT C (X300=2,550 PIXELS). THIS WAY, LINE THICKNESS WILL NOT DEPEND C ON WHETHER LANDSCAPE OR PORTRAIT MODE IN EFFECT. C JTHICK IS THE NUMBER OF LOOPS TO DRAW THICKER LINES, SO SET TO 0. C PTHIC2 WILL BE SET TO THE NUMBER OF PIXELS WIDE THE LINE WILL BE. C (PTHICK/100.)=(PIXELS/(8.5*300)) IMPLIES PIXELS=PTHICK*(8.5*300)/100. C =PTHICK*25.5 C NOTE: PIXELS GO IN ODD INCREMENTS ONLY, I.E., 1,3,5,7, .. ,31. C ATEMP=PTHICK*25.5 ITEMP=ATEMP+0.5 IF(ITEMP.LT.1)ITEMP=1 IF(ITEMP.GT.31)ITEMP=31 PTHIC2=REAL(ITEMP) IJUNK=MOD(INT(PTHIC2),2) IF(IJUNK.EQ.0)PTHIC2=PTHIC2+1. JTHICK=0 GOTO9000 C C ****************************************************** C ** STEP 96-- ** C ** TREAT THE X11 CASE ** C ** BASE THICKNESS ON "1000" POINTS SO THAT NUMBER ** C ** OF PIXELS FOR LINE WIDTH DOES NOT DEPEND ON THE ** C ** PARTICULAR WINDOW OR THE PARTICULAR WORKSTATION ** C ** PTHIC2 IS THE NUMBER OF PIXELS WIDE TO MAKE THE ** C ** LINE. ** C ****************************************************** C 9600 CONTINUE ATEMP=PTHICK*(1000.)/100. ITEMP=ATEMP+0.5 IF(ITEMP.LT.1)ITEMP=1 IF(ITEMP.GT.15)ITEMP=15 PTHIC2=REAL(ITEMP) IJUNK=MOD(ITEMP,2) IF(IJUNK.EQ.0)PTHIC2=PTHIC2+1. JTHICK=0 GOTO9000 C CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1991 (JJF) C ************************************************* C ** STEP 100-- ** C ** TREAT THE VGA VIA TURBO-C CASE ** C ** REFERENCE--TURBO C 1.5 ADDITIONS & ** C ** ENHANCEMENTS, PAGE 83. ** C ** REFERENCE--TURBO C 2.0 REFERENCE GUIDE, ** C ** PAGE 321. ** C ************************************************* C 10000 CONTINUE C ATEMP=PTHICK*ANUMVP/100. ITEMP=ATEMP+0.5 IF(ITEMP.LT.1)ITEMP=1 IF(ITEMP.GT.3)ITEMP=3 PTHIC2=REAL(ITEMP) IJUNK=MOD(ITEMP,2) IF(IJUNK.EQ.0)PTHIC2=PTHIC2+1. JTHICK=0 GOTO9000 C C ****************************************************** C ** STEP 110-- ** C ** TREAT THE GKS DRIVER ** C ****************************************************** C 11000 CONTINUE CCCCC PPENTH=PTEKTH PPENTH=0.1 PDELTA=(PTHICK-PPENTH)/2. IF(PDELTA.GT.0.0.AND.PPENTH.GT.0.0)GOTO11010 JTHICK=0 PTHIC2=PTHICK GOTO1190 11010 CONTINUE AINC=PDELTA/PPENTH NINC=AINC+0.9 JTHICK=NINC PTHIC2=PTHICK IF(NINC.GE.1)PTHIC2=PDELTA/REAL(NINC) 11090 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 120-- ** C ** TREAT THE GD DRIVER ** C ** THIS LIBRARY PROVIDES SUPPORT FOR: ** C ** 1) JPEG ** C ** 2) PNG ** C ** 3) WINDOWS BMP (BLACK/WHITE ONLY) ** C ** BASE THICKNESS ON "1000" POINTS SO THAT NUMBER ** C ** OF PIXELS FOR LINE WIDTH DOES NOT DEPEND ON THE ** C ** PARTICULAR WINDOW OR THE PARTICULAR WORKSTATION ** C ** PTHIC2 IS THE NUMBER OF PIXELS WIDE TO MAKE THE ** C ** LINE. ** C ****************************************************** C 12000 CONTINUE PPENTH=100.*(1./ANUMVP) PDELTA=(PTHICK-PPENTH)/2. IF(PDELTA.GT.0.0.AND.PPENTH.GT.0.0)GOTO12960 JTHICK=0 PTHIC2=PTHICK GOTO12990 12960 CONTINUE AINC=PDELTA/PPENTH NINC=AINC+0.9 JTHICK=NINC PTHIC2=PTHICK IF(NINC.GE.1)PTHIC2=PPENTH*REAL(NINC) 12990 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 130-- ** C ** TREAT THE MACINTOSH DRIVER ** C ** LIBRARY FROM ABSOFT COMPILER ** C ****************************************************** C 13000 CONTINUE PPENTH=100.*(1./ANUMVP) PDELTA=(PTHICK-PPENTH)/2. IF(PDELTA.GT.0.0.AND.PPENTH.GT.0.0)GOTO13560 JTHICK=0 PTHIC2=PTHICK GOTO13590 13560 CONTINUE AINC=PDELTA/PPENTH NINC=AINC+0.9 JTHICK=NINC PTHIC2=PTHICK IF(NINC.GE.1)PTHIC2=PPENTH*REAL(NINC) 13590 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 135-- ** C ** TREAT THE MAC OSX AQUATERM DRIVER ** C ****************************************************** C 13500 CONTINUE ATEMP=PTHICK*ANUMVP/100. ITEMP=ATEMP+0.5 IF(ITEMP.LT.1)ITEMP=1 IF(ITEMP.GT.50)ITEMP=50 PTHIC2=REAL(ITEMP) JTHICK=0 GOTO9000 C C ****************************************************** C ** STEP 140-- ** C ** TREAT THE PC PRINTER DRIVER ** C ****************************************************** C 14000 CONTINUE GOTO9000 C C C ****************************************************** C ** STEP 150-- ** C ** TREAT THE LATEX (USING EEPIC) DRIVER ** C ****************************************************** C 15000 CONTINUE JTHICK=0 IF(ILATLT.EQ.'HARD')THEN IF(PTHICK.GE.0.25)THEN PTHIC2=0.3 ELSEIF(PTHICK.GE.0.15)THEN PTHIC2=0.2 ELSE PTHIC2=0.1 ENDIF ELSE C C FOR LATEX, ASSUME SINGLE LINE WIDTH IS 1 POINT WIDE. C SINCE OUR COORDINATE SYSTEM IS SET TO 300 DPI (ONE C POINT IS 1/72 OF AN INCH), THIS TRANSLATES TO C ABOUT 4 PIXEL UNITS. C CCCCC APIX=2.0 APIX=2.0 PPENTH=100.*(APIX/ANUMVP) PDELTA=(PTHICK-PPENTH)/2. IF(PDELTA.GT.0.0.AND.PPENTH.GT.0.0)THEN AINC=PDELTA/PPENTH NINC=AINC+0.9 JTHICK=NINC PTHIC2=PTHICK IF(NINC.GE.1)PTHIC2=PPENTH*REAL(NINC) ELSE JTHICK=0 PTHIC2=PTHICK ENDIF ENDIF GOTO9000 C C ****************************************************** C ** STEP 160-- ** C ** TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER ** C ****************************************************** C 16000 CONTINUE ATEMP=PTHICK*ANUMVP/100. ITEMP=ATEMP+0.5 IF(ITEMP.LT.1)ITEMP=1 IF(ITEMP.GT.50)ITEMP=50 PTHIC2=REAL(ITEMP) JTHICK=0 GOTO9000 C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRTH')GOTO9090 WRITE(ICOUT,999) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9011) 9011 FORMAT('***** AT THE END OF GRTRTH--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9012)ICASE 9012 FORMAT('ICASE = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9013)PTHICK,JTHICK,PTHIC2 9013 FORMAT('PTHICK,JTHICK,PTHIC2 = ',E15.7,I8,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9014)IMANUF,IMODEL 9014 FORMAT('IMANUF,IMODEL = ',A4,2X,A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,9019)IBUGG4,ISUBG4,IERRG4 9019 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') 9090 CONTINUE C RETURN END SUBROUTINE GRWRTH(PX1,PY1,ICTEXT,NCTEXT, 1IPATT,IFONT,ICASE,IJUST,IDIR,ANGLE,IFILL,ICOL, 1JPATT,JFONT,JCASE,JJUST,JDIR,ANGLE2,JFILL,JCOL, 1PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK, 1JSIZE, 1JHEIG2,JWIDT2,JVEGA2,JHOGA2, 1PHEIG2,PWIDT2,PVEGA2,PHOGA2, 1JTHICK,PTHIC2, 1PXLEC,PXLECG,PYLEC,PYLECG, 1ISYMBL,ISPAC, 1PX99,PY99) C C PURPOSE--FOR A SPECIFIC GRAPHICS DEVICE, C AND FOR THE STANDARD (HARDWARE-GENERATED) FONT, C GO TO THE POINT (PX1,PY1) AND WRITE OUT C THE TEXT STRING C (IN A HORIZONTAL DIRECTION) C CONTAINED IN THE C CHARACTER VECTOR ICTEXT(.), C WHICH CONSISTS OF NCTEXT CHARACTERS. C NOTE--PX1 AND PY1 ARE IN STANDARDIZED COORDINATES C THAT IS, EACH IS 0.0 TO 100.0. C NOTE--THE SUBSECTION RWIND HAS BEEN EXTRACTED C OUT OF PLOT CONTROL COMMON . C THIS (AND GRWRTV) ARE THE ONLY SUBROUTINES WHERE C THIS SUB-EXTRACTION HAS BEEN DONE. C C WRITTEN BY--JAMES J. FILLIBEN C STATISTICAL ENGINEERING DIVISION C CENTER FOR APPLIED MATHEMATICS C NATIONAL BUREAU OF STANDARDS C WASHINGTON, D. C. 20234 C PHONE--301-921-3651 C NOTE--DATAPLOT IS A REGISTERED TRADEMARK C OF THE NATIONAL BUREAU OF STANDARDS. C THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED, C MODIFIED, OR OTHERWISE USED IN A CONTEXT C OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM. C LANGUAGE--ANSI FORTRAN (1977) C VERSION NUMBER--83.6 C ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY 1983. C UPDATED --MARCH 1986. C UPDATED --JANUARY 1989. SUN (BY BILL ANDERSON) C DRIVER OBSOLETE C UPDATED --JANUARY 1989. POSTSCRIPT (BY ALAN HECKERT) C UPDATED --JANUARY 1989. CGM (BY ALAN HECKERT) C UPDATED --JANUARY 1989. QMS QUIC (BY ALAN HECKERT) C UPDATED --JANUARY 1989. CALCOMP (BY ALAN HECKERT) C UPDATED --JANUARY 1989. ZETA (BY ALAN HECKERT) C UPDATED --APRIL 1989. SOFT-CODE BACKSLASH FOR UNIX C UPDATED --OCTOBER 1989. RWIND CORRECTION (NELSON HSU) C UPDATED --MARCH 1990. X11 (BY ALAN HECKERT) C UPDATED --JULY 1990. PACK HP 2622 OUTPUT C UPDATED --MARCH 1991. PACK REGIS OUTPUT. ALSO, REGIS C POSITIONS CHARACTER BELOW RATHER THAN C ABOVE CURRENT POSITION. C UPDATED --MAY 1991. RENUMBER TOP BRANCHES (JJF) C UPDATED --MAY 1991. VGA/TURBOC DRIVER (JJF) C DRIVER OBSOLETE C UPDATED --MAY 1991. FIX POSTSCRIPT CHAR. INDICES. C UPDATED --OCTOBER 1991. POSTSCRIPT FONTS (ALAN) C UPDATED --SEPTEMBER 1994. FIX TURBO-C SECTION C BAD C-SIDE MULTIPLOTTING (SCALING) C UPDATED --JANUARY 1995. FIX FRONT END TIC LABEL JUST. C UPDATED --SEPTEMBER 1995. RETROACTIVE JIM/ALAN MERGE C UPDATED --SEPTEMBER 1995. FIX TURBO-C SECTION C BAD C-SIDE MULTIPLOTTING (SCALING) (AGAIN) C UPDATED --SEPTEMBER 1995. REFIX TURBO-C SECTION C UPDATED --JULY 1996. LAHEY DRIVER (ALAN HECKERT) C OLD, CALCOMP STYLE C DRIVER OBSOLETE C UPDATED --OCTOBER 1996. QUICKWIN DRIVER (ALAN) C UPDATED --OCTOBER 1996. OPENGL DRIVER (ALAN) C USE BILL MITCHELLS OPENGL C BINDING FOR FORTRAN C UPDATED --OCTOBER 1996. GKS (ALAN) C CODED, NOT TESTED C UPDATED --OCTOBER 1996. BINARY CGM (ALAN) C PLACEHOLDER FOR NOW C UPDATED --OCTOBER 1996. DISPLAY POSTSCRIPT (ALAN) C PLACEHOLDER FOR NOW C UPDATED --OCTOBER 1997. LAHEY INTERACTOR (ALAN) C UPDATED --DECEMBER 1997. GENERAL CODED FOR GUI C UPDATED --JULY 1998. LAHEY WINTERACTOR C UPDATED --JUNE 2000. GD (FOR JPEG, PNG, WINDOWS BMP) C UPDATED --JUNE 2000. MACINTOSH C PLACEHOLDER FOR NOW C UPDATED --JUNE 2000. PC PRINTER C PLACEHOLDER FOR NOW C UPDATED --MARCH 2002. LATEX (USING EEPIC) C PLACEHOLDER FOR NOW C UPDATED --MARCH 2002. SVG (SCALABLE VECTOR GRAPHICS) C UPDATED --MARCH 2005. SUPPORT FOR AQUATERM C UPDATED --FEBRUARY 2006. IMPLEMENT LATEX DRIVER C C-----NON-COMMON VARIABLES (GRAPHICS)------------------------------------------- C CWINT USE WINTERACTER CINTE USE INTERACTER CCCCC FOLLOWING LINE FOR MICROSOFT FORTRAN OCTOBER 1996 CQWIN USE DFLIB CIVFO USE IFQWIN CQWVF TYPE (XYCOORD) XY CQWVF TYPE (FONTINFO) MSFONT CQWVF TYPE (WINDOWCONFIG) DPSCREEN CQWVF CHARACTER*4 QWSCRN CQWVF COMMON/QUICKWN/DPSCREEN,QWSCRN,IQWNFT,IQWNFN C CHARACTER*4 ICTEXT CHARACTER*4 IPATT CHARACTER*4 IFONT CHARACTER*4 ICASE CHARACTER*4 IJUST CHARACTER*4 IDIR CHARACTER*4 IFILL CHARACTER*4 ICOL C CCCCC JULY, 1996. ADD FOLLOWING 2 LINES CHARACTER*4 IJUSTH CHARACTER*4 IJUSTV C CHARACTER*4 ISYMBL CHARACTER*4 ISPAC C CHARACTER*4 IC4 CHARACTER*1 IC CHARACTER*1 IC1 CHARACTER*1 IC2 CHARACTER*1 ICARAT CHARACTER*1 IQUOTE CHARACTER*2 ICJUNK C CHARACTER*130 ICSTR CHARACTER*130 ICSTR2 CHARACTER*130 ICSTR3 CHARACTER*4 ISUBN0 C CHARACTER*4 ISUBRO C CHARACTER*4 ICTEMP C DIMENSION ICTEXT(*) DIMENSION IHOLL(33) C FOLLOWING 2 LINES ADDED FOR X11 DRIVER INTEGER STRING(130) INTEGER IADE(80) CCCCC FOLLOWING 3 LINES FOR LAHEY COMPILER ADDED JULY 1996. CHARACTER*40 CLAHEY REAL RLAHEY(7) INTEGER ILAHEY(9) C C-----COMMON---------------------------------------------------------- C INCLUDE 'DPCOGR.INC' INCLUDE 'DPCONP.INC' INCLUDE 'DPCOBE.INC' INCLUDE 'DPCOST.INC' INCLUDE 'DPCODV.INC' C THE FOLLOWING CORRECTION WAS MADE NOVEMBER 1989 CCCCC COMMON /RWIND/ CCCCC1PWXMIN,PWXMAX,PWYMIN,PWYMAX, CCCCC1WWXMIN,WWXMAX,WWYMIN,WWYMAX COMMON /RWIND/ 1PWXMIN,PWXMAX,PWYMIN,PWYMAX,PWZMIN,PYZMAX, 1WWXMIN,WWXMAX,WWYMIN,WWYMAX,WWZMIN,WWZMAX C CCCCC MARCH 2002: ADD FOLLOWING LINE FOR SVG DEVICE PARAMETER(MAXCLR=89) INTEGER IRED(MAXCLR), IBLUE(MAXCLR), IGREEN(MAXCLR) C C C-----COMMON VARIABLES (GENERAL)-------------------------------------- C CHARACTER*4 IFEEDB CHARACTER*4 IPRINT CHARACTER*240 ICOUT C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW COMMON /PRINT/IFEEDB,IPRINT COMMON /TEXTOU/ICOUT,NCOUT,ILOUT C EXTERNAL XTEXTH, XTATTR C CCCCC MARCH 2002: ADD FOLLOWING LINE FOR SVG DEVICE INCLUDE 'DPCOCT.INC' C C-----START POINT----------------------------------------------------- C ISUBN0='WRTH' ISUBRO=ISUBG4 C NCSTR=(-999) K=(-999) C IC4='-999' IC='-' IC1='-' IC2='-' C PXDEL=(-999.0) PYDEL=(-999.0) C K=(-999) NCTEP2=(-999) C IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'WRTH')GOTO90 WRITE(ICOUT,999) 999 FORMAT(1X) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,51) 51 FORMAT('***** AT THE BEGINNING OF GRWRTH--') CALL DPWRST('XXX','BUG ') WRITE(ICOUT,53)PX1,PY1 53 FORMAT('PX1,PY1 = ',E15.7,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,54)NCTEXT 54 FORMAT('NCTEXT = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,55)(ICTEXT(I),I=1,NCTEXT) 55 FORMAT('(ICTEXT(I),I=1,NCTEXT) = ',25A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,56)JSIZE 56 FORMAT('JSIZE = ',A4) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,57)IGUNIT 57 FORMAT('IGUNIT = ',I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,59)IPATT,JPATT 59 FORMAT('IPATT,JPATT= ',A4,I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,60)IFONT,JFONT 60 FORMAT('IFONT,JFONT= ',A4,I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,61)ICASE,JCASE 61 FORMAT('ICASE,JCASE = ',A4,I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,62)IJUST,JJUST 62 FORMAT('IJUST,JJUST= ',A4,I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,63)IDIR,JDIR 63 FORMAT('IDIR,JDIR= ',A4,I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,64)ANGLE,ANGLE2 64 FORMAT('ANGLE,ANGLE2= ',2E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,65)IFILL,JFILL 65 FORMAT('IFILL,JFILL= ',A4,I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,66)ICOL,JCOL 66 FORMAT('ICOL,JCOL= ',A4,I8) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,67)PHEIGH,JHEIG2,PHEIG2 67 FORMAT('PHEIGH,JHEIG2,PHEIG2= ',E15.7,I8,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,68)PWIDTH,JWIDT2,PWIDT2 68 FORMAT('PWIDTH,JWIDT2,PWIDT2= ',E15.7,I8,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,69)PVEGAP,JVEGA2,PVEGA2 69 FORMAT('PVEGAP,JVEGA2,PVEGA2= ',E15.7,I8,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,70)PHOGAP,JHOGA2,PHOGA2 70 FORMAT('PHOGAP,JHOGA2,PHOGA2= ',E15.7,I8,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,71)PTHICK,JTHICK,PTHIC2 71 FORMAT('PTHICK,JTHICK,PTHIC2= ',E15.7,I8,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,73)PXLEC,PXLECG 73 FORMAT('PXLEC,PXLECG= ',E15.7,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,74)PYLEC,PYLECG 74 FORMAT('PYLEC,PYLECG= ',E15.7,E15.7) CALL DPWRST('XXX','BUG ') WRITE(ICOUT,79)IBUGG4,ISUBG4,IERRG4 79 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4) CALL DPWRST('XXX','BUG ') 90 CONTINUE C C ****************************************** C ** STEP XX-- ** C ** COMPUTE NEW START POINTS DEPENDING ** C ** ON THE JUSTIFICATION ** C ****************************************** C CCCCC JULY, 1996. ADD SETTINGS FOR IJUSTH, IJUSTV IN FOLLOWING BLOCK IJUSTH='LEFT' IJUSTV='BOTT' C IF(IJUST.EQ.'LEFT')GOTO910 IF(IJUST.EQ.'CENT')GOTO920 IF(IJUST.EQ.'RIGH')GOTO930 C IF(IJUST.EQ.'LJUS')GOTO910 IF(IJUST.EQ.'CJUS')GOTO920 IF(IJUST.EQ.'RJUS')GOTO930 C IF(IJUST.EQ.'LEBO')GOTO910 IF(IJUST.EQ.'CEBO')GOTO920 IF(IJUST.EQ.'RIBO')GOTO930 C IF(IJUST.EQ.'LECE')GOTO940 IF(IJUST.EQ.'CECE')GOTO950 IF(IJUST.EQ.'RICE')GOTO960 C IF(IJUST.EQ.'LETO')GOTO970 IF(IJUST.EQ.'CETO')GOTO980 IF(IJUST.EQ.'RITO')GOTO990 C GOTO910 C 910 CONTINUE PXINC=0.0 PYINC=0.0 IJUSTH='LEFT' IJUSTV='BOTT' GOTO995 C 920 CONTINUE PXINC=PXLEC/2.0 PYINC=0.0 IJUSTH='CENT' IJUSTV='BOTT' GOTO995 C 930 CONTINUE PXINC=PXLEC PYINC=0.0 IJUSTH='RIGH' IJUSTV='BOTT' GOTO995 C 940 CONTINUE PXINC=0.0 PYINC=PYLEC/2.0 IJUSTH='LEFT' IJUSTV='CENT' GOTO995 C 950 CONTINUE PXINC=PXLEC/2.0 PYINC=PYLEC/2.0 IJUSTH='CENT' IJUSTV='CENT' GOTO995 C 960 CONTINUE PXINC=PXLEC PYINC=PYLEC/2.0 IJUSTH='RIGH' IJUSTV='CENT' GOTO995 C 970 CONTINUE PXINC=0.0 PYINC=PYLEC IJUSTH='LEFT' IJUSTV='TOP ' GOTO995 C 980 CONTINUE PXINC=PXLEC/2.0 PYINC=PYLEC IJUSTH='CENT' IJUSTV='TOP ' GOTO995 C 990 CONTINUE PXINC=PXLEC PYINC=PYLEC IJUSTH='RIGH' IJUSTV='TOP ' GOTO995 C 995 CONTINUE PXINC2=PXINC*(100.0/(PWXMAX-PWXMIN)) PYINC2=PYINC*(100.0/(PWYMAX-PWYMIN)) PX1P=PX1-PXINC2 PY1P=PY1-PYINC2 C C ************************* C ** STEP XX-- ** C ** COMPUTE END POINT ** C ************************* C ANCTEX=NCTEXT PX99=PX1P+ANCTEX*(PWIDT2+PHOGA2) PY99=PY1P C C ****************************************************** C ** STEP 1-- ** C ** BRANCH ACCORDING TO THE MANUFACTURER ** C ** AND THE MODEL ** C ****************************************************** C IF(IMANUF.EQ.'TEKT')GOTO1005 IF(IMANUF.EQ.'HP')GOTO1010 IF(IMANUF.EQ.'PCL')GOTO1015 IF(IMANUF.EQ.'GENE')GOTO1020 IF(IMANUF.EQ.'CALC')GOTO1025 IF(IMANUF.EQ.'ZETA')GOTO1030 IF(IMANUF.EQ.'RAMT')GOTO1035 IF(IMANUF.EQ.'SUN ')GOTO1040 IF(IMANUF.EQ.'XXXX')GOTO1045 IF(IMANUF.EQ.'REGI')GOTO1050 IF(IMANUF.EQ.'POST')GOTO1055 IF(IMANUF.EQ.'QUIC')GOTO1060 IF(IMANUF.EQ.'X11 ')GOTO1065 IF(IMANUF.EQ.'TURB')GOTO1070 IF(IMANUF.EQ.'GKS ')GOTO1075 IF(IMANUF.EQ.'LAHE')GOTO1080 IF(IMANUF.EQ.'GD ')GOTO1085 IF(IMANUF.EQ.'QWIN')GOTO1090 IF(IMANUF.EQ.'AQUA')GOTO1091 IF(IMANUF.EQ.'OPGL')GOTO1095 IF(IMANUF.EQ.'PRIN')GOTO1096 IF(IMANUF.EQ.'LATE')GOTO1097 IF(IMANUF.EQ.'MACI')GOTO1098 IF(IMANUF.EQ.'SVG ')GOTO1099 GOTO9000 C 1005 CONTINUE GOTO1100 C 1010 CONTINUE IF(IMODEL.EQ.'7221')GOTO2100 IF(IMODEL.EQ.'2622')GOTO2300 IF(IMODEL.EQ.'2623')GOTO2300 IF(IMODEL.EQ.'2627')GOTO2300 IF(IMODEL.EQ.'2647')GOTO2300 GOTO2200 C 1015 CONTINUE GOTO2600 C 1020 CONTINUE IF(IMODEL.EQ.'CODE')GOTO3200 IF(IMODEL.EQ.'CGM')GOTO3300 IF(IMODEL.EQ.'CGMB')GOTO3400 GOTO3100 C 1025 CONTINUE GOTO4100 C 1030 CONTINUE GOTO5100 C 1035 CONTINUE GOTO6100 C 1040 CONTINUE GOTO6600 C 1045 CONTINUE GOTO7100 C 1050 CONTINUE GOTO8100 C 1055 CONTINUE IF(IMODEL.EQ.'DISP')GOTO8900 GOTO8600 C 1060 CONTINUE GOTO9100 C 1065 CONTINUE IF(IMODEL.EQ.'35CL')GOTO9600 IF(IMODEL.EQ.'35BW')GOTO9600 IF(IMODEL.EQ.'35WB')GOTO9600 IF(IMODEL.EQ.'PPRN')GOTO9600 IF(IMODEL.EQ.'PTRA')GOTO9600 IF(IMODEL.EQ.'KTRA')GOTO9600 GOTO9600 C 1070 CONTINUE GOTO10000 C 1075 CONTINUE GOTO11000 C 1080 CONTINUE IF(IMODEL.EQ.'INTE')GOTO4900 IF(IMODEL.EQ.'WINT')GOTO4950 GOTO4600 C 1085 CONTINUE IF(IMODEL.EQ.'JPEG')GOTO12000 IF(IMODEL.EQ.'PNG ')GOTO12000 IF(IMODEL.EQ.'WBMP')GOTO12000 IF(IMODEL.EQ.'GIF')GOTO12000 GOTO12000 C 1090 CONTINUE GOTO4700 C 1091 CONTINUE GOTO13500 C 1095 CONTINUE GOTO4800 C 1096 CONTINUE GOTO14000 C 1097 CONTINUE GOTO15000 C 1098 CONTINUE GOTO13000 C 1099 CONTINUE GOTO16000 C C ****************************************************** C ** STEP 11-- ** C ** TREAT THE TEKTRONIX 4014 (ETC.) CASE ** C ****************************************************** C 1100 CONTINUE IFACTO=4 CCCCC IF(NUMHPP.GE.4000)IFACTO=1 CCCCC FOLLOWING LINE MODIFIED MARCH, 1990 (PORTRAIT, SQUARE ORIENTATION) IF(NUMVPP.GE.3000)IFACTO=1 ICSTR(1:1)=IGSC NCSTR=1 CALL GRTRSD(PX1P,PY1P,IX1P,IY1P,ISUBN0) CALL TKTRPT(IX1P,IY1P,IFACTO,ICSTR,NCSTR,ISUBN0) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=IUSC DO1110I=1,NCTEXT NCSTR=NCSTR+1 ICTEMP=ICTEXT(I) ICSTR(NCSTR:NCSTR)=ICTEMP(1:1) 1110 CONTINUE CALL GRWRST(ICSTR,NCSTR,ISUBN0) GOTO9000 C C ****************************************************** C ** STEP 21-- ** C ** TREAT THE HEWLETT-PACKARD 7221 CASE ** C ** (MULTI-COLOR PENPLOTTER) ** C ** TO WRITE A HORIZONTAL TEXT STRING-- ** C ** USE THE LOWER CASE P (= MOVE) INSTRUCTION * C ** AND PACKED BINARY COORDINATES, ** C ** AND THE TILDA SINGLE (RT-LEFT) QUOTE (= INVOKE LABEL MODE) I C ** AND THE DESIRED TEXT STRING, ** C ** AND ETX TO DENOTE THE END OF TEXT STRING, ** C ** (WITH TRAILING RIGHT CURLY BRACKET WHICH IS THE ** C ** DEFAULT NO-OP END-OF-INSTRUCTION TERMINATOR). ** C ** REFERENCE--HP 7221A GRAPHICS PLOTTER ** C ** OPERATING AND PROGRAMMING MANUAL, ** C ** PAGE 80-85, 253-254. ** C ** PAGE 111 AND 112. ** C ****************************************************** C 2100 CONTINUE ICSTR(1:1)='p' NCSTR=1 CALL GRTRSD(PX1P,PY1P,IX,IY,ISUBN0) CALL HPTRPT(IX,IY,ICSTR,NCSTR,ISUBN0) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) C CCCCC WRITE(IGUNIT,2111)(ICTEXT(I),I=1,NCTEP2) C2111 FORMAT('~''',120A1) ICSTR(1:2)='~''' NCSTR=2 DO2112J=1,NCTEXT K=J+NCSTR ICTEMP=ICTEXT(J) ICSTR(K:K)=ICTEMP(1:1) 2112 CONTINUE NCSTR=K NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=IETXC NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='}' CALL GRWRST(ICSTR,NCSTR,ISUBN0) GOTO9000 C C ****************************************************** C ** STEP 22-- ** C ** TREAT THE HEWLETT-PACKARD HP-GL CASES ** C ** (ALL PLOTTERS THAT TAKE HP-GL INSTRUCTIONS) ** C ** (MULTI-COLOR PENPLOTTERS) ** C ** TO WRITE A HORIZONTAL TEXT STRING-- ** C ** USE THE PU (= PEN UP) INSTRUCTION ** C ** AND THE PA (= PLOT ABSOLUTE) INSTRUCTION ** C ** ALONG WITH INTEGER COORDINATES, ** C ** AND THE LB (= LABEL) INSTRUCTION ** C ** AND THE DESIRED TEXT STRING, ** C ** AND ETX TO DENOTE THE END OF TEXT STRING, ** C ** (WITH TRAILING SEMI-COLONS WHICH ARE THE ** C ** DEFAULT NO-OP END-OF-INSTRUCTION TERMINATOR). ** C ** REFERENCE--HP 9872C GRAPHICS PLOTTER ** C ** OPERATING AND PROGRAMMING MANUAL, ** C ** PAGE 62, 143. ** C ** PAGE 65-67, 143. ** C ** PAGE 75, 141. ** C ****************************************************** C 2200 CONTINUE CALL GRTRSD(PX1P,PY1P,IX,IY,ISUBN0) CCCCC WRITE(IGUNIT,2211)IX,IY C2211 FORMAT('PU;PA',I5,',',I5,';') ICSTR(1:5)='PU;PA' NCSTR=5 NCHTOT=5 CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR) ICSTR(11:11)=',' NCSTR=11 CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR) ICSTR(17:17)=';' NCSTR=17 CALL GRWRST(ICSTR,NCSTR,ISUBN0) C NCTEP1=NCTEXT+1 NCTEP2=NCTEXT+2 ICTEXT(NCTEP1)=IETXC ICTEXT(NCTEP2)=';' CCCCC WRITE(IGUNIT,2212)(ICTEXT(J),J=1,NCTEP2) C2212 FORMAT('LB',120A1) ICSTR(1:2)='LB' NCSTR=2 DO2212J=1,NCTEP2 K=J+NCSTR ICSTR(K:K)=ICTEXT(J) 2212 CONTINUE NCSTR=K CALL GRWRST(ICSTR,NCSTR,ISUBN0) C 2290 CONTINUE GOTO9000 C C ********************************************************** C ** STEP 23-- ** C ** TREAT THE HEWLETT-PACKARD HP-2622 CASES ** C ** (ALL PLOTTERS THAT TAKE HP-2622-LIKE INSTRUCTIONS) ** C ** (MONOCHROME DISPLAY TERMINALS) ** C ** REFERENCE--HP 2322C GRAPHICS PLOTTER ** C ** REFERENCE MANUAL, ** C ** PAGE 10-12, 10-13, 10-21. C ********************************************************** C C JULY, 1990. PACK OUTPUT ONTO 1 LINE. C 2300 CONTINUE CALL GRTRSD(PX1P,PY1P,IX,IY,ISUBN0) ICSTR(1:1)=IESCC ICSTR(2:4)='*pa' NCSTR=4 NCHTOT=5 CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR) ICSTR(10:10)=',' NCSTR=10 CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR) ICSTR(16:16)='Z' NCSTR=16 CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0) C NCTEP1=NCTEXT+1 CCCCC NCTEP2=NCTEXT+2 ICTEXT(NCTEP1)=ICRC CCCCC ICTEXT(NCTEP2)='Z' CCCCC ICSTR(1:1)=IESCC CCCCC ICSTR(2:3)='*l' CCCCC NCSTR=3 ICSTR(17:17)=IESCC ICSTR(18:19)='*l' NCSTR=19 CCCCC DO2312J=1,NCTEP2 DO2312J=1,NCTEP1 K=J+NCSTR ICSTR(K:K)=ICTEXT(J) 2312 CONTINUE NCSTR=K CALL GRWRST(ICSTR,NCSTR,ISUBN0) C 2390 CONTINUE GOTO9000 C C ********************************************************** C ** STEP 26-- ** C ** TREAT THE HEWLETT-PACKARD PCL CASES ** C ** (LASERJET SERIES II LASER PRINTERS ) ** C ** REFERENCE--LASERJET SERIES II TECHNICAL ** C ** REFERENCE MANUAL, ** C ** PAGE ** C ** FIRST SET FONT IF NECCESSARY ** C ** NOTE THAT ONLY THE STROKE WEIGHT AND THE TYPEFACE ** C ** HAVE TO BE SET HERE. THE POINT SIZE AND CHARACTERS ** C ** PER INCH ARE SET IN "GRTRSI". THE OTHER ** C ** CHARACTERISTICS DO NOT VARY BETWEEN THE INTERNAL ** C ** FONTS AND ARE SET IN "GRINDE". ** C ********************************************************** C 2600 CONTINUE IF(IPCLFN.NE.IPCLFC)GOTO2605 IPCLFC=IPCLFN ICSTR(1:1)=IESCC C ICSTR(2:5)='(s3T' IF(IPCLFN.EQ.'COND')ICSTR(4:4)='0' ICSTR(6:6)=IESCC ICSTR(7:10)='(s0B' IF(IPCLFN.EQ.'CBOL')ICSTR(9:9)='3' NCSTR=10 CALL GRWRST(ICSTR,NCSTR,ISUBN0) C 2605 CONTINUE CALL GRTRSD(PX1P,PY1P,IX,IY,ISUBN0) ICSTR(1:1)=IESCC ICSTR(2:3)='*p' NCSTR=3 NCHTOT=4 CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR) ICSTR(8:8)='X' NCSTR=8 CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR) ICSTR(13:13)='Y' NCSTR=13 C DO2612J=1,NCTEXT NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=ICTEXT(J) 2612 CONTINUE CALL GRWRST(ICSTR,NCSTR,ISUBN0) C 2690 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 31-- ** C ** TREAT THE GENERAL (DEVICE-INDEPENDENT) CASE ** C ****************************************************** C 3100 CONTINUE C JANUARY, 1988: SWITCH TO LET DATAPLOT DO THE JUSTIFICATION OR C LET THE POST PROCESOR DO IT CCCCC THE FOLLOWING 2 LINES WAS CHANGED JANUARY 1995 CCCCC TO FIX THE TIC JUSTIFICATION PROBLEM JANUARY 1995 CCCCC IF(IJUSSW.EQ.'ON')PX1P=PX1 CCCCC IF(IJUSSW.EQ.'ON')PY1P=PY1 PX1P=PX1 PY1P=PY1 ICSTR(1:8)='MOVE TO ' NCSTR=8 NCHTOT=10 NCHDEC=5 CALL GRTRSA(PX1P,PY1P,AX,AY,ISUBN0) PX1P=AX PY1P=AY CALL GRTRRE(PX1P,NCHTOT,NCHDEC,ICSTR,NCSTR) ICSTR(19:20)=' ' NCSTR=20 CALL GRTRRE(PY1P,NCHTOT,NCHDEC,ICSTR,NCSTR) CALL GRWRST(ICSTR,NCSTR,ISUBN0) IF(NCTEXT.LE.0)GOTO3190 ICSTR(1:11)='WRITE TEXT ' NCSTR=11 K=0 DO3112J=1,NCTEXT K=J+NCSTR ICSTR(K:K)=ICTEXT(J) 3112 CONTINUE NCSTR=K CALL GRWRST(ICSTR,NCSTR,ISUBN0) 3190 CONTINUE GOTO9000 C C *************************************************************** C ** STEP 32-- ** C ** TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE ** C *************************************************************** C 3200 CONTINUE C JANUARY, 1988: SWITCH TO LET DATAPLOT DO THE JUSTIFICATION OR C LET THE POST PROCESOR DO IT C DECEMBER 1997. SLIGHTLY DIFFERENT CODING FOR GUI. CCCCC THE FOLLOWING 2 LINES WAS CHANGED JANUARY 1995 CCCCC TO FIX THE TIC JUSTIFICATION PROBLEM JANUARY 1995 CCCCC IF(IJUSSW.EQ.'ON')PX1P=PX1 CCCCC IF(IJUSSW.EQ.'ON')PY1P=PY1 IF(IMODE2.EQ.'PACK'.OR.IMODE2.EQ.'GUI')GOTO3250 C PX1P=PX1 PY1P=PY1 ICSTR(1:5)='MOTO ' NCSTR=5 NCHTOT=10 NCHDEC=5 CALL GRTRSA(PX1P,PY1P,AX,AY,ISUBN0) PX1P=AX PY1P=AY CALL GRTRRE(PX1P,NCHTOT,NCHDEC,ICSTR,NCSTR) ICSTR(16:17)=' ' NCSTR=17 CALL GRTRRE(PY1P,NCHTOT,NCHDEC,ICSTR,NCSTR) CALL GRWRST(ICSTR,NCSTR,ISUBN0) GOTO3260 C 3250 CONTINUE CALL GRTRSA(PX1,PY1,AX,AY,ISUBN0) IPXTMP=INT(AX*10.**IGENFA+0.5) IPYTMP=INT(AY*10.**IGENFA+0.5) ICSTR(1:2)='M ' NCSTR=2 NCHTOT=IGENFA+3 CALL GRTRIN(IPXTMP,NCHTOT,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=' ' CALL GRTRIN(IPYTMP,NCHTOT,ICSTR,NCSTR) CALL GRWRST(ICSTR,NCSTR,ISUBN0) C 3260 CONTINUE IF(NCTEXT.LE.0)GOTO3290 ICSTR(1:5)='WRTE ' NCSTR=5 K=0 DO3212J=1,NCTEXT K=J+NCSTR ICSTR(K:K)=ICTEXT(J) 3212 CONTINUE NCSTR=K CALL GRWRST(ICSTR,NCSTR,ISUBN0) 3290 CONTINUE GOTO9000 C C *************************************************************** C ** STEP 33-- ** C ** TREAT THE CGM CASE ** C *************************************************************** C 3300 CONTINUE C JANUARY, 1988: SWITCH TO LET DATAPLOT DO THE JUSTIFICATION OR C LET THE POST PROCESOR DO IT IF(NCTEXT.LE.0)GOTO3390 C CCCCC THE FOLLOWING 2 LINES WAS CHANGED JANUARY 1995 CCCCC TO FIX THE TIC JUSTIFICATION PROBLEM JANUARY 1995 CCCCC IF(IJUSSW.EQ.'ON')PX1P=PX1 CCCCC IF(IJUSSW.EQ.'ON')PY1P=PY1 PX1P=PX1 PY1P=PY1 CALL GRTRSA(PX1P,PY1P,AX,AY,ISUBN0) PX1P=AX PY1P=AY ICSTR(1:6)='TEXT (' NCSTR=6 NCHTOT=10 NCHDEC=5 CALL GRTRRE(PX1P,NCHTOT,NCHDEC,ICSTR,NCSTR) ICSTR(17:17)=',' NCSTR=17 CALL GRTRRE(PY1P,NCHTOT,NCHDEC,ICSTR,NCSTR) ICSTR(28:34)=') FINAL' NCSTR=34 CALL GRWRST(ICSTR,NCSTR,ISUBN0) ICSTR(1:1)='"' NCSTR=1 K=0 DO3312J=1,NCTEXT K=J+NCSTR ICSTR(K:K)=ICTEXT(J) 3312 CONTINUE K=K+1 ICSTR(K:K)='"' K=K+1 ICSTR(K:K)=';' NCSTR=K CALL GRWRST(ICSTR,NCSTR,ISUBN0) C 3390 CONTINUE C GOTO9000 C C *************************************************** C ** STEP 34-- ** C ** TREAT THE CGM (BINARY) CASE ** C *************************************************** C 3400 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 41-- ** C ** TREAT THE CALCOMP XXXXXX CASE ** C ** TO WRITE A HORIZONTAL TEXT STRING-- ** C ** WRITE OUT AN XXXXXXXXXX ** C ** USE CALCOMP LIBRARY ROUTINE SYMBOL ** C ** REFERENCE--FUNDAMENTAL PLOTTING ROUTINES ** C ** FORTRAN REFERENCE MANUAL - NICOLET ** C ** PAGES 2-7 (1984 EDITION) ** C ****************************************************** C 4100 CONTINUE CCCCC WRITE(IGUNIT,4111) C4111 FORMAT('FIX SUBROUTINE GRWRTH TO WRITE HOR TEXT CALCOMP DEV.') CCCCC ICSTR(1:52)='FIX SUBROUTINE GRWRTH TO WRITE HOR TEXT CALCOMP DEV.' CCCCC NCSTR=52 CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0) CALL CALCPT(PX1P,PY1P,AX1,AY1,ISUBN0) DO4112J=1,NCTEXT ICSTR(J:J)=ICTEXT(J) 4112 CONTINUE ANGLE=0. AXTEMP=0. CALL CALCPT(AXTEMP,PHEIG2,AYTMP2,HEIGHT,ISUBN0) CALL CALCTR(ICSTR,IHOLL,NCTEXT) CCCCC CALL SYMBOL(AX1,AY1,HEIGHT,IHOLL,ANGLE,NCTEXT) GOTO9000 C C ****************************************************** C ** STEP 46-- ** C ** TREAT THE LAHEY XXXXXX CASE ** C ** REFERENCE--Programmer's Reference, Revision C ** C ** Lahey Computer Systems, January, 1992** C ** PAGES 51 THRU 65 ** C ****************************************************** C 4600 CONTINUE ICSTR=' ' CALL CALCPT(PX1,PY1,AX1,AY1,ISUBN0) DO4612J=1,NCTEXT ICSTR(J:J)=ICTEXT(J) 4612 CONTINUE CALL GRINFO(ILAHEY,RLAHEY,CLAHEY) ICOLMN=INT(REAL(ILAHEY(8))*(AX1*RLAHEY(1)/11.0)+0.5) IF(IJUSTH.EQ.'RIGH')THEN NSHIFT=NCTEXT ELSEIF(IJUSTH.EQ.'CENT')THEN NSHIFT=NCTEXT/2 ELSE NSHIFT=0 ENDIF ICOLMN=ICOLMN-NSHIFT IF(ICOLMN.LT.1)ICOLMN=1 IF(ICOLMN.GT.ILAHEY(8))ICOLMN=ILAHEY(8) ILINE=INT(REAL(ILAHEY(9))*(RLAHEY(1)*(8.5-AY1)/8.5)+0.5) IF(IJUSTV.EQ.'TOP')THEN NSHIFT=1 ELSEIF(IJUSTV.EQ.'CENT')THEN NSHIFT=1 ELSE NSHIFT=0 ENDIF ILINE=ILINE-NSHIFT IF(ILINE.LT.1)ILINE=1 IF(ILINE.GT.ILAHEY(9))ILINE=ILAHEY(9) CCCCC CALL GTEXT(ILINE,ICOLMN,ICSTR(1:NCTEXT)) GOTO9000 C C ****************************************************** C ** STEP 47-- ** C ** TREAT THE MICROSOFT QUICKWIN DRIVER ** C ** FOR WINDOWS 95 AND WINDOWS NT. ** C ****************************************************** C 4700 CONTINUE ICSTR=' ' DO4712J=1,NCTEXT ICSTR(J:J)=ICTEXT(J) 4712 CONTINUE CCCCC CALL GRTRSD(PX1,100.-PY1,IX1,IY1,ISUBN0) CALL GRTRSD(PX1,PY1,IX1,IY1,ISUBN0) IF(IJUSTH.EQ.'LEFT')THEN IXINC=0 ELSEIF(IJUSTH.EQ.'CENT')THEN CQWVF IXINC=GETGTEXTEXTENT(ICSTR(1:NCTEXT))/2 ELSEIF(IJUSTH.EQ.'RIGH')THEN CQWVF IXINC=GETGTEXTEXTENT(ICSTR(1:NCTEXT)) ELSE IXINC=0 ENDIF IF(IJUSTV.EQ.'TOP ')THEN IYINC=0 ELSEIF(IJUSTV.EQ.'CENT')THEN IYINC=JHEIG2/2 ELSEIF(IJUSTV.EQ.'BOTT')THEN IYINC=JHEIG2 ELSE IYINC=0 ENDIF CQWVF CALL MOVETO(INT2(IX1-IXINC),INT2(IY1-IYINC),XY) CQWVF CALL OUTGTEXT(ICSTR(1:NCTEXT)) GOTO9000 C C ****************************************************** C ** STEP 48-- ** C ** TREAT THE OPEN-GL DRIVER ** C ** FOR WINDOWS 95 AND WINDOWS NT AND X11 ** C ****************************************************** C 4800 CONTINUE IF(IOPGOF.EQ.'OFF')GOTO4899 C DO4805I=1,NCTEXT IC1=ICTEXT(I)(1:1) CALL DPCOAN(IC1,IJUNK) STRING(I)=IJUNK 4805 CONTINUE STRING(NCTEXT+1)=0 C ILAST=80 DO4810I=80,1,-1 ILAST=I IF(IX11FN(I:I).NE.' ')GOTO4819 4810 CONTINUE 4819 CONTINUE DO4820I=1,ILAST CALL DPCOAN(IX11FN(I:I),IJUNK) IADE(I)=IJUNK 4820 CONTINUE IADE(ILAST+1)=0 C CALL GLTATT(IADE,IXERR) IF(IXERR.EQ.1) THEN WRITE(ICOUT,4821) 4821 FORMAT(1X,'WARNING: X11 FONT NAME NOT FOUND--USE CURRENT FONT') CALL DPWRST('XXX','BUG ') ELSEIF(IXERR.EQ.2)THEN WRITE(ICOUT,4822) 4822 FORMAT(1X,'WARNING: X11 FONT NAME NOT FOUND--USE DEFAULT FONT') CALL DPWRST('XXX','BUG ') END IF C IFONTH=0 IFONTV=0 IF(IJUST.EQ.'LEFT')IFONTH=0 IF(IJUST.EQ.'CENT')IFONTH=1 IF(IJUST.EQ.'RIGH')IFONTH=2 IF(IJUST.EQ.'LJUS')IFONTH=0 IF(IJUST.EQ.'CJUS')IFONTH=1 IF(IJUST.EQ.'RJUS')IFONTH=2 IF(IJUST.EQ.'LEBO')IFONTH=0 IF(IJUST.EQ.'CEBO')IFONTH=1 IF(IJUST.EQ.'RIBO')IFONTH=2 IF(IJUST.EQ.'LECE')IFONTH=0 IF(IJUST.EQ.'CECE')IFONTH=1 IF(IJUST.EQ.'RICE')IFONTH=2 IF(IJUST.EQ.'LETO')IFONTH=0 IF(IJUST.EQ.'CETO')IFONTH=1 IF(IJUST.EQ.'RITO')IFONTH=2 IF(IJUST.EQ.'LEFT')IFONTV=1 IF(IJUST.EQ.'CENT')IFONTV=1 IF(IJUST.EQ.'RIGH')IFONTV=1 IF(IJUST.EQ.'LJUS')IFONTV=1 IF(IJUST.EQ.'CJUS')IFONTV=1 IF(IJUST.EQ.'RJUS')IFONTV=1 IF(IJUST.EQ.'LEBO')IFONTV=1 IF(IJUST.EQ.'CEBO')IFONTV=1 IF(IJUST.EQ.'RIBO')IFONTV=1 IF(IJUST.EQ.'LECE')IFONTV=0 IF(IJUST.EQ.'CECE')IFONTV=0 IF(IJUST.EQ.'RICE')IFONTV=0 IF(IJUST.EQ.'LETO')IFONTV=2 IF(IJUST.EQ.'CETO')IFONTV=2 IF(IJUST.EQ.'RITO')IFONTV=2 IXERR=0 IX1=INT(PX1+0.5) IY1=INT(PY1+0.5) CALL GLTEXH(STRING,IX1,IY1,IFONTH,IFONTV,IXERR) C 4899 CONTINUE C GOTO9000 C C ****************************************************** C ** STEP 49-- ** C ** TREAT THE LAHEY INTERACTOR CASE ** C ****************************************************** C 4900 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 49B- ** C ** TREAT THE LAHEY WINTERACTOR CASE ** C ****************************************************** C 4950 CONTINUE ICSTR=' ' DO4952J=1,NCTEXT ICSTR(J:J)=ICTEXT(J) 4952 CONTINUE IF(IJUSTH.EQ.'LEFT')THEN CWINT CALL IGrCharJustify('L') ELSEIF(IJUSTH.EQ.'CENT')THEN CWINT CALL IGrCharJustify('C') ELSEIF(IJUSTH.EQ.'RIGH')THEN CWINT CALL IGrCharJustify('R') ELSE CWINT CALL IGrCharJustify('C') ENDIF PYINC=0.0 IF(IJUSTV.EQ.'TOP')THEN CWINT PYINC=InfoGraphics(4) ELSEIF(IJUSTV.EQ.'CENT')THEN CWINT PYINC=InfoGraphics(4)/2.0 ELSEIF(IJUSTV.EQ.'BOTT')THEN CWINT PYINC=0.0 ELSE CWINT PYINC=InfoGraphics(4)/2.0 ENDIF CWINT CALL IGrCharOut(PX1,PY1+PYINC,ICSTR(1:NCTEXT)) GOTO9000 C C C ****************************************************** C ** STEP 51-- ** C ** TREAT THE ZETA 3600SX AND 3653SX CASES ** C ** TO WRITE A HORIZONTAL TEXT STRING-- ** C ** USE THE 1 OP CODE (= MOVE) ** C ** ALONG WITH COORDINATES, ** C ** USE THE 3 OP CODE (= CHARACTER STRING) ** C ** ALONG WITH RELATIVE COOR ** C ** ALONG WITH NUMBER OF CHAR (= 1) ** C ** ALONG WITH CONVERTED CHAR STRING ** C ** (2 CONVERTED CHAR FOR EVERY SINGLE CHAR). ** C ** REFERENCE--USER MANUAL FOR DIGITAL PLOTTER ** C ** MODELS 3600SX AND 3653SX ** C ** PAGES B-0 , B-1, AND E-1 ** C ** REFERENCE--ZETA FORTRAN REFERENCE MANUAL ** C ** PAGE A-2 ** C ** USE CALCOMP LIBRARY (MARCH,1988) ** C ****************************************************** C 5100 CONTINUE CCCCC ICSTR(1:1)='1' CCCCC NCSTR=1 CCCCC CALL GRTRSD(PX1P,PY1P,IX,IY,ISUBN0) CCCCC CALL ZETRPT(IX,IY,ICSTR,NCSTR,ISUBN0) CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0) C CCCCC ICSTR(1:1)='3' CCCCC NCSTR=1 CCCCC PXDEL=PX99-PX1P CCCCC PYDEL=PY99-PY1P CCCCC CALL GRTRSD(PXDEL,PYDEL,IXW,IYH,ISUBN0) CCCCC CALL ZETRPT(IXW,IYH,ICSTR,NCSTR,ISUBN0) C CCCCC NCSTR=NCSTR+1 CCCCC ITENS=NCTEXT/10 CCCCC ITENSP=ITENS+48 CCCCC ICSTR(NCSTR:NCSTR)=CHAR(ITENSP) CCCCC CALL DPCONA(ITENSP,ICSTR(NCSTR:NCSTR)) C CCCCC NCSTR=NCSTR+1 CCCCC IUNITS=NCTEXT-10*ITENS CCCCC IUNITP=IUNITS+48 CCCCC ICSTR(NCSTR:NCSTR)=CHAR(IUNITP) CCCCC CALL DPCONA(IUNITP,ICSTR(NCSTR:NCSTR)) C CCCCC IF(NCTEXT.LE.0)GOTO5190 CCCCC DO5110I=1,NCTEXT CCCCC IC4=ICTEXT(I) CCCCC IC=IC4(1:4) CCCCC CALL ZETRCH(IC,IC1,IC2) CCCCC NCSTR=NCSTR+1 CCCCC ICSTR(NCSTR:NCSTR)=IC1 CCCCC NCSTR=NCSTR+1 CCCCC ICSTR(NCSTR:NCSTR)=IC2 C5110 CONTINUE C CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0) C C5190 CONTINUE CALL CALCPT(PX1P,PY1P,AX1,AY1,ISUBN0) DO5112J=1,NCTEXT ICSTR(J:J)=ICTEXT(J) 5112 CONTINUE ANGLE=0. AXTEMP=0. CALL CALCPT(AXTEMP,PHEIG2,AYTMP2,HEIGHT,ISUBN0) CALL CALCTR(ICSTR,IHOLL,NCTEXT) CCCCC CALL SYMBOL(AX1,AY1,HEIGHT,IHOLL,ANGLE,NCTEXT) GOTO9000 C C ****************************************************** C ** STEP 61-- ** C ** TREAT THE RAMTEK XXXXXX CASE ** C ** TO WRITE A HORIZONTAL TEXT STRING-- ** C ** WRITE OUT AN XXXXXXXXXX ** C ** (NOT DONE) ** C ** REFERENCE--XX ** C ** XX ** C ** PAGES XX AND XX ** C ****************************************************** C 6100 CONTINUE CCCCC WRITE(IGUNIT,6111) C6111 FORMAT('FIX SUBROUTINE GRWRTH TO WRITE HOR TEXT RAMTEK DEV.') ICSTR(1:51)='FIX SUBROUTINE GRWRTH TO WRITE HOR TEXT RAMTEK DEV.' NCSTR=51 CALL GRWRST(ICSTR,NCSTR,ISUBN0) GOTO9000 C C ****************************************************** C ** STEP 66-- ** C ** TREAT THE SUN CASE - WRITTEN BY BILL ANDERSON ** C ****************************************************** C 6600 CONTINUE NCSTR=0 C DO6610I=1,NCTEXT NCSTR=NCSTR+1 ICTEMP=ICTEXT(I) ICSTR(NCSTR:NCSTR)=ICTEMP(1:1) 6610 CONTINUE C CALL GRTRSD(PX1P,PY1P,IX1P,IY1P,ISUBN0) NCSTR=NCSTR+1 ITEMP=0 CALL DPCONA(ITEMP,ICSTR(NCSTR:NCSTR)) CSUN CALL cftext(IX1P,IY1P,ICSTR(1:NCSTR)) GOTO9000 C C ****************************************************** C ** STEP 71-- ** C ** TREAT THE XXXXXX XXXXXX CASE ** C ** TO WRITE A HORIZONTAL TEXT STRING-- ** C ** WRITE OUT AN XXXXXXXXXX ** C ** (NOT DONE) ** C ** REFERENCE--XX ** C ** XX ** C ** PAGES XX AND XX ** C ****************************************************** C 7100 CONTINUE CCCCC WRITE(IGUNIT,7111) C7111 FORMAT('FIX SUBROUTINE GRWRTH TO WRITE HOR TEXT XXXXXX DEV.') ICSTR(1:51)='FIX SUBROUTINE GRWRTH TO WRITE HOR TEXT XXXXXX DEV.' NCSTR=51 CALL GRWRST(ICSTR,NCSTR,ISUBN0) GOTO9000 C C ****************************************************** C ** STEP 22-- ** C ** TREAT THE DEC REGIS CASE ** C ** TO WRITE A HORIZONTAL TEXT STRING-- ** C ** USE THE P[ (= POSITION ) INSTRUCTION ** C ** ALONG WITH INTEGER COORDINATES, ** C ** WITH A TRAILING ] ** C ** AND THE T' (= TEXT) INSTRUCTION ** C ** AND THE DESIRED TEXT STRING, ** C ** AND ' TO DENOTE THE END OF TEXT STRING, ** C ** REFERENCE--VT125 GRAPHICS TERMINAL USER GUIDE ** C ** PAGES 118 AND 120 ** C ****************************************************** C C C MARCH, 1991. PACK OUTPUT. ALSO, REGIS DRAWS CHARACTER BELOW THE C CURSUR POSITION RATHER THAN ABOVE IT (AS DATAPLOT ASSUMES), SO HAVE C TO ADJUST VERTICAL POSITION ONE CHARACTER HEIGHT. C 8100 CONTINUE PY1P=PY1P+PHEIG2 CALL GRTRSD(PX1P,PY1P,IX,IY,ISUBN0) ICSTR(1:2)='P[' NCSTR=2 NCHTOT=5 CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR) ICSTR(8:8)=',' NCSTR=8 CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR) ICSTR(14:14)=']' NCSTR=14 IF(NCTEP1.GT.110)THEN CALL GRWRST(ICSTR,NCSTR,ISUBN0) NCSTR=0 END IF C NCTEP1=NCTEXT+1 ICTEXT(NCTEP1)='''' NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='T' NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='''' DO8112J=1,NCTEP1 K=J+NCSTR ICSTR(K:K)=ICTEXT(J) 8112 CONTINUE NCSTR=K CALL GRWRST(ICSTR,NCSTR,ISUBN0) C 8190 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 86-- ** C ** TREAT THE POSTSCRIPT CASE ** C ** TO WRITE A HORIZONTAL TEXT STRING-- ** C ** XCOOR YCOOR MOVETO (NOTE: USE UNADJUSTED COOR)** C ** (STRING) SHOW ** C ** NOTE: RIGHTSHOW AND CENTSHOW ARE DATAPLOT ** C ** DEFINED PROCEDURES TO RIGHT AND CENTER ** C ** JUSTIFY STRINGS RESPECTIVELY ** C ** REFERENCE--POSTSCRIPT TUTORIAL AND COOKBOOK ** C ** FROM ADOBE SYSTEMS ** C ** FIRST SET FONT IF REQUIRED ** C ** CHECK FOR FOLLOWING CHARACTERS AND IF FOUND ** C ** PRECEDE WITH A BACKSLASH ** C ** "(", ")", AND BACKSLASH ** C ****************************************************** C C 8600 CONTINUE IPSTPS=INT(JHEIG2+0.5) IF(IPSTFN.EQ.IPSTFC.AND.IPSTPC.EQ.IPSTPS)GOTO8605 C FOLLOWING CODE MODIFIED OCTOBER 1991. IJUNK=7 DO8695I=1,IPSTMF IF(IPSTFN.NE.IPSTT1(I))GOTO8695 IJUNK=I GOTO8697 8695 CONTINUE 8697 CONTINUE ICSTR(1:1)='/' ICSTR(2:41)=IPSTT2(IJUNK)(1:40) ICSTR(42:51)=' findfont ' NCHTOT=5 NCSTR=51 CALL GRTRIN(IPSTPS,NCHTOT,ICSTR,NCSTR) NCSTR=NCSTR+1 NCSTR2=NCSTR+17 ICSTR(NCSTR:NCSTR2)=' scalefont setfont' NCSTR=NCSTR2 CALL GRWRST(ICSTR,NCSTR,ISUBN0) CCCCC ICSTR(1:33)='/Times-Roman findfont ' CCCCC IF(IPSTFN.EQ.'TBOL') CCCCC1ICSTR(1:23)='/Times-Bold ' CCCCC IF(IPSTFN.EQ.'TITA') CCCCC1ICSTR(1:23)='/Times-Italic ' CCCCC IF(IPSTFN.EQ.'TBIT') CCCCC1ICSTR(1:23)='/Times-BoldItalic ' CCCCC IF(IPSTFN.EQ.'HELV') CCCCC1ICSTR(1:23)='/Helvetica ' CCCCC IF(IPSTFN.EQ.'HELB') CCCCC1ICSTR(1:23)='/Helvetica-Bold ' CCCCC IF(IPSTFN.EQ.'HELO') CCCCC1ICSTR(1:23)='/Helvetica-Oblique ' CCCCC IF(IPSTFN.EQ.'HEBO') CCCCC1ICSTR(1:23)='/Helvetica-BoldOblique ' CCCCC IF(IPSTFN.EQ.'COUR') CCCCC1ICSTR(1:23)='/Courier ' CCCCC IF(IPSTFN.EQ.'CBOL') CCCCC1ICSTR(1:23)='/Courier-Bold ' CCCCC IF(IPSTFN.EQ.'COBL') CCCCC1ICSTR(1:23)='/Courier-Oblique ' CCCCC IF(IPSTFN.EQ.'CBOB') CCCCC1ICSTR(1:23)='/Courier-BoldOblique ' CCCCC NCSTR=33 CCCCC NCHTOT=5 CCCCC CALL GRTRIN(IPSTPS,NCHTOT,ICSTR,NCSTR) CCCCC ICSTR(39:56)=' scalefont setfont' CCCCC NCSTR=56 CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0) C C END OF CHANGE IPSTFC=IPSTFN IPSTPC=IPSTPS C 8605 CONTINUE CCCCC 6 LINES IN THE FOLLOWING SECTION WERE FIXED MAY 1991 (ALAN) CCCCC ICSTR(1:3)='/IX ' ICSTR(1:4)='/IX ' CCCCC NCSTR=3 NCSTR=4 CALL GRTRSD(PX1,PY1P,IX,IY,ISUBN0) NCHTOT=5 CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR) CCCCC ICSTR(9:17)=' def /IY ' ICSTR(10:18)=' def /IY ' CCCCC NCSTR=17 NCSTR=18 CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR) CCCCC ICSTR(23:26)=' def' ICSTR(24:27)=' def' CCCCC NCSTR=26 NCSTR=27 CALL GRWRST(ICSTR,NCSTR,ISUBN0) C ICSTR(1:1)='(' NCSTR=1 DO8612J=1,NCTEXT CCCCC THE FOLLOWING LINE WAS FIXED (SOFT-CODE BACKSLASH) APRIL 1989 IF(ICTEXT(J).NE.'('.AND.ICTEXT(J).NE.')'.AND.ICTEXT(J).NE.IBASLC) * GOTO8613 NCSTR=NCSTR+1 CCCCC THE FOLLOWING LINE WAS FIXED (SOFT-CODE BACKSLASH) APRIL 1989 ICSTR(NCSTR:NCSTR)=IBASLC 8613 CONTINUE NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=ICTEXT(J) 8612 CONTINUE NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=')' CALL GRWRST(ICSTR,NCSTR,ISUBN0) IF(IJUST(1:1).EQ.'L')ICSTR(1:9)='leftshow ' IF(IJUST(1:1).EQ.'C')ICSTR(1:9)='centshow ' IF(IJUST(1:1).EQ.'R')ICSTR(1:9)='rightshow' NCSTR=9 CALL GRWRST(ICSTR,NCSTR,ISUBN0) GOTO9000 C C ****************************************************** C ** STEP 89-- ** C ** TREAT THE DISPLAY POSTSCRIPT DRIVER ** C ****************************************************** C 8900 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 91-- ** C ** TREAT THE QUIC CASE ** C ** TO WRITE A HORIZONTAL TEXT STRING-- ** C ** MOVE: ^IHXXXXX^IVXXXXX ** C ** SET DEFAULT FONT:^ISXXXXX ** C ** SET FONT FOR CURRENT LINE: ^SMXXXXX ** C ** ENTER TEXT ** C ** REFERENCE--QUIC PROGRAMMING MANUAL FOR QMS ** C ** CHAPTER 7 DISCUSSES FONTS ** C ****************************************************** C C 9100 CONTINUE IFONTT=IQUIFN IF(IORNSW.EQ.'PORT'.AND.( 1IFONTT.EQ.521.OR. 1IFONTT.EQ.522.OR. 1IFONTT.EQ.523.OR. 1IFONTT.EQ.524))IFONTT=10 IF(IORNSW.NE.'PORT'.AND.( 1IFONTT.EQ.124.OR. 1IFONTT.EQ.144.OR. 1IFONTT.EQ.16.OR. 1IFONTT.EQ.328.OR. 1IFONTT.EQ.998.OR. 1IFONTT.EQ.404.OR. 1IFONTT.EQ.444.OR. 1IFONTT.EQ.532))IFONTT=10 CALL DPCONA(94,ICARAT) IF(IFONTT.EQ.IQUIFC)GOTO9105 ICSTR(1:1)=ICARAT ICSTR(2:3)='IS' IQUIFC=IFONTT KFONT=IFONTT NCHTOT=-5 NCSTR=3 CALL GRTRIN(KFONT,NCHTOT,ICSTR,NCSTR) NCSTR=8 CALL GRWRST(ICSTR,NCSTR,ISUBN0) C 9105 CONTINUE PYTEMP=100.-PY1P CALL QUICPT(PX1P,PYTEMP,IX,IY,ISUBN0) ICSTR(1:1)=ICARAT ICSTR(2:3)='IH' NCSTR=3 NCHTOT=-5 CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR) ICSTR(9:9)=ICARAT ICSTR(10:11)='IV' NCSTR=11 CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR) NCSTR=16 C DO9112J=1,NCTEXT K=J+NCSTR ICSTR(K:K)=ICTEXT(J) 9112 CONTINUE NCSTR=K CALL GRWRST(ICSTR,NCSTR,ISUBN0) C 9190 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 96-- ** C ** TREAT THE X11 CASE ** C ** NOTE THAT JUSTIFICATION, POSITIONING, ETC. IS ** C ** HANDLED BY THE C ROUTINE. ALSO, THE CHARACTER ** C ** STRING IS PASSED TO C AS AN INTEGER ARRAY ** C ** CONTAINING THE ASCII DECIMAL EQUIVALENTS ** C ****************************************************** C C 9600 CONTINUE IF(IX11OF.EQ.'OFF')GOTO9699 C CALL GRTRSD(PX1,PY1,IX,IY,ISUBN0) C DO9605I=1,NCTEXT IC1=ICTEXT(I)(1:1) CALL DPCOAN(IC1,IJUNK) STRING(I)=IJUNK 9605 CONTINUE STRING(NCTEXT+1)=0 C ILAST=80 DO9610I=80,1,-1 ILAST=I IF(IX11FN(I:I).NE.' ')GOTO9619 9610 CONTINUE 9619 CONTINUE DO9620I=1,ILAST CALL DPCOAN(IX11FN(I:I),IJUNK) IADE(I)=IJUNK 9620 CONTINUE IADE(ILAST+1)=0 C CALL XTATTR(IADE,IXERR) IF(IXERR.EQ.1) THEN WRITE(ICOUT,9621) 9621 FORMAT(1X,'WARNING: X11 FONT NAME NOT FOUND--USE CURRENT FONT') CALL DPWRST('XXX','BUG ') ELSEIF(IXERR.EQ.2)THEN WRITE(ICOUT,9622) 9622 FORMAT(1X,'WARNING: X11 FONT NAME NOT FOUND--USE DEFAULT FONT') CALL DPWRST('XXX','BUG ') END IF C IFONTH=0 IFONTV=0 IF(IJUST.EQ.'LEFT')IFONTH=0 IF(IJUST.EQ.'CENT')IFONTH=1 IF(IJUST.EQ.'RIGH')IFONTH=2 IF(IJUST.EQ.'LJUS')IFONTH=0 IF(IJUST.EQ.'CJUS')IFONTH=1 IF(IJUST.EQ.'RJUS')IFONTH=2 IF(IJUST.EQ.'LEBO')IFONTH=0 IF(IJUST.EQ.'CEBO')IFONTH=1 IF(IJUST.EQ.'RIBO')IFONTH=2 IF(IJUST.EQ.'LECE')IFONTH=0 IF(IJUST.EQ.'CECE')IFONTH=1 IF(IJUST.EQ.'RICE')IFONTH=2 IF(IJUST.EQ.'LETO')IFONTH=0 IF(IJUST.EQ.'CETO')IFONTH=1 IF(IJUST.EQ.'RITO')IFONTH=2 IF(IJUST.EQ.'LEFT')IFONTV=1 IF(IJUST.EQ.'CENT')IFONTV=1 IF(IJUST.EQ.'RIGH')IFONTV=1 IF(IJUST.EQ.'LJUS')IFONTV=1 IF(IJUST.EQ.'CJUS')IFONTV=1 IF(IJUST.EQ.'RJUS')IFONTV=1 IF(IJUST.EQ.'LEBO')IFONTV=1 IF(IJUST.EQ.'CEBO')IFONTV=1 IF(IJUST.EQ.'RIBO')IFONTV=1 IF(IJUST.EQ.'LECE')IFONTV=0 IF(IJUST.EQ.'CECE')IFONTV=0 IF(IJUST.EQ.'RICE')IFONTV=0 IF(IJUST.EQ.'LETO')IFONTV=2 IF(IJUST.EQ.'CETO')IFONTV=2 IF(IJUST.EQ.'RITO')IFONTV=2 IXERR=0 CALL XTEXTH(STRING,IX,IY,IFONTH,IFONTV,IXERR) C 9699 CONTINUE C GOTO9000 C CCCCC THE FOLLOWING SECTION WAS ADDED MAY 1991 (JJF) CCCCC AND REFIXED SEPTEMBER 1995 C ************************************************* C ** STEP 100-- ** C ** TREAT THE VGA VIA TURBO-C CASE ** C ** REFERENCE--TURBO C 1.5 ADDITIONS & ** C ** ENHANCEMENTS, PAGE 124, 113. ** C ** REFERENCE--TURBO C 2.0 REFERENCE GUIDE, ** C ** PAGE 324-325, 256. ** C ** REFERENCE--WEISKAMP, POWER GRAPHICS ** C ** USING TURBO C, PAGE 59-60, 54-55** C ************************************************* C 10000 CONTINUE IF(ITCST.EQ.'CLOS')GOTO10099 C CCCCC THE FOLLOWING 2 LINES OF CODE WERE REPLACED SEPTEMBER 1994 CCCCC BY THE SUBSEQUENT 7 LINES OF CODE SEPTEMBER 1994 CCCCC TO FIX C-SIDE MULTIPLOTTING NOT WORKING SEPTEMBER 1994 C CCCCC CALL TCMOTO(PX1,PY1) CCCCC CALL TCWRTE(ICTEXT,NCTEXT) C IF(NCTEXT.LE.0)GOTO10099 c CCCCC SEE COMMENTS FOR GENERAL CODED (STEP 32) FOR NEXT 2 LINES C CCCCC THE FOLLOWING 2 LINES WAS CHANGED JANUARY 1995 CCCCC TO FIX THE TIC JUSTIFICATION PROBLEM JANUARY 1995 CCCCC IF(IJUSSW.EQ.'ON')PX1P=PX1 CCCCC IF(IJUSSW.EQ.'ON')PY1P=PY1 PX1P=PX1 PY1P=PY1 CALL GRTRSA(PX1P,PY1P,AX,AY,ISUBN0) PX1P=AX PY1P=AY CALL TCMOTO(PX1P,PY1P) CALL TCWRTE(ICTEXT,NCTEXT) C 10099 CONTINUE C GOTO9000 C C ****************************************************** C ** STEP 110-- ** C ** TREAT THE GKS DRIVER ** C ****************************************************** C 11000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 120-- ** C ** TREAT THE GD DRIVER ** C ** THIS LIBRARY PROVIDES SUPPORT FOR: ** C ** 1) JPEG ** C ** 2) PNG ** C ** 3) WINDOWS BMP (BLACK/WHITE ONLY) ** C ** TREAT THE PBM (PORTABLE BIT MAP) DRIVER ** C ****************************************************** C 12000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 130-- ** C ** TREAT THE MACINTOSH DRIVER ** C ** LIBRARY FROM ABSOFT COMPILER ** C ****************************************************** C 13000 CONTINUE GOTO9000 C C ****************************************************** C ** STEP 135-- ** C ** TREAT THE MAC OSX AQUATERM DRIVER ** C ****************************************************** C 13500 CONTINUE IF(JJUST.EQ.1)THEN IAQJUS=8+0 ELSEIF(JJUST.EQ.2)THEN IAQJUS=8+1 ELSEIF(JJUST.EQ.3)THEN IAQJUS=8+2 ELSEIF(JJUST.EQ.4)THEN IAQJUS=0 + 0 ELSEIF(JJUST.EQ.5)THEN IAQJUS=0+1 ELSEIF(JJUST.EQ.6)THEN IAQJUS=0+2 ELSEIF(JJUST.EQ.7)THEN IAQJUS=16 + 0 ELSEIF(JJUST.EQ.8)THEN IAQJUS=16 + 1 ELSEIF(JJUST.EQ.9)THEN IAQJUS=16 + 2 ELSE IAQJUS=8 ENDIF AROT=0.0 CAQUA aqtAddLabel(ICTEXT(1:NCTEXT),PX1,PY1,AROT,IAQJUS) GOTO9000 C C ****************************************************** C ** STEP 140-- ** C ** TREAT THE PC PRINTER DRIVER ** C ****************************************************** C 14000 CONTINUE GOTO9000 C C C ****************************************************** C ** STEP 150-- ** C ** TREAT THE LATEX (USING EEPIC) DRIVER ** C ****************************************************** C 15000 CONTINUE CALL GRTRSD(PX1,PY1P,IX,IY,ISUBN0) ICSTR(1:1)=IBASLC ICSTR(2:5)='put(' NCSTR=5 NCHTOT=5 CALL GRTRIN(IX,NCHTOT,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=',' CALL GRTRIN(IY,NCHTOT,ICSTR,NCSTR) NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR+15)='){ makebox(0,0)[' ICSTR(NCSTR+2:NCSTR+2)=IBASLC NCSTR=NCSTR+15 C IF(IJUSTV.EQ.'CENT')THEN NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='c' ELSEIF(IJUSTV.EQ.'BOTT')THEN NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='b' ELSEIF(IJUSTV.EQ.'TOP ')THEN NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='t' ENDIF C IF(IJUSTH.EQ.'CENT')THEN NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='c' ELSEIF(IJUSTH.EQ.'LEFT')THEN NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='l' ELSEIF(IJUSTH.EQ.'RIGH')THEN NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='r' ENDIF NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)=']' CCCCC CALL GRWRST(ICSTR,NCSTR,ISUBN0) C DO15110J=1,NCTEXT ICSTR2(J:J)=ICTEXT(J)(1:1) 15110 CONTINUE MAXWID=130 CALL LATCON(ICSTR2,NCTEXT,ICSTR3,NCTEX2,MAXWID,ISUBRO,IERROR) C NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR)='{' ICNT=NCSTR DO15120J=1,NCTEX2 ICNT=ICNT+1 ICSTR(ICNT:ICNT)=ICSTR3(J:J) 15120 CONTINUE NCSTR=ICNT NCSTR=NCSTR+1 ICSTR(NCSTR:NCSTR+1)='}}' NCSTR=NCSTR+1 CALL GRWRST(ICSTR,NCSTR,ISUBN0) GOTO9000 C C ****************************************************** C ** STEP 160-- ** C ** TREAT THE SVG (SCALABLE VECTOR GRAPHICS) DRIVER ** C ****************************************************** C 16000 CONTINUE C CALL GRTRSD(PX1,PY1P,IX,IY,ISUBN0) C CALL DPCONA(34,IQUOTE) C ICSTR(1:11)='