Title :NGRAPH Keywords :GRAPHICS>Computer :DEC VAX 11/730-785, DEC PDP 11/2-11/73%Operating System :VAXVMS, RT-11"Programming Language :Fortran IVJHardware Requirements :TEKTRONICS 4010 terminal or an EQUIVALENT emulator)Author(s) :Nestor J. ZaluzecPCorrespondence Address :Argonne Nat. Lab, Electron Microscopy Center, Bldg 212P :Materials Science Division, Argonne, Illinois 60439, USA Abstract: PThis subroutine library provides graphics functions for Tektronics 4010-1Pterminals and/or their emulators. The current terminals supported are:PTektronics 4010-1,4014-1, Lear Siegler ADM-3,ADM-5 (with Retrographics RG-512)PPeritek VCG-512 bit map color graphics, Tektronics 4027, HP 7470A/7475A plottersPDEC LA100/LA50 printers, Intecolor VT-100 with TEK 4010-1,4014-1, 4027 modes,PDEC VT-200 with 4010-1,4014-1 mode, Tektronics 4105/4107 with VT-100 mode,PPlessey VT-100/TEK 4010-1, Espirit VT-100/TEK 4010-1, Tektronics 4695 Copier.PThe computer program NGTEST is a fortran demonstration program which exercisesPthis graphics package. The purpose of this graphics library is to provide aPstandard set of routine for producing x-y plots of XEDS and EELS data for theEanalysis programs NEDS, NELS and graphics for plotting CBED patterns.K---------------------------------------------------------------------------CTitle :NGRAPH (Subroutine Library) - Documentation Keywords :GRAPHICS>Computer :DEC VAX 11/730-785, DEC PDP 11/2-11/73%Operating System :VAXVMS, RT-11"Programming Language :Fortran IVHardware Requirements :None)Author(s) :Nestor J. ZaluzecPCorrespondence Address :Argonne Nat. Lab, Electron Microscopy Center, Bldg 212P :Materials Science Division, Argonne, Illinois 60439, USA$Description: Start on the 10th line> Outline/Description and the purpose of the code. References: A Operating Instructions for Tektronics 4010 terminals supplied by the manufacturer. Compilation Procedure: Using VAX-Fortran compiler 1. Rename file to NGRAPH.FOR6 2. At DCL prompt type FORTRAN/EXTEND/NOF77 NGRAPH.FOR Using RT-11 Fortran IV compiler 1. Rename file to NGRAPH.FOR; 2. At RT-11 prompt type FORTRAN/EXTEND/WARNINGS NGRAPH.FOR Linking Procedure: ; Include the object module NGRAPH.OBJ in your standard link; procedure for example when linking the NGRAPH library into> the main program NGTEST you would use the following procedure Using VAX-Linker) 1. At DCL prompt type LINK NGTEST,NGRAPH Using RT-11 Linker+ 1. At RT-11 prompt type LINK NGTEST,NGRAPH Test Data: ? None, this routine generates graphics plots no data available General Comments: A To run the demonstration program type RUN NGTEST upon receipt of the system ready prompt. < NOTE: If NGRAPH is to be used with smaller computer systems< such as PDP 11's it may be necessary to divide the routines> up into an overlay structure to allow for swapping on and off< the disk an example of an overlay structure which will work is given below. @ The NGRAPH library requires the existance of a data file called@ TERMIN.DAT on the default storage device named DAT:. This file? is called by the subroutine TERMIN, which attempts to read the? terminal type currently in use. If the file doesnot exist the@ library will default to a TEKTRONICS 4010-1 terminal, operating< at 9600 baud, with no hardcopy device. The user is allowedA to change the terminal type through access of the TERMIN routine< see the program NGTEST for an example. The following is an= example of the format of the TERMIN.DAT file, only the first8 three lines are required, please note that the comments@ begining each of the first three lines are both spacers as well= reminders as to the function of the parameters on each line.GRAPHICS TERMINAL TYPE:8BAUD RATE FOR GRAPHICS:9600HARDCOPY DEVICE TYPE:5;C --------------------------------------------------------C TERMINAL DEFINITIONS:C ---------------------KC -3 = ASCII TERMINAL: NO GRAPHICS, & NO VT-100 compatibility & <32 COLUMNS=C -2 = ASCII TERMINAL: NO GRAPHICS, & NO VT-100 compatibility?C -1 = ANSI X3.4 ASCII TERMINAL: NO GRAPHICS, VT-100 compatible6C 0 = TEKTRONICS 4010-1,4014-1 (WITH HARDWARE CURSOR)4C 1 = TEKTRONICS 4006 ,4010 (NO HARDWARE CURSOR);C 2 = LEAR SIEGLER ADM-3,ADM-5 (WITH RETROGRAPHICS RG-512)-C 3 = PERITEK VCG-512 BIT MAP COLOR GRAPHICSC 4 = TEKTRONICS 4027&C 5 = HP 7470A/7475A HARDCOPY PLOTTER#C 6 = LA100/LA50 HARDCOPY GRAPHICS/C 7 = INTECOLOR VT-100 with 4010-1,4014-1 mode&C 8 = INTECOLOR VT-100 with 4027 mode)C 9 = DEC VT-200 with 4010-1,4014-1 mode:C 10 = TEKTRONICS 4105/4107 with VT-100 compatibility mode C 11 = PLESSEY VT-100/TEK 4010-1 C 12 = ESPIRIT VT-100/TEK 4010-13C 13 = TEKTRONICS 4010-1 HARDCOPY VIDEO TO VERSATIC#C 14 = TEKTRONICS 4695 Color Copier;C ---------------------------------------------------------C BAUD RATE RANGE FOR GRAPHICS (110 - 19200);C --------------------------------------------------------CC Title :NGRAPH (Subroutine Library)- Source Code"C Keywords :Graphics@C Computer :DEC VAX 11/730-785, DEC PDP 11/2-11/73'C Operating System :VAXVMS, RT-11$C Programming Language :Fortran IVC Hardware Requirements :None+C Author(s) :Nestor J. ZaluzecRC Correspondence Address :Argonne Nat. Lab, Electron Microscopy Center, Bldg 212RC :Materials Science Division, Argonne, Illinois 60439, USA C Code:Start OC------------------------------------------------------------------------------CC VERSION DATE: 16 AUGUST 1991CBC GRAPHIC LIBRARY ROUTINES FOR DEC SYSTEMS USING TEK 4010 PROTOCOL@C routines are listed alphabetically, see demonstration program 8C NGTEST for an example of library usage, or examime theEC subroutine entitled CRT, which is the basic routine used to produce4C a complete labeled x-y plot on the TEK 4010 screenCCLC--------------------------------------------------------------------------- SUBROUTINE ADM5E(NL)LC---------------------------------------------------------------------------5 COMMON /TERMIN/ ITERM,IBAUD,IPLOT,ICOLOR,IMODE,IHARDCC CHECK TERMINAL TYPEC+ IF(ITERM.NE.2) RETURN !RETURN IF NOT ADM5CCCC2C SUBROUTINE TO ERASE BOTTOM PART OF ADM5 TERMINALCC FOR TEXT WRITING8C NOTE AT END OF TEXT LINE SETS MODE BACK TO WHITE!/C HENCE MUST RESET BLACK MODE BEFORE EACH WRITECC:C THIS ROUTINE ERASES #NL LINES STARTING AT Y POSTION =180C CALL PLOT(0.,180.,0) CALL DELAY(5) DO 1 I=1,NL CALL TOUT(27) CALL TOUT(127) WRITE(7,2) CALL DELAY(5) CALL TOUT(27) CALL TOUT(127) WRITE(7,3) CALL DELAY(5) CALL TOUT(27) CALL TOUT(127) WRITE(7,4) CALL DELAY(5) CALL TOUT(27) CALL TOUT(127) WRITE(7,5) CALL DELAY(5) 2 FORMAT(' ')3 FORMAT(1H+,72('#'))4 FORMAT(1H+,72('H'))5 FORMAT(1H+,72('I')) 1 CONTINUE& CALL TOUT(27) !SET DATA MODE TO WHITE CALL TOUT(97) CALL PLOT(0.,158.,0) RETURN ENDKC-------------------------------------------------------------------------- SUBROUTINE AXIS(ITYPE)LC---------------------------------------------------------------------------C4C THIS SUBROUTINE DRAWS X AND Y AXII BASED ON VALUES%C OBTAINED FROM THE OFFSET SUBROUTINE.C XL=LENGTH OF X AXIS IN ABSOLUTE SCREEN UNITS.C YL=LENGTH OF Y AXIS IN ABSOLUTE SCREEN UNITS%C ITYPE= TYPE OF AXIS 0=OPEN 1=CLOSEDC0C NOTE TIC MARKS ARE NOT DRAWN WITH THIS ROUTINECC6 COMMON /CRTLST/ XMIN,DX,YMIN,DY,OFFX,OFFY,XL,YL,XZ,YZ< COMMON /TERMIN/ ITERM,IBAUD,IPLOT,ICOLOR,IMODE,IHARD,ILP(3) XEND=OFFX+XL YEND=OFFY + YL CALL TOUT(29) CALL XYTRAN(XEND,OFFY) CALL XYTRAN(XEND,OFFY) CALL XYTRAN(OFFX,OFFY) CALL XYTRAN(OFFX,YEND) IF(ITYPE.EQ.0) GO TO 1 CALL XYTRAN(XEND,YEND) CALL XYTRAN(XEND,OFFY) 1 CONTINUE*C INSERT TIME DELAY FOR BAUD RATE PURPOSES CALL TOUT(31) CALL DELAY (5)/ IF(ITERM.EQ.5)REWIND 80 !DUMP STUFF TO PLOTTER; IF(ITERM.EQ.5) CALL DELAY(10)!LONG DELAY TIME FOR HARDCOPY RETURN ENDLC---------------------------------------------------------------------------= SUBROUTINE CRT (XA,YA,NPT,NMODE,IRPLT,XM,YM,SXA,SYA,NS)LC---------------------------------------------------------------------------C9C THIS IS THE GRAPHICS CONTROL SUBROUTINE WHICH WILL?C PRODUCE A COMPLETE GRAPH ON THE TEKTRONIX 4010-1 TERMINAL)C INCLUDING AXII,TIC MARKS AND LABELSCC<C NOW MODIFIED TO SUPPORT ALL TERMINAL DEFINED BY TERMIN.DATCCC 29-MAR-85 CLEAN UP SUBROUTINE CALL PUT MORE STUFF IN COMMON AREAS9C SO TERMINAL CHARACTERISTICS CAN BE SETUP DIFFERENTLYCC;C --------------------------------------------------------C TERMINAL DEFINITIONS:C)C SEE TERMIN SUBROUTINE FOR DOCUMENTATION;C ---------------------------------------------------------C BAUD RATE RANGE FOR GRAPHICS (110 - 19200);C --------------------------------------------------------C C C GRAPHICS DEFINITIONS C --------------------HC XZ= ORIGIN OF GRAPH (X AXIS) IN ABSOLUTE SCREEN UNITS (50.-1023.)GC YZ= " " (Y AXIS) " " " " (50.-770.)#C XA= ARRAY OF DATA FOR X AXIS#C YA= " " " " Y AXIS5C NPT= NUMBER OF POINTS IN XA & YA TO BE PLOTTEDC$C NMODE= DESCRIBES TYPE OF PLOT$C 0= DATA PLOTTED AS DOTS/C 1= DATA PLOTTED AS CONTINUOUS LINE?C -NMODE= DATA PLOTTED AS SYMBOL (I.E. NMODE IS NEGATIVE) C -1=SQUAREC -2=TRIANGLE C -3= X C -4= +C -5= HEXAGONC -6=DIAMONDC -7=STAR C -8=CIRCLE)C -9=BAR DOWN FROM DATA POINT TO X-AXIS C -10=DOTC#C IRPLT= SUPERPOSITION CONTROL7C 0= NEW GRAPH ERASE SCREEN AND DRAW AXII ETC3C 1= SUPERIMPOSE DATA ON TOP OF OLD GRAPH?C (USE SCALE FACTORS FROM LAST GRAPH FOR PLOTTING)4C XM=AUXILIARY MAGNIFICATION CHANGE (OVERRIDES EC CALCULATED SCALE FACTORS IF DIFFERENT FROM 1.0) X AXISC YM= AS XM BUT Y AXISFC SXA= DATA ARRAY USED TO SCALE X AXIS (CAN BE DIFFERENT FROM XA)C SYA= AS SXA BUT Y AXIS@C NS= NUMBER OF POINTS IN SXA & SYA TO BE USED FOR SCALING BC ILX= ARRAY CONTAINING THE LABEL FOR THE X AXIS (2 HOLLERITH,C CHARACTERS PER ARRAY ELEMENT)(C NILX= NUMBER OF CHARACTERS IN ILXDC ILY= ARRAY CONTAINING THE LABEL FOR THE Y AXIS (1 HOLLERITH +C CHARACTER PER ARRAY ELEMENT)(C NILY= NUMBER OF CHARACTERS IN ILYCCC$ DIMENSION XA(1),YA(1),SXA(1),SYA(1)6 COMMON /CRTLST/ XMIN,DX,YMIN,DY,OFFX,OFFY,XL,YL,XZ,YZ< COMMON /TERMIN/ ITERM,IBAUD,IPLOT,ICOLOR,IMODE,IHARD,ILP(3)! COMMON /LABEL/ ILX,ILY,NILX,NILYC.C TYPICAL LABELS FOR X & Y AXIS ARE SHOWN HERECC/C DATA ILX /'En','er','gy',' (','eV',') ',' '//C DATA ILY /'C ','o ','u ','n ','t ','s ',' '/ C NILX=14C NILY=7C)C RECOMMENDED OFFFSET PARAMETERS & SIZES!C GRAPH LENGTH X AXIS = 800 UNITS!C GRAPH LENGTH Y AXIS = 500 UNITS!C GRAPH OFFSET X AXIS = 150 UNITS!C GRAPH OFFSET Y AXIS = 250 UNITSC- IF(ITERM.LT.0) RETURN !NON-GRAPHICS TERMINAL( YZOLD=YZ !SAVE YZ AS INPUT BY OPERATOR7 IF(ITERM.EQ.4) YZ=50. !DEFAULT YZ OFFSET FOR 4027 MODE3 IF(ITERM.EQ.8) YZ=50. ! " " ": IF(ITERM.EQ.5) YZ=YZ+150. !SHIFT UP FOR HARDCOPY PLOTTINGCC&C CHECK FOR COLOR & 4027 TYPE TERMINALC8 ICHOZN=ICOLOR !STORE CHOZEN COLOR FOR FUTURE REFERENCEC !BY THIS ROUTINE ? CALL COLOR (ICHOZN) !FOR RT-11 OVERLAY MUST BE BEFORE STRTCRT6C !OTHERWISE TEXT QUESTIONS ARE IN 4010 INSTEAD1C !OF ANSI HAS TO DO WITH OVERLAY PROBLEMSCC SET UP THE GRAPHICS TERMINALCC CALL STRTCRTCCCCC CALCULATE SCALE FACTORSC CALL SCALE(XMIN,DX,NS,SXA,XL) CALL SCALE(YMIN,DY,NS,SYA,YL) DX=DX*XM DY=DY*YM) CALL OFFSET(XMIN,DX,YMIN,DY,XZ,YZ,XL,YL)CC CHECK FOR SUPERPOSITIONC IF (IRPLT.EQ.1) GO TO 2 CALL ERASECCC ALWAYS DRAW AXII & TICS IN WHITE THEN SWITCH BACK TO CHOZEN COLORC! CALL COLOR (0) !SWITCH TO WHITE CALL AXIS(1) CALL TICS0 CALL COLOR(ICHOZN) !SWITCH BACK TO CHOZEN COLORCC DRAW DATA C$ 2 IF(ITERM.EQ.5) CALL DELAY(10)0 IF((ITERM.EQ.4).OR.(ITERM.EQ.8)) CALL DELAY(10)% IF(NMODE.EQ.0) CALL POINT(NPT,XA,YA)* IF(NMODE.EQ.1) CALL LINE(NPT,XA,YA)C$C SYMBOL SIZE=8 UNLESS BAR IS CHOSENC SIZE=8.: IF(NMODE.EQ.-9) SIZE=XL/(NPT) !SPECIAL SIZE FOR BAR MODE # IF(NMODE.LT.0) NSYM=-1*NMODE6 IF(NMODE.LT.0) CALL SPOINT(NPT,XA,YA,NSYM,SIZE) CALL DELAY(5)CC CLOSE THE GRAPHICS TERMINALCC3 IF(IRPLT.EQ.0) CALL LABEL(ILX,NILX,ILY,NILY) CALL ENDCRT" YZ=YZOLD !RETURN OLD YZ FACTOR RETURN ENDJC------------------------------------------------------------------------- SUBROUTINE CHP7470 (IC)JC-------------------------------------------------------------------------C2C SUBROUTINE TO CHANGE PEN COLOR ON HP7470 PLOTTERC5 COMMON /TERMIN/ ITERM,IBAUD,IPLOT,ICOLOR,IMODE,IHARD IPEN=IC +1 IF(IPEN.EQ.0) IPEN=-2 WRITE(80,1000) IPEN IF(IPEN.GT.6) IPEN=11000 FORMAT(1X,'SP',I2) RETURN ENDLC--------------------------------------------------------------------------- SUBROUTINE COLOR (IC)LC---------------------------------------------------------------------------C7C THIS ROUTINE SETS UP THE COLOR MAP FOR THE TERMINALS C< COMMON /TERMIN/ ITERM,IBAUD,IPLOT,ICOLOR,IMODE,IHARD,ILP(3)C=C CHECK TERMINAL TYPE COLOR ONLY ON PERITEK, 4027, 4105/07/09C IF(ITERM.EQ.3) CALL CPERITEKC6C IF A 4027/4105 EMULATORS CAN CHANGE LINE COLORS HEREC, ANS=' ' !BLANK THE ANS(SWER) TO START UP%10 IF(ITERM.EQ.4) GO TO 11 !TEK 4027) IF(ITERM.EQ.8) GO TO 11 !INTECOLOR 4027) IF(ITERM.EQ.10) GO TO 11 !TEK 4105/07/09C4C TERMINAL DOES NOT SUPPORT COLOR GET OUT OF ROUTINEC RETURNC4C SET UP STANDARD COLOR SEQUENCE FOR TEKTRONICS MODEC11 IF(IC.GE.0) GO TO 35CFC IF USER SELECTS A NEGATIVE COLOR THEN HE WANTS A LIST TO CHOOSE FROMC WRITE(7,20)20 FORMAT($,' SELECT COLOR: 9 * WHITE,RED,GREEN,BLUE,YELLOW,CYAN,MAGENTA,DARK: ') READ(5,30) ANS30 FORMAT(1A1)35 CALL STRTCRTCCC 4027 TERMINAL COLOR SEQUENCECC4 IF((ITERM.EQ.4).OR.(ITERM.EQ.8)) CALL C4027(ANS,IC)CC 4105/07/09 TERMINAL SEQUENCEC$ IF(ITERM.EQ.10) CALL C4105(ANS,IC) CC DONE C 45 RETURN END CCJC------------------------------------------------------------------------- SUBROUTINE C4027 (ANS,IC)JC-------------------------------------------------------------------------C5C THIS SUBROUTINE PROVIDES THE COLOR MAP TRANSLATION #C FOR THE TEKTRONICS 4027 TERMINALSCC< COMMON /TERMIN/ ITERM,IBAUD,IPLOT,ICOLOR,IMODE,IHARD,ILP(3)CCC IF(IC.GE.0) GO TO 35C-C USER HAS SPECIFIED COLOR BY ASCII CHARACTERC IF(ANS.EQ.'W') ICOLOR=0 IF(ANS.EQ.'R') ICOLOR=1 IF(ANS.EQ.'G') ICOLOR=2 IF(ANS.EQ.'B') ICOLOR=3 IF(ANS.EQ.'Y') ICOLOR=4 IF(ANS.EQ.'C') ICOLOR=5 IF(ANS.EQ.'M') ICOLOR=6 IF(ANS.EQ.'D') ICOLOR=735 IF(IC.GE.0) ICOLOR=ICC.C NOW THAT WE KNOW THE COLOR TELL THE TERMINALC36 WRITE(7,40) ICOLOR40 FORMAT(' !COLOR C',I1) RETURN END CCCJC------------------------------------------------------------------------- SUBROUTINE CPERITEKJC-------------------------------------------------------------------------CC?C THIS SUBROUTINE SETSUP THE DEFAULT COLOR MAP FOR THE PERITEK C< COMMON /TERMIN/ ITERM,IBAUD,IPLOT,ICOLOR,IMODE,IHARD,ILP(3)CCC IF(ITERM.NE.3) RETURNCCC CALL CMAP(00,00,00,00) CALL CMAP(01,05,00,05) CALL CMAP(02,00,00,10) CALL CMAP(03,00,06,12) CALL CMAP(04,00,09,09) CALL CMAP(05,00,10,05) CALL CMAP(06,00,10,00) CALL CMAP(07,00,14,00) CALL CMAP(08,12,15,00) CALL CMAP(09,15,15,00) CALL CMAP(10,12,12,00) CALL CMAP(11,12,09,00) CALL CMAP(12,12,06,00) CALL CMAP(13,15,06,00) CALL CMAP(14,15,00,00) CALL CMAP(15,15,15,15) RETURN ENDKC-------------------------------------------------------------------------- SUBROUTINE C4105 (ANS,IC)KC--------------------------------------------------------------------------CC4C THIS SUBROUTINE PROVIDES THE COLOR MAP TRANSLATION)C FOR THE TEKTRONICS 4105/07/09 TERMINALSC5 COMMON /TERMIN/ ITERM,IBAUD,IPLOT,ICOLOR,IMODE,IHARDC#C SET COLOR MODE (HLS,OPAQUE,COLOR)C IF(ITERM.NE.10) RETURN CALL TOUT (27) !ESC CALL TOUT (84) !T CALL TOUT (77) !M CALL TOUT (51) !3 CALL TOUT (49) !1 CALL TOUT (49) !1C>C NOW TELL TERMINAL THE COLOR NOTE: TEK COLOR MAP IS DIFFERENTCC IF(ICOLOR.GE.0) GO TO 10C/C USER HAS REQUESTED A COLOR CODE BY TEXT INPUTC) ICR=1 !DEFAULT TO WHITE AT A MINIMUM IF(ANS.EQ.'W'.OR.IC.EQ.0) ICR=1 IF(ANS.EQ.'R'.OR.IC.EQ.1) ICR=2 IF(ANS.EQ.'G'.OR.IC.EQ.2) ICR=3 IF(ANS.EQ.'B'.OR.IC.EQ.3) ICR=4 IF(ANS.EQ.'Y'.OR.IC.EQ.4) ICR=7 IF(ANS.EQ.'C'.OR.IC.EQ.5) ICR=5 IF(ANS.EQ.'M'.OR.IC.EQ.6) ICR=6 IF(ANS.EQ.'D'.OR.IC.EQ.7) ICR=0C-C NOW STORE THE RESULT IF INPUT WAS VIA "ANS"C IF(ANS.EQ.'W') ICOLOR=0 IF(ANS.EQ.'R') ICOLOR=1 IF(ANS.EQ.'G') ICOLOR=2 IF(ANS.EQ.'B') ICOLOR=3 IF(ANS.EQ.'Y') ICOLOR=4 IF(ANS.EQ.'C') ICOLOR=5 IF(ANS.EQ.'M') ICOLOR=6 IF(ANS.EQ.'D') ICOLOR=7C?C IF IC>0 THEN USER HAS SPECIFIED THE COLOR USING TEK 4027 STND"C WE MUST TRANSLATE FOR 4105/07/09CC10 IF(ICOLOR.GE.0) IC=ICOLOR'C IF((IC.GE.0).AND.(IC.LE.3)) ICR=IC +1C IF(IC.EQ.5) ICR=5C IF(IC.EQ.6) ICR=6C IF(IC.EQ.7) ICR=0C IF(IC.EQ.4) ICR=7CAC ADD ASCII DECIMAL EQUIVALENT OF ZERO (=48) AND SEND TO TERMINALC ITEK=ICR + 48 CALL TOUT (27) !ESC CALL TOUT (77) !M CALL TOUT (76) !L= CALL TOUT (ITEK) !COLOR NUMERIC VALUE 0-15 ASCII ADE 48 - 56 RETURN ENDLC--------------------------------------------------------------------------- SUBROUTINE CRSSHR(X,Y)LC---------------------------------------------------------------------------C*C THIS SUBROUTINE LIGHTS UP THE CROSSHAIR 3C POSITION THE CROSSHAIR BY MOVING THE THUMBWHEELS >C ON THE TERMINAL THEN STRIKE ANY PRINTING KEY (OR HIT RETURN)BC THE VALUE OF THE ABSOLUTE SCREEN COORDINATE ARE THEN TRANSMITTED C TO X & YC X=X AXIS ABSOLUTE COORDINATEC Y=Y AXIS ABSOLUTE COORDINATE CALL TOUT(27) CALL TOUT(26)% CALL TINPUT(IC,IHX,ILX,IHY,ILY) CALL TOUT(31) DO 1 II=1,100 1 B=II+1.1C X=32*(IHX-160)+(ILX-160) !ORIGINAL 4010-1 0C Y=32*(IHY-160)+(ILY-160) !ORIGINAL 4010-1CC X=X+4224.0 !INTECOLOR TERMINAL ADDS EXTRA BITS MUST SUBTRACT 42248C Y=Y+4224.0 !TO GET CORRECT ABSOLUTE SCREEN COORDINATES, X=32*(IHX-32)+(ILX-32) !INTECOLOR 4010, Y=32*(IHY-32)+(ILY-32) !INTECOLOR 4010 CALL TOUT(31) C WRITE(8,2) IHX,ILX,IHY,ILY,X,YGC2 FORMAT(' IHX=',I4,'ILX=',I4,'IHY=',I4,'ILY=',I4,'X,Y=',2(1X,1F10.3)) RETURN ENDLC--------------------------------------------------------------------------- SUBROUTINE CRSSPT(X,Y)LC---------------------------------------------------------------------------5 COMMON /TERMIN/ ITERM,IBAUD,IPLOT,ICOLOR,IMODE,IHARDC<C THIS ROUTINE REPLACES THE CRSSHR ROUTINE WHICH IS NORMALLY@C USED WITH THE 4010-1 TERMINAL BY A BLINKING SPOT ON THE SCREEN(C FOR 4010,4006,ADM3, AND ADM5 TERMINALSBC NOTE: AS THE DOT GOES THROUGH DATA IT ERASES IT FROM THE DISPLAY"C BUT NOT FROM THE DATA BASE ARRAYC1C IF TERMINAL = PERITEK THE NATIVE CURSOR IS USEDCC@C THE VALUES RETURNED ARE THE ABSOLUTE SCREEN COORDINATES OF THEAC BLINKING DOT AFTER THE OPERATOR ENTERS A (CARRIAGE RETURN)C<C THIS ROUTINE USES THE CURSOR CONTROL FEATURES OF THE ADM5 9C TO MOVE THE DOT I.E. THE ARROWS NEXT TO THE HOME BUTTON5C THEIR ASCII DECIMAL VALUES ON INPUT ARE AS FOLLOWS:C UP=11 C DOWN=10 C LEFT=8C RIGHT=12=C TO MODIFY THESE, TO USE THE CHARACTERS 'U','D','L','R' FOR 6C UP,DOWN,LEFT, RIGHT REPECTIVELY CHANGE THE FOLLOWINGC 11 TO 85 (CAPTIAL U)C 10 TO 68 (CAPTIAL D)C 8 TO 76 (CAPTIAL L)C 12 TO 82 (CAPTIAL R)C IN LINES 2,3,4,5 REPECTIVELYFC THE CURRENT VERSION ALLOWS THE USE OF EITHER MODE FOR CURSOR CONTROLCC<C NOTE: THIS ROUTINE WILL NOT WORK ON A NORMAL 4010 TERMINAL<C TYPE OF CRSSHR USED IS DETERMINED BY TERMINAL MODE (ITERM)CCC CHECK FOR TERMINAL TYPEC. IF(ITERM.LT.0) RETURN !NON-GRAPHICS TERMINAL CALL STRTCRT !TURN ON GRAPHICS< IF(ITERM.EQ.0) CALL CRSSHR(X,Y) !TURN ON 4010-1 CURSOR MODE; IF(ITERM.EQ.0) GO TO 99 !GET OUT OF ROUTINE IF 4010-1 TERM4 IF(ITERM.EQ.3) CALL GCRS(5) !TURN ON PERITEK CURSOR9 IF(ITERM.GE.4) CALL CRSSHR(X,Y) !4027 OR 4010-1 EMULATOR IF(ITERM.GE.4) GO TO 99C?C IF 4010-1 OPTION IS USED REST OF THIS ROUTINE IS BYPASSED!!!!'C AND THE HARD WARE CURSOR WILL OPERATECCCCC)C READ VALUE OF JSW AT LOC"44 AND SAVE ITC IVALUE=IPEEK("44)C 9C CHANGE BIT 12 OF JSW TO 1 ("10000=4096=2**12) BY OR-INGC IT WITH THE CURRENT CONTENTSC% CALL IPOKE("44,"10000.OR.IPEEK("44))# CALL IPOKE("44,"100.OR.IPEEK("44)) X=512. Y=390.C-C CHANGE PLOT MODE SO CURSOR WILL NOT BE SEENC SEE PLOT SUBROUTINE FOR THIS C1 CALL TOUT(29)- CALL XYTRAN(X,Y) !MOVE TO POINT AND PLOT IT = IF(ITERM.NE.3) CALL XYTRAN(X,Y) !DONOT PLOT POINT IF PERITEK I=ITTINR(0) DIRX=0. DIRY=0.62 IF(I.EQ.10) DIRY=-1. !ALLOW LF (DOWN ARROW) FOR DOWN' IF(I.EQ.68) DIRY=-1. !ALLOW D FOR DOWN&3 IF(I.EQ.11) DIRY=+1. !ALLOW ^ FOR UP% IF(I.EQ.85) DIRY=+1. !ALLOW U FOR UP+4 IF(I.EQ.12) DIRX=+1. !ALLOW --> FOR RIGHT( IF(I.EQ.82) DIRX=+1. !ALLOW R FOR RIGHT*5 IF(I.EQ.8) DIRX=-1. !ALLOW <-- FOR LEFT' IF(I.EQ.76) DIRX=-1. !ALLOW L FOR LEFTCC ERASE OLD POINT4C SEE RETRO-GRAPHICS INSTRUCTIONS FOR ERASING POINTSBC THIS HAS NO EFFECT ON PERITEK MODE SO NO NEED TO CHECK TERM TYPEC CALL TOUT(27)! CALL TOUT(127) !ENTER BLACK MODE CALL TOUT(29) CALL XYTRAN(X,Y)7 IF(ITERM.NE.3) CALL XYTRAN(X,Y)!DONOT PLOT IF PERITEK CALL TOUT(27)% CALL TOUT(97) !RETURN TO WHITE MODECC CALCULATE NEW COORDINATESC X=X+DIRX Y=Y+DIRY$ IF(I.EQ.13) GO TO 6 ! ENDS LOOP GO TO 16 CALL TOUT(31)6 IF(ITERM.EQ.3) CALL GCRS(-1) !TURN OFF PERITEK CURSORCC RETURN JSW TO PREVIOUS VALUEC CALL IPOKE("44,IVALUE)99 CALL ENDCRT RETURN ENDLC---------------------------------------------------------------------------' SUBROUTINE DECLBL(YMIN,YMAX,XMIN,XMAX)LC---------------------------------------------------------------------------CC?C THIS SUBROUTINE PRDUCES A AXIS LABEL AT THE TOP OF THE SCREEN*C FOR OPERATION IN A DEC VT-200/4010 MODE DC SINCE DEC DOES NOT USE STANDARD TEK 4010 SIZE CHARACTERS WE CANNOT@C POSITION THEM RELATIVE TO THE X&Y AXII AND CALCULATE WHERE TO (C PUT THEM BASED ON TEK SIZE COORDINATESCCCCC DEC VT-200 LABELSCC! WRITE(7,300) YMIN,YMAX,XMIN,XMAX-300 FORMAT(' COUNTS/MIN:MAX = ',2(1PE9.2,1X),, * 'ENERGY(EV)/MIN:MAX = ',2(0PF7.2,1X)) RETURN END KC-------------------------------------------------------------------------- SUBROUTINE DELAY(N)LC---------------------------------------------------------------------------5 COMMON /TERMIN/ ITERM,IBAUD,IPLOT,ICOLOR,IMODE,IHARDCC'C TIME DELAY FOR BAUD RATE PURPOSESC NULL=08 NT=100.*IBAUD/4800. !SCALE # TIME IN LOOP TO BAUD RATE B=0. DO 1 J=1,N!C IF(ITERM.EQ.5) WRITE(8,10) NULL DO 1 II=1,NT 1 B= II*II 10 FORMAT(A1) RETURN ENDKC-------------------------------------------------------------------------- SUBROUTINE ENDCRTLC---------------------------------------------------------------------------CC?C THIS SUBROUTINE SHUTS DOWN THE GRAPHICS DEVICE AND ALLOWS THE>C USER TO COMMUNICATE WITH THE PROGRAM USING A SCROLLING ASCII<C CHARACTER STRING AT THE BOTTOM OF THE SCREEN TO RETURN TO ?C TRUE VT-100 MODE USE THE VT100 SUBROUTINE WHICH IS A SUPERSETC OF THIS ROUTINECCC C COMMON BLOCKS FOR NELSCC5 COMMON /TERMIN/ ITERM,IBAUD,IPLOT,ICOLOR,IMODE,IHARDCCC IMODE=ITERMA IF(ITERM.EQ.2) CALL ENLSIRG !EXIT LSI/ADM RETROGRAPHICS TO ASCII% IF(ITERM.EQ.5) CALL ENDHP !EXIT HP( IF(ITERM.EQ.6) CALL ENDLA !EXIT LA1006 IF(ITERM.EQ.7) CALL ENI4010 !EXIT INTECOLOR 4010 MODE? IF(ITERM.EQ.8) CALL ENI4027 !EXIT INTECOLOR 4010 TO 4027 ASCII0 IF(ITERM.EQ.9) CALL END4010 !EXIT DEC 4010 MODE: IF(ITERM.EQ.10)CALL ENT4105 !EXIT TEK 4105/4107/4109 MODE5 IF(ITERM.EQ.11)CALL ENT4105 !EXIT TEK 4695 HARD COPY RETURN END CCCCLC--------------------------------------------------------------------------- SUBROUTINE ENDHPLC---------------------------------------------------------------------------CC/C THIS SUBROUTINE SHUTS DOWN THE HP7470 PLOTTERCC CALL TOUT(31) !GRAPHICS OFF CALL DELAY(4) WRITE(80,1000)91000 FORMAT(' PU;PA 0,0;SP;') !PEN UP, CORNER, PEN STORE REWIND 802 CALL TOUT(27) !TURN OFF PLOTTER IF ON-LINE MODE CALL TOUT(46) !SEND ESC . ) CALL TOUT(41) RETURN END CCLC--------------------------------------------------------------------------- SUBROUTINE ENDLALC---------------------------------------------------------------------------C C DO NOTHING C RETURN END CCLC--------------------------------------------------------------------------- SUBROUTINE END4010LC---------------------------------------------------------------------------C5 COMMON /TERMIN/ ITERM,IBAUD,IPLOT,ICOLOR,IMODE,IHARDC<C THIS SUBROUTINE EXITS THE DEC 4010 MODE TO THE VT-200 MODE-C BY SENDING THE APPROPRIATE ESCAPE SEQUENCESC< CALL TOUT(29) !GS MAKE SURE WE ARE IN SOME TYPE OF GRAPHICS- CALL TOUT(31) !US MODE PREFERABLY 4010 ALPHA CALL TOUT(27) !ESC CALL TOUT(91) ![ CALL TOUT(63) !? CALL TOUT(51) !3 CALL TOUT(56) !8 CALL TOUT(108)!lCC CLEAR ASCII SCREENC' IMODE=-1 !WE ARE NOW AN ANSI TERMINAL CALL ERASE RETURN END CC LC--------------------------------------------------------------------------- SUBROUTINE ENI4010LC---------------------------------------------------------------------------5 COMMON /TERMIN/ ITERM,IBAUD,IPLOT,ICOLOR,IMODE,IHARDCCBC THIS SUBROUTINE EXITS THE INTECOLOR 4010 MODE TO THE VT-100 MODE-C BY SENDING THE APPROPRIATE ESCAPE SEQUENCESC< CALL TOUT(29) !GS MAKE SURE WE ARE IN SOME TYPE OF GRAPHICS- CALL TOUT(31) !US MODE PREFERABLY 4010 ALPHA CALL TOUT(27) !ESC CALL TOUT(34) !" CALL TOUT(48) !0 CALL TOUT(103)!gC:C CLEAR SCREEN OF ASCII CHARACTERS AND SPACE DOWN 30 LINESC' IMODE=-1 !WE ARE NOW AN ANSI TERMINAL CALL ERASE RETURN END CC LC--------------------------------------------------------------------------- SUBROUTINE ENI4027LC---------------------------------------------------------------------------5 COMMON /TERMIN/ ITERM,IBAUD,IPLOT,ICOLOR,IMODE,IHARDCFC THIS SUBROUTINE EXITS THE INTECOLOR 4027/4010 MODE TO THE 4027/ASCII2C MODE BY SENDING THE APPROPRIATE ESCAPE SEQUENCESC; CALL TOUT(31) !SEND TO LEAVE 4027/4010 TO 4027/ASCII, WRITE(7,10) !MONITOR = WORK SPACE FOR TEXT210 FORMAT(' !MON') !LEAVE IMODE=8 I.E. 4027 MODE RETURN ENDLC---------------------------------------------------------------------------! SUBROUTINE ENLBL(VALUE,DUM)LC---------------------------------------------------------------------------C9C THIS SUBROUTINE ENCODES THE VALUE OF THE VARIABLE VALUE?C INTO THE ARRAY "DUM" WITH A MAXIMUM OF 9 CHARACTERS DISPLAYEDGC FOR VALUE, IF VALUE IS > 1.E06 THEN EXPONENTIAL FORMAT IS USED CC INTEGER*2 DUM(10)1 IF(ABS(VALUE).LT.1E06) ENCODE(10,1001,DUM) VALUE1 IF(ABS(VALUE).GE.1E06) ENCODE(10,1010,DUM) VALUE1001 FORMAT(1F9.2)1010 FORMAT(1PE9.2) RETURN ENDC LC--------------------------------------------------------------------------- SUBROUTINE ENLSIRGLC---------------------------------------------------------------------------5 COMMON /TERMIN/ ITERM,IBAUD,IPLOT,ICOLOR,IMODE,IHARDCCEC THIS SUBROUTINE EXITS THE LSI/ADM RETROGRAPHICS 4010 MODE TO ASCII -C BY SENDING THE APPROPRIATE ESCAPE SEQUENCESC CALL TOUT(29) !GS ; CALL TOUT(31) !US EXIT 4010 VECTOR MODE TO 4010 ALPHA MODE> CALL TOUT(24) !CAN EXIT 4010 ALPHA MODE TO LSI/ADM ASCII MODEC:C CLEAR SCREEN OF ASCII CHARACTERS AND SPACE DOWN 30 LINESC- IMODE=-1 !WE ARE NOW AN ANSI/ASCII TERMINAL CALL ERASE RETURN ENDLC--------------------------------------------------------------------------- SUBROUTINE ENPLESSLC---------------------------------------------------------------------------5 COMMON /TERMIN/ ITERM,IBAUD,IPLOT,ICOLOR,IMODE,IHARDCC7C THIS SUBROUTINE EXITS THE PLESSEY 4010 MODE TO ASCII -C BY SENDING THE APPROPRIATE ESCAPE SEQUENCESC CALL TOUT(29) !GS ; CALL TOUT(31) !US EXIT 4010 VECTOR MODE TO 4010 ALPHA MODE> CALL TOUT(27) !ESC EXIT 4010 ALPHA MODE TO LSI/ADM ASCII MODE CALL TOUT(50) !2C:C CLEAR SCREEN OF ASCII CHARACTERS AND SPACE DOWN 30 LINESC- IMODE=-1 !WE ARE NOW AN ANSI/ASCII TERMINAL CALL ERASE RETURN ENDLC--------------------------------------------------------------------------- SUBROUTINE ENT4105LC---------------------------------------------------------------------------5 COMMON /TERMIN/ ITERM,IBAUD,IPLOT,ICOLOR,IMODE,IHARDC@C THIS SUBROUTINE EXITS THE TEK 4105/4010 MODE TO THE ASCII MODE-C BY SENDING THE APPROPRIATE ESCAPE SEQUENCESC CALL TOUT(27) !ESC CALL TOUT(37) !% CALL TOUT(33) !! CALL TOUT(49) !1C.C AND NOW TURN ON THE DIALOG AREA JUST IN CASEC CALL TOUT(27) !ESC CALL TOUT(75) !K CALL TOUT(65) !A CALL TOUT(49) !1C:C CLEAR SCREEN OF ASCII CHARACTERS AND SPACE DOWN 30 LINESC5 IMODE=-1 !WE HAVE AN ASCII TYPE MODE HERE SO USE IT CALL ERASE RETURN ENDKC-------------------------------------------------------------------------- SUBROUTINE ERASELC---------------------------------------------------------------------------5 COMMON /TERMIN/ ITERM,IBAUD,IPLOT,ICOLOR,IMODE,IHARDC 0C THIS SUBROUTINE ERASES THE TEKTRONIX TERMINAL*C OUTPUT (ESC) (FF) TO SCOPE FOR NEW PAGE 6C IF THE MODE IS TEKTRONICS THEN ERASE GRAPHICS IF NOT,C THEN ERASE ASCII CHARACTERS (IF IMODE < 0)CCC2C CHECK FOR TERMINAL TYPE TO DECIDE ON ERASE MODE C- IF(IMODE.EQ.-1) GO TO 10 !ANSI 3.64 TERMINAL1 IF(ITERM.EQ.3) CALL CLRGR(0) !TERMINAL = PERITEK+ IF(ITERM.EQ.3) RETURN !TERMINAL = PERITEKCC TEKTRONICS TYPE TERMINALC" IF(IMODE.GE.0) CALL TOUT(7) !BELL2 IF(IMODE.GE.0) CALL TOUT(27) !ESC, ERASE SEQUENCE! IF(IMODE.GE.0) CALL TOUT(12) !FF8 IF(IMODE.GE.0) CALL TOUT(31) !GO INTO 4010 ALPHA MODEC'C TIME DELAY FOR BAUD RATE PURPOSESC CALL DELAY(3)= IF((ITERM.GE.0).OR.(ITERM.LE.4)) RETURN !TEK 4010,4006,4027 C8C CHECK MODE OF TERMINAL IF IMODE = ANSI = -1 THEN ERASEC ASCII DISPLAY CC LSI/ADM TERMINALCF IF((IMODE.LT.0).AND.(ITERM.EQ.2)) CALL TOUT(31)!RETURN TO 4010 ALPHA B IF((IMODE.LT.0).AND.(ITERM.EQ.2)) CALL TOUT(26) !CLEARS LSI/ADM5 G IF((IMODE.LT.0).AND.(ITERM.EQ.2)) CALL TOUT(24) !RETURN TO ADM5 ALPHA ) IF((IMODE.LT.0).AND.(ITERM.EQ.2)) RETURNC C WE HAVE A VT100/ANSI TERMINAL C:C CLEAR SCREEN OF ASCII CHARACTERS AND SPACE DOWN 30 LINESC10 CALL TOUT(27)!ESC CALL TOUT(91)![ CALL TOUT(50)!2 CALL TOUT(74)!J WRITE(7,20)20 FORMAT(30(/)) RETURN ENDAC---------------------------------------------------------------- SUBROUTINE HCSCRNAC----------------------------------------------------------------C7C THIS SUBROUTINE PRODUCES A HARDCOPY OF THE SCREEN FOR3C DEVICES WHICH CAN TRANSMITT A SCREEN DUMP ON THE <C RECEIPT OF ESCAPE CHARACTERS OTHER HARDCOPIES WILL REQUIRE2C THAT YOU REPLOT THE GRAPH ON THE HARDCOPY DEVICEC2C THE CURRENT DEVICES WHICH ALLOW THIS OPTION ARE:C4C TEKTRONICS 4010-1 TERMINALS WITH A VERSATEC COPIER6C TEKTRONICS 4105/07/09 TERMINALS WITH THE 4695 COPIER-C NOTE: TERMINAL MUST BE IN GRAPHICS MODE&C FOR THIS ROUTINE TO WORK PROPERLYCC"C COMMON BLOCKS for NGRAPHCC6 COMMON /CRTLST/ XMIN,DX,YMIN,DY,OFFX,OFFY,XL,YL,XZ,YZ5 COMMON /TERMIN/ ITERM,IBAUD,IPLOT,ICOLOR,IMODE,IHARD! COMMON /LABEL/ ILX,ILY,NILX,NILYCCCC WRITE(7,1)"C1 FORMAT(' THIS IS A TEST OF HC'), IF(IHARD.EQ.12) GO TO 10 !TEKTRONICS 4010-1/ IF(IHARD.EQ.11) GO TO 20!TEKTRONICS 4105/07/095 RETURN !ALL OTHER TERMINALS MUST REDRAW SEPERATELYCC'C TEKTRONICS 4010-1 REQUIRES AN ESC,ETBCC10 CALL TOUTPT(27) !ESCAPE CALL TOUTPT(23) !ETB RETURNC;C TEKTRONICS 4105/07/09 WITH 4695 COPIER REQUIRES ESC,K,H,1C"20 CALL STRTCRT !TURN ON GRAPHICS CALL TOUTPT(27) !ESCAPE CALL TOUTPT(75) !K CALL TOUTPT(72) !H CALL TOUTPT(49) !NUMBER 1 CALL ENDCRT RETURN END FUNCTION IPEEK RETURN END FUNCTION IPOKE RETURN END FUNCTION ITTINR RETURN ENDLC--------------------------------------------------------------------------- SUBROUTINE HPLBL(IARRAY,NS,NF)LC---------------------------------------------------------------------------CC7C THIS SUBROUTINE TRANSMITTS THE ASCII STRING CONTAINED6C IN THE ARRAY "IARRAY" TO THE HP PLOTTER FOR LABELINGC AXII AND TIC MARKS%C LIMITS ON THE CONTENTS OF THE ARRAY9C PRINTED ARE BETWEEN NS= NUMBER OF CHARACTER TO START AT*C NF= NUMBER OF CHARACTER TO STOP ATC IN THE ARRAY "IARRAY" DIMENSION IARRAY(1) BYTE NESCCCCC DEFINE TERMINATOR ESC=27CC REWIND 80 !DUMP PLOTTER BUFFER NESC=27E CALL DELAY(4*(1+NF-NS)) !DELAY BASED ON NUMBER OF CHARACTERS PLOTTED! WRITE(80,10) (IARRAY(K),K=NS,NF)"10 FORMAT(' CP -0.,-0.5; LB',50A2) WRITE(80,20) 20 FORMAT(/)E CALL DELAY(4*(1+NF-NS)) !DELAY BASED ON NUMBER OF CHARACTERS PLOTTED REWIND 80 !DUMP PLOTTER BUFFER RETURN ENDLC---------------------------------------------------------------------------$ SUBROUTINE LABEL(ILX,NILX,ILY,NILY)LC---------------------------------------------------------------------------C.C THIS SUBROUTINE LABELS THE AXII OF THE GRAPHC-C ILX=ARRAY OF CHARACTERS FOR LABELING X AXIS8C STORED AS 2 HOLLERITH CHARACTERS PER ARRAY ELEMENT"C NILX=NUMBER OF CHARACTERS IN ILX-C ILY=ARRAY OF CHARACTERS FOR LABELING Y AXIS7C STORED AS 1 HOLLERITH CHARACTER PER ARRAY ELEMENT"C NILY=NUMBER OF CHARACTERS IN ILYCC!C EXAMPLE0C STORE THE X AXIS LABEL ENERGY(KEV) IN ILX)C AND THE Y AXIS LABEL COUNTS IN ILYC4C FOR LABELING THE X AND Y AXII RESPECTIVELYC !C DIMENSION ILX(6),ILY(6)1C DATA ILX/'EN','ER','GY',' (','KE','V)'/+C DATA ILY/'C','O','U','N','T','S'/#C CALL LABEL (ILX,12,ILY,6)C CCC XL=X AXIS LENGTHC YL=Y AXIS LENGTHC=C THE ROUTINE LABELS THE MIN AND MAX OF EACH AXIS AND OUTPUTSFC THE VALUE OF THE INCREMENT (MINOR TIC) IN UNITS OF THE ORIGINAL DATA;C NOTE THAT THIS ROUTINE HAS ALSO BEEN SETUP TO WRITE ASCII,C CHARACTERS TO LABEL THE TITLES OF THE AXIIBC FOR READABILITY ALL LABELING IS DONE USING THE NORMAL TTY OUTPUT?C THE GRAPHICS ROUTINE ARE USED IN ORDER TO POSITION THE OUTPUT'C WITH RESPECT TO THE COORDINATE SYSTEMCC6 COMMON /CRTLST/ XMIN,DX,YMIN,DY,OFFX,OFFY,XL,YL,XZ,YZ5 COMMON /TERMIN/ ITERM,IBAUD,IPLOT,ICOLOR,IMODE,IHARD DIMENSION ILX(1),ILY(1) INTEGER*2 DUM(10)CC NO LABELS FOR PERITEKC7 IF(ITERM.EQ.3) RETURN !FORGET ABOUT LABELS ON PERITEKCC SPECIAL LABEL FOR DEC/VT200CCC XEND=OFFX+XL-75. YEND=OFFY+YL YS=OFFY-50.. IF ((ITERM.EQ.4).OR.(ITERM.EQ.8)) YS=OFFY-12. XS=5. XXS=OFFX-75. XMAX=XL/DX+XMIN YMAX=YL/DY+YMIN DELTAX=XL/DX/20. DELTAY=YL/DY/20.CC LABEL X AXISCCCC MOVE TO XMIN POSITIONCC CALL DELAY(3) CALL PLOT(XXS,YS,0)9 IF ((ITERM.EQ.4).OR.(ITERM.EQ.8)) CALL PLOT(XXS,YS-20,0) CALL DELAY(5) VALUE=XMINC'C CHECK TERMINAL TYPE AND WRITE IT OUTC6 IF (((ITERM.LE.2).OR.(ITERM.EQ.7)).OR.(ITERM.EQ.10)) CCALL LBL4010(VALUE)5 IF((ITERM.EQ.4).OR.(ITERM.EQ.8)) CALL LBL4027(VALUE)% IF(ITERM.EQ.5) CALL LBLHP(VALUE) CALL DELAY(3)CC GO TO XMAX POSITIONC CALL PLOT(XEND,YS,0): IF ((ITERM.EQ.4).OR.(ITERM.EQ.8)) CALL PLOT(XEND,YS-20,0) CALL DELAY(5) VALUE=XMAX6 IF (((ITERM.LE.2).OR.(ITERM.EQ.7)).OR.(ITERM.EQ.10)) CCALL LBL4010(VALUE)5 IF((ITERM.EQ.4).OR.(ITERM.EQ.8)) CALL LBL4027(VALUE)% IF(ITERM.EQ.5) CALL LBLHP(VALUE) CALL DELAY(3)CC+C MOVE TO MIDPOSITION AND WRITE XAXIS LABELCC XMID=OFFX +XL/2. XTOP=XMID - 15.*(NILX/2.) CALL PLOT(XTOP,YS,0): IF ((ITERM.EQ.4).OR.(ITERM.EQ.8)) CALL PLOT(XTOP,YS-20,0) NL=NILX/2. CALL DELAY(3)C(C USE NORMAL ASCII TEXT OF TEK 4010 MODEC< IF (((ITERM.LT.3).OR.(ITERM.EQ.7)).OR.(ITERM.EQ.10))$ C WRITE(7,200) (ILX(I),I=1,NL)? IF((ITERM.EQ.4).OR.(ITERM.EQ.8)) CALL LBLTEXT(ILX,1,NL)$ IF(ITERM.EQ.5) CALL HPLBL(ILX,1,NL) IF(ITERM.EQ.5) CALL DELAY(30) CALL DELAY(10)200 FORMAT('+',50A2)CCC LABEL Y AXISCCC8C POSITION GRAPHICS BEAM CHECK TERMINAL AND WRITE IT OUTCC CALL PLOT(2.,YEND,0)( IF(ITERM.EQ.5) CALL PLOT(2.,YEND+10.,0) CALL DELAY(5)CC WRITE YMAXC VALUE=YMAX6 IF (((ITERM.LE.2).OR.(ITERM.EQ.7)).OR.(ITERM.EQ.10)) CCALL LBL4010(VALUE)5 IF((ITERM.EQ.4).OR.(ITERM.EQ.8)) CALL LBL4027(VALUE)% IF(ITERM.EQ.5) CALL LBLHP(VALUE) CALL DELAY(5)CC WRITE YMINC YM=OFFY CALL PLOT(2.,YM,0) CALL DELAY(5) VALUE=YMIN6 IF (((ITERM.LE.2).OR.(ITERM.EQ.7)).OR.(ITERM.EQ.10)) CCALL LBL4010(VALUE)5 IF((ITERM.EQ.4).OR.(ITERM.EQ.8)) CALL LBL4027(VALUE)% IF(ITERM.EQ.5) CALL LBLHP(VALUE)125 CONTINUE CALL DELAY(5)CC GO TO MID POSITION FOR LABELC YMID=OFFY + YL/2. YTOP=YMID + 22.*(NILY/2.) DO 201 I=1,NILY CALL PLOT(22.,YTOP,0) CALL DELAY(5)< IF (((ITERM.LT.3).OR.(ITERM.EQ.7)).OR.(ITERM.EQ.10)) C WRITE(7,202) ILY(I)6 IF((ITERM.EQ.4).OR.(ITERM.EQ.8))CALL LBLTEXT(ILY,I,I)# IF(ITERM.EQ.5) CALL HPLBL(ILY,I,I) IF(ITERM.EQ.5) CALL DELAY(5) CALL DELAY(5) 202 FORMAT('+',50A1) YTOP=YTOP-22. 201 CONTINUECC DEC VT-200 LABELSC>2000 IF(ITERM.EQ.9) CALL PLOT(5.,800.,0) !GO OFF TOP OF SCREEN0 IF(ITERM.EQ.9) CALL DECLBL(YMIN,YMAX,XMIN,XMAX)CC= CALL DELAY(20) !MEDIUM DELAY HERE TO CATCH UP WITH YOURSELFCC GO TO ORIGINCD CALL PLOT(OFFX,OFFY,0) !GO BACK TO ORIGIN & GET READY TO PLOT DATA IF(ITERM.EQ.5) CALL DELAY(50) RETURN END CCLC--------------------------------------------------------------------------- SUBROUTINE LBL4027(VALUE)LC---------------------------------------------------------------------------C:C THIS SUBROUTINE WRITES THE VALUE OF THE VARIABLE "VALUE"9C ON THE TEK 4027 SCREEN AT THE CURRENT GRAPHICS POSITIONCC INTEGER*2 DUM(10)5 CALL ENLBL(VALUE,DUM) !ENCODE VALUE INTO DUMMY ARRAY4 CALL LBL (DUM,1,9) !WRITE IT TO SCREEN 9 CHARACTERS RETURN END CCCCLC--------------------------------------------------------------------------- SUBROUTINE LBL(AARRAY,NS,NF)LC---------------------------------------------------------------------------CC7C THIS SUBROUTINE TRANSMITTS THE ASCII STRING CONTAINED4C IN THE ARRAY "AARRAY" TO THE TEK 4027 FOR LABELINGC AXII AND TIC MARKS%C LIMITS ON THE CONTENTS OF THE ARRAY9C PRINTED ARE BETWEEN NS= NUMBER OF CHARACTER TO START AT*C NF= NUMBER OF CHARACTER TO STOP ATC IN THE ARRAY "IARRAY" INTEGER*2 AARRAY(10)CCC WRITE(7,10) (AARRAY(K),K=NS,NF)!10 FORMAT(' !STRING "',10A2,'"') RETURN END CLC---------------------------------------------------------------------------" SUBROUTINE LBLTEXT (AARRAY,NS,NF)LC---------------------------------------------------------------------------CC7C THIS SUBROUTINE TRANSMITTS THE ASCII STRING CONTAINED4C IN THE ARRAY "AARRAY" TO THE TEK 4027 FOR LABELINGC AXII AND TIC MARKS%C LIMITS ON THE CONTENTS OF THE ARRAY9C PRINTED ARE BETWEEN NS= NUMBER OF CHARACTER TO START AT*C NF= NUMBER OF CHARACTER TO STOP ATC IN THE ARRAY "IARRAY" INTEGER AARRAY(10)CCC WRITE(7,10) (AARRAY(K),K=NS,NF)!10 FORMAT(' !STRING "',10A2,'"') RETURN ENDLC--------------------------------------------------------------------------- SUBROUTINE LBL4010(VALUE)LC---------------------------------------------------------------------------CC:C THIS SUBROUTINE WRITES THE VALUE OF THE VARIABLE "VALUE"9C ON THE TEK 4010 SCREEN AT THE CURRENT GRAPHICS POSITIONCC( IF(ABS(VALUE).LT.1E06) WRITE(7,1) VALUE) IF(ABS(VALUE).GE.1E06) WRITE(7,10) VALUE41 FORMAT('+',1F9.2) !remove + for rt-11 operation10 FORMAT('+',1PE9.2) RETURN END CC LC--------------------------------------------------------------------------- SUBROUTINE LBLHP(VALUE)LC---------------------------------------------------------------------------C:C THIS SUBROUTINE WRITES THE VALUE OF THE VARIABLE "VALUE"8C ON THE HP7470 PLOTTER AT THE CURRENT GRAPHICS POSITIONC' REWIND 80 !DUMP CURRENT PLOTTER BUFFER* IF(ABS(VALUE).LT.1E06) WRITE(80,91) VALUE+ IF(ABS(VALUE).GE.1E06) WRITE(80,910) VALUE$91 FORMAT(' CP -3.,-.5; LB',1F9.2,/)&910 FORMAT(' CP -3.,-.5; LB',1PE9.2,/)' REWIND 80 !DUMP CURRENT PLOTTER BUFFER RETURN ENDLC--------------------------------------------------------------------------- SUBROUTINE LINE (NPT,AX,AAY)LC---------------------------------------------------------------------------CGC THIS SUBROUTINE DRAWS A CONTINUOUS LINE FROM DATA POINT TO DATA POINTC NPT=NUMBER OF DATA POINTSC AX=ARRAY OF DATA FOR X AXISC AAY=ARRAY OF DATA FOR Y AXISC=C SPECIAL NOTE: THE VALUES OF XMIN,DX,YMIN,DY,OFFX,OFFY,XL,YL6C ARE SET BY CALLS TO THE SUBROUTINES SCALE AND OFFSETC6 COMMON /CRTLST/ XMIN,DX,YMIN,DY,OFFX,OFFY,XL,YL,XZ,YZ5 COMMON /TERMIN/ ITERM,IBAUD,IPLOT,ICOLOR,IMODE,IHARD DIMENSION AX(NPT),AAY(NPT) XEND=OFFX+XL YEND=OFFY+YL XLAST=OFFX+(AX(1)-XMIN)*DX YLAST=OFFY+(AAY(1)-YMIN)*DY IF(XLAST.GE.XEND) XLAST=XEND IF(YLAST.GE.YEND) YLAST=YEND IF(XLAST.LE.OFFX) XLAST=OFFX IF(YLAST.LE.OFFY) YLAST=OFFY CALL TOUT(29) CALL XYTRAN(XLAST,YLAST) DO 1 I=1,NPT XPT=OFFX+(AX(I)-XMIN)*DX YPT=OFFY+(AAY(I)-YMIN)*DY IF(XPT.GE.XEND) XPT=XEND IF(YPT.GE.YEND) YPT=YEND IF(XPT.LE.OFFX) XPT=OFFX IF(YPT.LE.OFFY) YPT=OFFY CALL XYTRAN(XPT,YPT) 1 CONTINUEC,C INSERT LONGER DELAY FOR BAUD RATE PURPOSESC3 CALL DELAY(5) CALL TOUT(31) RETURN ENDKC-------------------------------------------------------------------------- SUBROUTINE MOVE (X,Y)KC--------------------------------------------------------------------------CCC=C THIS SUBROUTINE MOVES THE GRAPHICS BEAM TO THE POSITION X,YCC/C X= ABSOLUTE SCREEN COORDINATE X AXIS (0-1023).C Y= ABSOLUTE SCREEN COORDINATE Y AXIS (0-749)CC5 COMMON /TERMIN/ ITERM,IBAUD,IPLOT,ICOLOR,IMODE,IHARD IF(ITERM.LT.0) RETURN CALL TOUT (31)" CALL TOUT (29) !TURN ON GRAPHICS! CALL XYTRAN (X,Y) !MOVE TO POINT# CALL TOUT (31) !TURN OFF GRAPHICS RETURN END CCIC------------------------------------------------------------------------ SUBROUTINE MOVREL(DX,DY)IC------------------------------------------------------------------------CC:C THIS SUBROUTINE MOVES THE GRAPHICS BEAM FROM THE CURRENT4C GRAPHICS BEAM LOCATION TO A NEW RELATIVE LOCATION =C BY FINDING THE CURRENT POSITION AND THEN COMPUTING THE NEW 5C POSITION (WHICH THE SUBROUTINE FINDS OUT BY SENDING8C AN STATUS REQUEST ENQUIRY), TO THE POSITION X+DX,Y+DY *C ------------------'C SPECIAL NOTE*C ------------------C8C THIS ROUTINE DOESNOT FUNCTION FOR 4027 TERMINALS !!!!!CC=C DX= ABSOLUTE DISPLACEMENT SCREEN COORDINATE X-AXIS (0-1023)<C DY= ABSOLUTE DISPLACEMENT SCREEN COORDINATE Y-AXIS (0-749)CC"C COMMON BLOCKS for NGRAPHCC5 COMMON /TERMIN/ ITERM,IBAUD,IPLOT,ICOLOR,IMODE,IHARD BYTE IBC,IBHX,IBLX,IBHY,IBLY IF(ITERM.LT.0) RETURN$ IF(ITERM.EQ.4.OR.ITERM.EQ.8) RETURNCCBC WE NOW FORCE THE TERMINAL TO GIVE US THE GRAPHICS BEAM LOCATION <C BY RESETTING THE GS MODES AND READING THE TERMINAL STATUS CCCC1 CALL TOUT (29) !GO TO GRAPHICS MODE USING C1C NOW FORCE THE ISSUE WITHOUT THE USER KNOWING IT<C NOTE IN GIN/GRAPHICS/TEXT MODES THE REPORTS ARE DIFFERENT!C8 IF((ITERM.NE.4).OR.(ITERM.NE.8)) CALL R4010 (XGBP,YGBP)8 IF((ITERM.EQ.4).OR.(ITERM.EQ.8)) CALL R4027 (XGBP,YGBP)CCCC CALL TOUT(29) !GRAPHICS ON1 CALL XYTRAN (XGBP + DX,YGBP + DY) !NEW END POINTF IF((ITERM.NE.4).OR.(ITERM.NE.8)) CALL TOUT (31) !TURN OFF VECTOR MODEC>C THE FOLLOWING WRITE STATEMENT IS FOR DEBUGGING PURPOSES ONLY?C TO SEE WHAT CHARACTERS (ADE'S) ARE BEING RECEIVED BY THE HOSTC&C WRITE(8,101) IBC,IBHX,IBLX,IBHY,IBLY.C101 FORMAT(' 101 = IC,HX,LX,HY,LY=',5(I2,1X)) C REWIND 8CC ALL DONE C RETURN END SUBROUTINE CLRGR RETURN END SUBROUTINE CMAP RETURN END SUBROUTINE DRAW RETURN END SUBROUTINE GCRS RETURN END SUBROUTINE PNT RETURN END SUBROUTINE SETPV RETURN ENDLC---------------------------------------------------------------------------( SUBROUTINE OFFSET(A,B,C,D,E,F,G,H)LC---------------------------------------------------------------------------CFC THIS SUBROUTINE STORES THE VALUES OF XMIN,DX,YMIN,DY,OFFX,OFFY,XL,YLC IN THE APPROPRIATE ORDER*C XMIN =MIN VALUE OF DATA ARRAY FOR X AXISC DX=SCALE FACTOR FOR X AXISC YMIN=MIN. VALUE FOR Y AXISC DY=SCALE FACTOR FOR Y AXISAC OFFX=OFFSET OF ORIGIN USED FOR SHIFTING THE ORIGIN ALONG X AXIS$C OFFY=OFFSET OF ORIGIN ALONG Y AXIS3C NOTE THAT OFFX AND OFFY MUST BE IN UNITS OF !C ABSOLUTE SCREEN COORDINATSC6 COMMON /CRTLST/ XMIN,DX,YMIN,DY,OFFX,OFFY,XL,YL,XZ,YZ XMIN=A DX=B YMIN=C DY=D OFFX=E OFFY=F XL=G YL=H RETURN END MC--------------------------------------------------------------------------- SUBROUTINE PLOT (X,Y,NMODE)LC---------------------------------------------------------------------------CC C COMMON BLOCKS FOR NELSCC5 COMMON /TERMIN/ ITERM,IBAUD,IPLOT,ICOLOR,IMODE,IHARDCCCCC6C THIS SUBROUTINE MOVES THE POINTER TO A POSITION)C X,Y (ABSOLUTE UNITS) ON THE SCREEN$C IF NMODE =0 MOVE TO POSITION 4C =1 MOVE TO POSITION AND PLOT A POINTCC CHECK TERMINALC IF(ITERM.LT.0) RETURN IF(ITERM.NE.IMODE) RETURNC TURN ON GS CALL TOUT(31) CALL TOUT(29)"C TEST FOR MOVE, POINT PLOT, : 0,1 IF(NMODE.EQ.0) GO TO 1 IF(NMODE.EQ.1) GO TO 2C PLOT LINE FROM LAST TO NEW 2 CALL XYTRAN (X,Y) 1 CALL XYTRAN (X,Y) C TURN OFF GS CALL TOUT(31) RETURN ENDLC-------------------------------------------------------------------------- ! SUBROUTINE POINT(NPT,AX,YA)LC---------------------------------------------------------------------------C0C THIS SUBROUTINE PLOTS AN ARRAY OF POINTS WHERE#C NPT=NUMBER OF POINTS IN THE ARRAY"C AX= ARRAY OF DATA FOR THE X AXIS"C YA= ARRAY OF DATA FOR THE Y AXISC =C SPECIAL NOTE: THE VALUES OF XMIN,DX,YMIN,DY,OFFX,OFFY,XL,YL8C WHICH ARE REQUIRED FOR PLOTTING ARE INTERNALLY SET BY *C CALLING THE SUBROUTINES SCALE AND OFFSETCC6 COMMON /CRTLST/ XMIN,DX,YMIN,DY,OFFX,OFFY,XL,YL,XZ,YZ DIMENSION AX(NPT),YA(NPT) XEND=OFFX+XL YEND=OFFY+YL DO 1 I=1,NPT XPT=OFFX+(AX(I)-XMIN)*DX YPT=OFFY+(YA(I)-YMIN)*DY XPT=INT(XPT) YPT=INT(YPT) IF(XPT.GE.XEND) XPT=XEND IF(YPT.GE.YEND) YPT=YEND IF(XPT.LE.OFFX) XPT=OFFX IF(YPT.LE.OFFY) YPT=OFFY CALL TOUT(29) CALL XYTRAN(XPT,YPT) CALL XYTRAN(XPT,YPT) CALL TOUT(31) 1 CONTINUE RETURN ENDMC--------------------------------------------------------------------------- * SUBROUTINE SCALE(XMIN,DX,NPT,AAX,XL)LC---------------------------------------------------------------------------C<C THIS SUBROUTINE CALCULATES THE APPROPRIATE SCALING FACTORS8C FOR PLOTTING DATA USING A LINEAR SCALE ON THE TEKSCOPEC XMIN=MIN. VALUE IN ARRAY AAX5C DX=SCALE FACTOR FOR PLOTTING IN POINTS/UNIT OF DATA"C NPT=NUMBER OF DATA POINTS IN AAXC AAX=ARRAY CONTAINING DATA,C XL=LENGTH OVER WHICH DATA IS TO BE PLOTTED1C NOTE THIS VALUE IS IN ABSOLUTE SCREEN UNITS&C X AXIS=1024 SCREEN UNITS (MAX)&C Y AXIS= 780 SCREEN UNITS (MAX)CC DIMENSION AAX(NPT) XMIN=1. E38 DO 1 I=1,NPT 1 XMIN=AMIN1(XMIN,AAX(I)) XMAX=-1.E38 DO 2 I=1,NPT 2 XMAX=AMAX1(XMAX,AAX(I)) IF(XMAX-XMIN) 3,3,4 4 CONTINUE DX=XL/(XMAX-XMIN) RETURN 3 DX=XL/10. RETURN ENDCCCLC---------------------------------------------------------------------------' SUBROUTINE RSCALE(XMIN,DX,NPT,AAX,XL)LC---------------------------------------------------------------------------C<C THIS SUBROUTINE CALCULATES THE APPROPRIATE SCALING FACTORS8C FOR PLOTTING DATA USING A LINEAR SCALE ON THE TEKSCOPE9C NOTE THAT THIS ROUTINE ROUNDS ONLY THE UPPER LIMITC XMIN=MIN. VALUE IN ARRAY AAX5C DX=SCALE FACTOR FOR PLOTTING IN POINTS/UNIT OF DATA"C NPT=NUMBER OF DATA POINTS IN AAXC AAX=ARRAY CONTAINING DATA,C XL=LENGTH OVER WHICH DATA IS TO BE PLOTTED1C NOTE THIS VALUE IS IN ABSOLUTE SCREEN UNITS&C X AXIS=1024 SCREEN UNITS (MAX)&C Y AXIS= 780 SCREEN UNITS (MAX)CC DIMENSION AAX(NPT) XMIN=1. E38 DO 1 I=1,NPT 1 XMIN=AMIN1(XMIN,AAX(I)) XMAX=-1.E38 DO 2 I=1,NPT 2 XMAX=AMAX1(XMAX,AAX(I)) IF(XMAX-XMIN) 3,3,4 4 CONTINUE# IF(ABS(XMAX).GE.100.) GO TO 5" IF(ABS(XMAX).LT.1.0) GO TO 9 XMAX=10.*INT(XMAX/10. +1.) GO TO 6 9 CNT=-1. 11 XMAX=XMAX*10.# IF(ABS(XMAX).LT.1.0) GO TO 10! XMAX=INT(XMAX +1.)*10.**CNT GO TO 6 10 CNT=CNT-1. GO TO 11 5 CNT=1. 7 XMAX=XMAX/10.$ IF (ABS(XMAX).LT.100.) GO TO 8 CNT=CNT+1. GO TO 7! 8 XMAX=INT(XMAX +1.)*10.**CNT 6 CONTINUE DX=XL/(XMAX-XMIN) RETURN 3 DX=XL/10. RETURN END HC----------------------------------------------------------------------- SUBROUTINE R4010 (XGBP,YGBP)HC-----------------------------------------------------------------------C@C THIS SUBROUTINE REPORTS THE GRAPHICS BEAM POSITION WHEN WE AREC IN THE 4010 MODE OF OPERATIONC+ CALL TOUT (27) !REQUEST STATUS OF TERMINAL; CALL TOUT (5) !THIS SEND A REPORT OF GRAPHICS COORDINATESC !I.E. 5 BYTE SEQUENCE CC READ THESE INTO THE PROGRAM0C MUST HAVE TRAILER CODES FROM THE TERMINAL EC FOR THIS READ STATEMENT TO BE EXECUTED WITHOUT OPERATOR KNOWING ITC$ READ(5,100) IBC,IBHX,IBLX,IBHY,IBLY100 FORMAT(5A1)'C WRITE (8,102) IBC,IBHX,IBLX,IBHY,IBLY4C102 FORMAT(' 102 = IBC,IHX,ILX,IHY,ILY=', 5(I2,1X))CCC CONVERT BYTES TO WORDSCCC200 IHX=IBHX ILX=IBLX IHY=IBHY ILY=IBLYC>C THE FOLLOWING WRITE STATEMENT IS FOR DEBUGGING PURPOSES ONLY?C TO SEE WHAT CHARACTERS (ADE'S) ARE BEING RECEIVED BY THE HOSTC&C WRITE(8,101) IBC,IBHX,IBLX,IBHY,IBLY-C101 FORMAT('101 = IC,HX,LX,HY,LY=',5(I2,1X)) C REWIND 8CCC>C NOW WE DO A LOT OF BUSY WORK TO GET BACK THE COORDINATES ANDC THEN REPLOT THE MESS!C, XGBP = 32*(IHX-32)+(ILX-32) !INTECOLOR 4010, YGBP = 32*(IHY-32)+(ILY-32) !INTECOLOR 4010 RETURN ENDCCHC----------------------------------------------------------------------- SUBROUTINE R4027 (XGBP,YGBP)HC-----------------------------------------------------------------------CC@C THIS SUBROUTINE REPORTS THE GRAPHICS BEAM POSITION WHEN IN THEC 4027 MODE OF OPERATIONCC5 COMMON /TERMIN/ ITERM,IBAUD,IPLOT,ICOLOR,IMODE,IHARD+ BYTE IBC,IBHX,IBLX,IBHY,IBLY,IZERO,NULL,LFCCC RETURN ENDLC---------------------------------------------------------------------------- SUBROUTINE SPOINT(NPT,AX,YA,NTYPE,SIZE)LC---------------------------------------------------------------------------C0C THIS SUBROUTINE PLOTS AN ARRAY OF POINTS WHERE#C NPT=NUMBER OF POINTS IN THE ARRAY"C AX= ARRAY OF DATA FOR THE X AXIS"C YA= ARRAY OF DATA FOR THE Y AXIS)C NTYPE=SYMBOL TO BE PLOTTED AT THE POINT'C SIZE=SIZE OF THE SYMBOL TO BE PLOTTEDC =C SPECIAL NOTE: THE VALUES OF XMIN,DX,YMIN,DY,OFFX,OFFY,XL,YL8C WHICH ARE REQUIRED FOR PLOTTING ARE INTERNALLY SET BY *C CALLING THE SUBROUTINES SCALE AND OFFSETCC6 COMMON /CRTLST/ XMIN,DX,YMIN,DY,OFFX,OFFY,XL,YL,XZ,YZ DIMENSION AX(NPT),YA(NPT) XEND=OFFX+XL YEND=OFFY+YL DO 1 I=1,NPT XPT=OFFX+(AX(I)-XMIN)*DX YPT=OFFY+(YA(I)-YMIN)*DY XPT=INT(XPT) YPT=INT(YPT) IF(XPT.GE.XEND) XPT=XEND IF(YPT.GE.YEND) YPT=YEND IF(XPT.LE.OFFX) XPT=OFFX IF(YPT.LE.OFFY) YPT=OFFY% CALL SYMBOL(XPT,YPT,SIZE,NTYPE) 1 CONTINUE RETURN ENDCCCLC--------------------------------------------------------------------------- SUBROUTINE STD4010LC---------------------------------------------------------------------------CC9C THIS SUBROUTINE SHIFTS THE DEC FROM VT-200 TO 4010 MODE*C BY SENDING APPROPRIATE CONTROL SEQUENCESCC+ CALL ERASE !START BY ERASING VT-100 SCREEN+ CALL TOUT(27) !ESC NOW SWITCH TO 4010 MODE CALL TOUT(91) ![ CALL TOUT(63) !? CALL TOUT(51) !3 CALL TOUT(56) !8 CALL TOUT(104)!h RETURN ENDCCCLC--------------------------------------------------------------------------- SUBROUTINE STI4010LC---------------------------------------------------------------------------CC>C THIS SUBROUTINE SHIFT THE INTECOLOR FROM VT-100 TO 4010 MODE*C BY SENDING APPROPRIATE CONTROL SEQUENCESCC IF(ITERM.NE.-1) GO TO 101 CALL ERASE !ESC START BY ERASING VT-100 SCREEN(10 CALL TOUT(29) !GS ENTER TEK 4010 MODE RETURN ENDCCCCCLC--------------------------------------------------------------------------- SUBROUTINE STI4027LC---------------------------------------------------------------------------CC?C THIS SUBROUTINE SHIFTS THE INTECOLOR FROM VT-100 TO 4027 MODE*C BY SENDING APPROPRIATE CONTROL SEQUENCESC! CALL STI4010 !INTO 4010 FIRST CALL TOUT(27) !ESC NOW TO 4027 CALL TOUT(34) !" CALL TOUT(54) !6 CALL TOUT(103)!gC5C INITIALIZE MONITOR AND WORKSPACE AND GRAPHICS AREASCB WRITE(7,10) !SEND 4027 SETUP COMMANDS FOR MONITOR & GRAPHICS AREA)10 FORMAT(' !WOR 28!GRA1,28!SHR Y!MON',/) RETURN ENDCLC--------------------------------------------------------------------------- SUBROUTINE STLSIRGLC---------------------------------------------------------------------------CCDC THIS SUBROUTINE SHIFT THE LEAR SIEGLER ADM FROM ASCII TO 4010 MODE*C BY SENDING APPROPRIATE CONTROL SEQUENCESCC . CALL TOUT(26) !SUB = START BY ERASING SCREEN& CALL TOUT(29) !GS ENTER TEK 4010 MODE RETURN ENDLC--------------------------------------------------------------------------- SUBROUTINE STPLESSLC---------------------------------------------------------------------------CC<C THIS SUBROUTINE SHIFT THE PLESSEY FROM VT-100 TO 4010 MODE*C BY SENDING APPROPRIATE CONTROL SEQUENCESCC IF(ITERM.NE.-1) GO TO 101 CALL ERASE !ESC START BY ERASING VT-100 SCREEN(10 CALL TOUT(29) !GS ENTER TEK 4010 MODE RETURN ENDLC--------------------------------------------------------------------------- SUBROUTINE STRTCRTLC---------------------------------------------------------------------------CC3C THIS SUBROUTINE READS THE TERMINAL TYPE AND SENDS/C THE APPROPRIATE CONTROL SEQUENCE TO SETUP THEC GRAPHICS DEVICE FOR PLOTTINGCC C COMMON BLOCKS FOR NELSCC5 COMMON /TERMIN/ ITERM,IBAUD,IPLOT,ICOLOR,IMODE,IHARDCCCA IF (IMODE.EQ.ITERM) RETURN !IF ALREADY IN CORRECT MODE THEN EXIT9 IF (ITERM.EQ.2) CALL STLSIRG !LSI ADM WITH RETROGRAPHICS, IF (ITERM.EQ.5) CALL STRTHP !HP7470 PLOTTER' IF (ITERM.EQ.6) CALL STRTLA !DEC LA1005 IF (ITERM.EQ.7) CALL STI4010 !INTECOLOR IN 4010 MODE5 IF (ITERM.EQ.8) CALL STI4027 !INTECOLOR IN 4027 MODE5 IF (ITERM.EQ.9) CALL STD4010 !DEC VT200 IN 4010 MODE; IF (ITERM.EQ.10)CALL STT4105 !TEK 4105/07/09 IN 4010 MODE. IF (ITERM.EQ.11)CALL STT4105 !TEK 4695 COPIER410 IMODE = ITERM !TELL PROGRAM WHICH MODE IT IS IN$ RETURN !TO AVOID CONFUSION LATER! END !ANSI TERMINAL IMODE = -1CCCLC--------------------------------------------------------------------------- SUBROUTINE STRTHPLC---------------------------------------------------------------------------C1C THIS SUBROUTINE INITIALIZES THE HP7470 HARDCOPY,C DEVICE FOR PRODUCING COPYIES OF THE GRAPHSC DISPLAYED ON THE CRT DEVICE=C IT IS ASSUMED THAT THE HP7470 IS LOCATED ON RT-11 DEVICE #89C AND CAN BE ACCESSED USING A STANDARD WRITE STATEMENT TOC A SERIAL HANDLER SUCH AS LS:C)C THE OPERATOR SHOULD "ASSIGN LS: TO 80"C BEFORE RUNNING GRAPHICSCC4 COMMON/TERMIN/ ITERM,IBAUD,IPLOT,ICOLOR,IMODE,IHARDC1C SETUP DEFAULT 'S FOR PLOT SIZE, CHARACTER SIZE,CC BYTE NESC,NPER,NON C NPER=46C NON=40 C NESC=27 !DEFINE TERMINATOR<C WRITE(80,999) NESC,NPER,NON !TURN ON PLOTTER IF IN Y MODEC999 FORMAT(1X,3A1) CALL TOUT(27) CALL TOUT(46) CALL TOUT(40) WRITE(80,1000) F1000 FORMAT(' IN; VS 25; IP 2150,825, 8150,6325;')!INIT, SPEED, LIMITS CALL DELAY(5) WRITE(80,1010)#1010 FORMAT( !SCALE FACTORS,PEN#&UP5 * ' SC 0,1024, 0,800; SR 1.3,2.;SP1;PU;PA 0,0;',! * ' PD;PA -100,1, -100,850, ; * 1050,850, 1050,1, -100,1;PU;')!DRAW FRAME,& LEAVE UP CALL DELAY(5) WRITE(80,1020) 1020 FORMAT(' DT',/,'; PU;')4 CALL DELAY(20) !WAIT A MINUTE BEFORE STARTING PLOT RETURN ENDCCLC--------------------------------------------------------------------------- SUBROUTINE STRTLALC---------------------------------------------------------------------------CC DO NOTHING YETC RETURN ENDCCLC--------------------------------------------------------------------------- SUBROUTINE STT4105LC---------------------------------------------------------------------------C0C THIS SUBROUTINE TAKES THE TEK 4105/07/09 INTO C 4010-1 MODEC CALL TOUT(27) !ESC CALL TOUT(37) !% CALL TOUT(33) !! CALL TOUT(48) !0C?C NOW DISABLE THE DIALOG AREA SO TEXT GETS PRINTED ON THE GRAPH;C AND NOT IN A SCROLLING REGION AT THE BOTTOM OF THE SCREEN;C THIS FUNCTION IS PERFORMED BY REVERTING TO THE ASCII MODE8C USING THE EXIT ROUTINE RATHER THAN THE TEK/DIALOG MODEC CALL TOUT(27) !ESC CALL TOUT(75) !K CALL TOUT(65) !A CALL TOUT(48) !0 RETURN END CLC---------------------------------------------------------------------------( SUBROUTINE SYMBOL (X,Y,HGHT,NTYPE)LC---------------------------------------------------------------------------6 COMMON /CRTLST/ XMIN,DX,YMIN,DY,OFFX,OFFY,XL,YL,XZ,YZC0C THIS SUBROUTINE DRAWS SYMBOLS AT THE POINT X,Y6C SIZE IS THE SIZE OF THE CHARACTER (WIDTH=HEIGHT) IN AC ABSOLUTE SCREEN UNITS . NTYPE IS THE TYPE OF SYMBOL TO BE DRAWNCCCC C 1=SQUAREC 2=TRIANGLEC 3= XC 4= +C 5= HEXAGONC 6=DIAMONDC 7=STAR C 8=CIRCLE&C 9=BAR DOWN FROM DATA POINT TO X-AXISC10=DOTC CALL TOUT(29) SIZE=HGHT/2. FLAG=0.# GO TO (1,2,3,4,5,6,7,9,10,9),NTYPECC DRAW SQUAREC 1 CALL XYTRAN(X-SIZE,Y+SIZE) CALL XYTRAN(X-SIZE,Y+SIZE) CALL XYTRAN(X+SIZE,Y+SIZE) CALL XYTRAN(X+SIZE,Y-SIZE) CALL XYTRAN(X-SIZE,Y-SIZE) CALL XYTRAN(X-SIZE,Y+SIZE) GO TO 99CC DRAW TRIANGLEC 2 HT=SIZE/1.7321 BHT=2*HT CALL XYTRAN(X,Y+BHT) CALL XYTRAN(X,Y+BHT) CALL XYTRAN(X+SIZE,Y-HT) CALL XYTRAN(X-SIZE,Y-HT) CALL XYTRAN(X,Y+BHT) GO TO 99CC DRAW XC 3 CALL XYTRAN(X-SIZE,Y+SIZE) CALL XYTRAN(X-SIZE,Y+SIZE) CALL XYTRAN(X+SIZE,Y-SIZE) CALL TOUT(29) CALL XYTRAN(X-SIZE,Y-SIZE) CALL XYTRAN(X-SIZE,Y-SIZE) CALL XYTRAN(X+SIZE,Y+SIZE) GO TO 99C C DRAW +C4 CALL XYTRAN(X,Y+SIZE) CALL XYTRAN(X,Y+SIZE) CALL XYTRAN(X,Y-SIZE) CALL TOUT(29) CALL XYTRAN(X-SIZE,Y) CALL XYTRAN(X-SIZE,Y) CALL XYTRAN(X+SIZE,Y)" IF (FLAG.EQ.1) CALL TOUT(29) IF (FLAG.EQ.1) GO TO 3 GO TO 99C'C DRAW STAR = X AND + SUPERIMPOSEDC 7 FLAG=1. GO TO 4CC DRAW HEXAGONC# 5 CALL XYTRAN(X-SIZE/2.,Y+SIZE)# CALL XYTRAN(X-SIZE/2.,Y+SIZE)# CALL XYTRAN(X+SIZE/2.,Y+SIZE)# CALL XYTRAN(X+SIZE,Y+SIZE/2.)# CALL XYTRAN(X+SIZE,Y-SIZE/2.)# CALL XYTRAN(X+SIZE/2.,Y-SIZE)# CALL XYTRAN(X-SIZE/2.,Y-SIZE)# CALL XYTRAN(X-SIZE,Y-SIZE/2.)# CALL XYTRAN(X-SIZE,Y+SIZE/2.)# CALL XYTRAN(X-SIZE/2.,Y+SIZE) GO TO 99CC DRAW DIAMONDC 6 CALL XYTRAN(X,Y+SIZE) CALL XYTRAN(X,Y+SIZE) CALL XYTRAN(X+SIZE,Y) CALL XYTRAN(X,Y-SIZE) CALL XYTRAN(X-SIZE,Y) CALL XYTRAN(X,Y+SIZE) GO TO 99CC DRAW .( DOT )C 8 CALL XYTRAN(X,Y) CALL XYTRAN(X,Y) GO TO 99CC DRAW CIRCLEC 9 CALL XYTRAN(X+SIZE,Y) ISTEP=9 IF(SIZE.GT.24) ISTEP=6 IF(SIZE.GT.48) ISTEP=4 IF(SIZE.GT.99) ISTEP=2 IF(SIZE.GT.150) ISTEP=1 DO 11 I=1,361,ISTEP THETA=0.0174533*(I-1) XPT=SIZE*COS(THETA) + X YPT=SIZE*SIN(THETA) + Y 11 CALL XYTRAN(XPT,YPT) GO TO 99CC DRAW BAR DOWN TO X-AXIS/C OF WIDTH =SIZE , DATA POINT AT LEFT MOST EDGEC 10 N=HGHT + 2 DO 20 I=1,N CALL TOUT(29) !RESET GRAPHICS XPT=X+(I-2) CALL XYTRAN(XPT,Y) CALL XYTRAN(XPT,Y) CALL XYTRAN(XPT,OFFY)20 CONTINUE CALL DELAY(1) GO TO 99CCC INSERT TIME DELAY CC 99 CALL DELAY(1) CALL TOUT(31) RETURN END@C--------------------------------------------------------------- SUBROUTINE TERMIN@C---------------------------------------------------------------;C SUBROUTINE WHICH DETERMINES THE TYPE OF GRAPHICS TERMINAL!C AVAILABLE ON THE CURRENT SYSTEMC0C THIS ROUTINE ACCESSES THE FILE "DK:TERMIN.DAT":C IF THE FILE DOESNOT EXIST DEFAULT PARAMETERS ARE DEFINEDC6C ITERM = CURRENT TERMINAL DEFINITION AS GIVEN BELOW,C IBAUD = BAUD RATE FOR GRAPHICS (110-19200)1C IPLOT = PLOT CONTROL PARAMETER FOR PERITEK MODE4C ICOLOR = COLOR CONTROL PARAMETER FOR PERITEK MODE:C IMODE = CURRENT MODE OF TERMINAL MAY DIFFER FROM ITERM7C IN SYSTEM WHICH CAN SWITCH BETWEEN DIFFERENT MODES>C IHARD = CURRENT DEVICE TYPE BEING USED FOR HARDCOPY OUTPUTC*C *' Terminal Definitions (ITERM & IHARD);C *' -----------------------------------------------------;C *' -3 = ASCII Terminal No graphics capabilities 32 column;C *' -2 = ASCII Terminal No graphics capabilities 80 column<C *' -1 = ANSI 3.64 Terminal (VT-100 Compatible) No graphics9C *' 0 = TEKTRONICS 4010-1,4014-1 (with hardware cursor)7C *' 1 = TEKTRONICS 4006 ,4010 (no hardware cursor)>C *' 2 = LEAR SIEGLER ADM-3,ADM-5 (with Retrographics RG-512)8C *' 3 = PERITEK VCG-512 Bit Map Color Graphics MonitorC *' 4 = TEKTRONICS 4027#C *' 5 = HP 7470A Hardcopy Plotter&C *' 6 = LA100/LA50 Hardcopy Graphics2C *' 7 = INTECOLOR VT-100 with 4010-1,4014-1 mode)C *' 8 = INTECOLOR VT-100 with 4027 mode,C *' 9 = DEC VT-200 with 4010-1,4014-1 mode,C *' 10 = TEKTRONICS 4105/07/09 IN 4010 MODE&C *' 11 = TEKTRONICS 4695 COLOR COPIER)C *' 12 = TEKTRONICS 4631/VERSATIC COPIERCCC< COMMON /TERMIN/ ITERM,IBAUD,IPLOT,ICOLOR,IMODE,IHARD,ILP(3)CCC IEFLAG=0> OPEN(UNIT=11,NAME='DAT:TERMIN.DAT',TYPE='OLD',DISPOSE='SAVE',$ c ACCESS='SEQUENTIAL',ERR=100)! READ(11,10) ITERM !TERMINAL TYPE10 FORMAT(23X,I2) READ(11,20) IBAUD !BAUD RATE20 FORMAT(23X,I5)8 READ(11,10,END=21,ERR=21) IHARD !HARDCOPY TERMINAL TYPE21 IEFLAG=1 CLOSE (UNIT=11,DISPOSE='SAVE') GO TO 110C$C OPEN FAILS FOR FILE DAT:TERMIN.DAT.C SET DEFAULT TO TEKTRONICS 4010 AT 9600 BAUDC100 ITERM=0 IBAUD=9600 IHARD=99110 IPLOT=0 ICOLOR=15 IMODE=-1 WRITE(7,29)29 FORMAT(/, c ' Definitions :',/, c ' ------------') WRITE(7,291)"291 FORMAT($,' Terminal Device: ') IF(ITERM.EQ.-3) WRITE (7,300) IF(ITERM.EQ.-2) WRITE (7,301) IF(ITERM.EQ.-1) WRITE (7,302) IF(ITERM.EQ.0) WRITE (7,30) IF(ITERM.EQ.1) WRITE (7,31) IF(ITERM.EQ.2) WRITE (7,32) IF(ITERM.EQ.3) WRITE (7,33) IF(ITERM.EQ.4) WRITE (7,34) IF(ITERM.EQ.5) WRITE (7,35) IF(ITERM.EQ.6) WRITE (7,36) IF(ITERM.EQ.7) WRITE (7,37) IF(ITERM.EQ.8) WRITE (7,38) IF(ITERM.EQ.9) WRITE (7,39) IF(ITERM.EQ.10)WRITE (7,3910) WRITE(7,2910)%2910 FORMAT(/,$,' Hardcopy Device: ')o IF(IHARD.GE.99) WRITE (7,3920) IF(IHARD.EQ.-3) WRITE (7,300) IF(IHARD.EQ.-2) WRITE (7,301) IF(IHARD.EQ.-1) WRITE (7,302) IF(IHARD.EQ.0) WRITE (7,30) IF(IHARD.EQ.1) WRITE (7,31) IF(IHARD.EQ.2) WRITE (7,32) IF(IHARD.EQ.3) WRITE (7,33) IF(IHARD.EQ.4) WRITE (7,34) IF(IHARD.EQ.5) WRITE (7,35) IF(IHARD.EQ.6) WRITE (7,36) IF(IHARD.EQ.7) WRITE (7,37) IF(IHARD.EQ.8) WRITE (7,38) IF(IHARD.EQ.9) WRITE (7,39) IF(IHARD.EQ.10)WRITE (7,3910) IF(IHARD.EQ.11)WRITE (7,3911) IF(IHARD.EQ.12)WRITE (7,3912)5300 FORMAT(' -3 = ASCII Terminal Width = 32 Column')c5301 FORMAT(' -2 = ASCII Terminal Width = 80 Column')-6302 FORMAT(' -1 = ANSI x3.64 Non-Graphics Terminal')430 FORMAT(' 0 = TEKTRONICS 4010-1,4014-1 Terminal')431 FORMAT(' 1 = TEKTRONICS 4006 ,4010 Terminal')432 FORMAT(' 2 = LSI ADM-3A/5A RG-512 Terminal')433 FORMAT(' 3 = PERITEK VCG-512 Bit-Map Monitor')434 FORMAT(' 4 = TEKTRONICS 4027 Color Terminal')435 FORMAT(' 5 = HP 7470A Hardcopy X-Y Plot')436 FORMAT(' 6 = LA100/LA50 Hardcopy Graphics Plot')437 FORMAT(' 7 = INTECOLOR VT-100/TEK4010 Terminal')438 FORMAT(' 8 = INTECOLOR VT-100/TEK4027 Terminal')439 FORMAT(' 9 = DEC VT-220 / TEK4010-1, Terminal')63910 FORMAT(' 10 = TEKTRONICS 4105/7/9/4010 Terminal')73911 FORMAT(' 11 = TEKTRONICS 4695 Color Copier') R63912 FORMAT(' 12 = TEKTRONICS/VERSATEC Video Copier')*3920 FORMAT(' = No Graphics Hard Copy') WRITE (7,4000) IBAUDp$4000 FORMAT(/,' Baud Rate : ',I6) WRITE(7,40) 40 FORMAT(//,i& c $,' Change Definitions [N]? ') READ(5,50) ANSn50 FORMAT(1A1) IF(ANS.NE.'Y') RETURNCiGC LIST OUT OPTIONS FOR USER USING ABOVE FORMAT STATEMENTS TO SAVE SPACEiC WRITE(7,29) !TITLEe% WRITE(7,300) !NON GRAPHICS TERMINALS. WRITE(7,301)o WRITE(7,302) WRITE(7,30) !GRAPHICS TERMINALS WRITE(7,31) WRITE(7,32) WRITE(7,33) WRITE(7,34) WRITE(7,35) WRITE(7,36) WRITE(7,37) WRITE(7,38) WRITE(7,39) WRITE(7,3910) WRITE(7,3911) WRITE(7,3912)Ce(C NOW LET HIM/HER TELL US WHICH HE WANTSCk WRITE(7,60)*60 FORMAT(/,$,' Enter Terminal Device : ') READ(5,70) ITERM 70 FORMAT(I3)r WRITE(7,92) i*92 FORMAT( $,' Enter Hardcopy Device : ') READ(5,70) ITEM IF(ITEM.NE.0) IHARD=ITEMeCC IF(((ITEM.EQ.5).OR.(ITEM.EQ.6).OR.(ITEM.EQ.11)).OR.(ITEM.EQ.12)) *C 1IHARD=ITEM ! ONLY 3 TYPES AVAILABLE YET WRITE(7,80)*80 FORMAT( $,' Enter Baud Rate : ') READ(5,90) ITEM IF(ITEM.NE.0) IBAUD=ITEMl 90 FORMAT(I6)e: IF(IBAUD.GT.32767) IBAUD=32677 !MAXIMUM BAUD RATE ALLOWED# IF(IBAUD.LE.0) IBAUD=9600 !DEFAULTeC Cm7C THE USER HAS JUST CHANGED THE TERMINAL DEVICE MAKE ITp6C PERMANENT ON HIS DISK FOR HIM BY EITHER CREATING THE2C TERMIN.DAT FILE IF IT DIDN'T EXIST (IEFLAG=1) BY4C WRITING THE FIRST THREE LINES OF THE EXISTING FILEC WITH THE NEW PARAMETERSClCo?C IF(IEFLAG.EQ.1) OPEN(UNIT=11,NAME='DK:TERMIN.DAT',TYPE='OLD',n,C c DISPOSE='SAVE',ACCESS='SEQUENTIAL')?C IF(IEFLAG.EQ.0) OPEN(UNIT=11,NAME='DK:TERMIN.DAT',TYPE='NEW',u5C c DISPOSE='SAVE',ACCESS='SEQUENTIAL',ERR=1000) C IF(IEFLAG.EQ.1) REWIND 11eC WRITE (11,1001) ITERMC WRITE (11,1002) IBAUDaC WRITE (11,1003) IHARDa+C1001 FORMAT(' GRAPHICS TERMINAL TYPE:',I2) +C1002 FORMAT(' BAUD RATE FOR GRAPHICS:',I5)t-C1003 FORMAT(' HARDCOPY DEVICE TYPE:',I2,/,nCCe C CLOSE (UNIT=11,DISPOSE='SAVE')CTCfCoCg GO TO 1101000 RETURNo END C CMLC--------------------------------------------------------------------------- SUBROUTINE TICShLC---------------------------------------------------------------------------C CC THIS SUBROUTINE DRAWS TIC MARKS ALONG THE X AND Y AXIS OF A GRAPHR3C USING THE VALUES OBTAINED FROM THE OFFSET ROUTINE-C XL=X AXIS LENGTHC YL=Y AXIS LENGTH%C NOTE THAT THE TIC MARKS ALWAYS HAVEN)C THE SAME DENSITY ALONG THE VARIOUS AXIIT/C THAT IS THERE ARE ALWAYS THE SAME NUMBER (20) ,C AND ALTERNATE ONES ARE OF DIFFERENT LENGTHC CO6 COMMON /CRTLST/ XMIN,DX,YMIN,DY,OFFX,OFFY,XL,YL,XZ,YZ5 COMMON /TERMIN/ ITERM,IBAUD,IPLOT,ICOLOR,IMODE,IHARD0 IX=OFFX IY=OFFY) IEX=IX+XLC IEY=OFFY+YL INCX=-XL/20.C=C DRAW X AXIS TICS CT IF(ITERM.EQ.5) CALL DELAY(10) DO 1 I=IEX,IX,INCX S=1. A=(I-IX)*10./XL0 IF(A.EQ.INT(A)) S=2. TCLGTH=10.*S YPT=OFFY-TCLGTHG XPT=I7 YPT=INT(YPT) CALL TOUT(29)d CALL XYTRAN(XPT,OFFY)i CALL XYTRAN(XPT,OFFY)0 CALL XYTRAN(XPT,YPT) IF(ITERM.EQ.5) CALL DELAY(5)h CALL TOUT(31) IF(ITERM.EQ.5) CALL DELAY(5) 1 CONTINUECRC DRAW Y AXIS TICS3CT INCY=YL/20.R DO 2 J=IY,IEY,INCY S=1. A=(J-IY)*10./YL IF(A.EQ.INT(A)) S=2. TCLGTH=10.*S XPT=OFFX-TCLGTH YPT=JR XPT=INT(XPT) CALL TOUT(29)- CALL XYTRAN(OFFX,YPT)- CALL XYTRAN(OFFX,YPT) CALL XYTRAN(XPT,YPT) IF(ITERM.EQ.5) CALL DELAY(1)e CALL TOUT(31): IF(ITERM.EQ.5) CALL DELAY(5) 2 CONTINUE0 IF(ITERM.EQ.5)REWIND 80 !DUMP STUFF TO PLOTTER RETURN ENDgIC------------------------------------------------------------------------ & SUBROUTINE TINPUT(IC,IHX,ILX,IHY,ILY)IC------------------------------------------------------------------------2C C ,C FORTRAN SUBROUTINE TO REPLACE TINPUT.MAC Cr4C THIS ROUTINE READS IN THE HIGH/LOW COORDINATES OF <C A POINT DEFINED BY THE CURSOR OF A TEK 4010/4027 EMULATING;C TERMINAL. THE TERMINAL MUST HAVE ALREADY BEEN PLACED IN =C GRAPHICS INPUT MODE (GIN) BY THE HOST SENDING AN _{t<C SEQUENCE TO THE TERMINAL WHICH TURNS ON THE CROSSHAIR MODECECfCaC >C 1-APR-85 NESTOR !OPERATION OKAY IN 4010 MODE EXCEPT FOR 9C 1-APR-85 NESTOR !CHANGE MODE TO ONLY = READ CURSOReBC 2-APR-85 NESTOR !CLEAN UP OPERATION IN 4027 MODE FOR = READCC 4-APR-85 NESTOR !SUBROUTINE NOW WORKS WITH ANY KEYBOARD CHARACTERNC !INCLUDING C-C-,C NOTE: THE TERMINAL IS EXPECTED TO RESPOND <C IN ONE OF TWO WAYS: IN THE FIRST MANNER AFTER THE TERMINAL8C RECEIVES A GIN COMMAND _{THE ENTERING OF ANY 8C ALPHANUMBERIC CHARACTER ON THE KEYBOARD RESULTS IN THE6C TRANSMISSION OF A 5 CHARACTER (1BYTE/EACH) SEQUENCE:;C FOLLOWED BY A GRAPHICS TRAILER CODE = AS SHOWN BELOWT.C CHR, HIGHX, LOWX, HIGHY, LOWY 3C THE TRAILER CODE IS PRESET BY THE TERMINAL FOR G(C THE INTECOLOR 2427 IT IS A SINGLE CDC SPECIAL NOTE: IN METHOD 1 ENTERING ONLY A INSTEAD OF A VALID 7C ALPHANUMERIC CHARACTER RETURNS GARBAGE TO THE SYSTEM CW0C USING THE FIRST READ SUBROUTINE AS IMPLEMENTED>C BELOW THE OPERATOR ENTERS A VALID ALPHANUMERIC KEY (A-Z,0-9)>C AFTER WHICH THE TERMINAL TRANSMITTS ITS 5 CHARACTER SEQUENCE0C OF CORRDINATES THIS SEQUENCE OF HIGH/LOW BYTES>C IS THEN DECODED BY THE CRSSHR SUBROUTINE TO YIELD THE ACTUAL:C (I.E. ABSOLUTE) X,Y, COORDINATES OF THE POINT DEFINED BYC THE CROSSHAIR INTERSECTIONC-C-AC IN THE SECOND OPERATIONAL MODE THE HOST SENDS A STATUS ENQUIRY-AC AND THE TERMINAL RESPONDS (IF IT IS IN THE GIN MODE)-,C BY SENDING A 4 BYTE CHARACTER SEQUENCE OF:*C HIGHX, LOWX, HIGHY, LOWY >C FOR THE CROSSHAIR LOCATION. TRANSLATION IS IDENTICAL TO THE?C FIRST METHOD. IN THIS PROCEDURE WE ALLOW THE OPERATOR TO TELLA=C THE SYSTEM HE IS READY TO READ THE COORDINATES BY PLACING AH>C NONUSED READ STATEMENT JUST BEFORE THE SO THAT WE5C HAVE A CHANCE TO LOCATE THE CURSOR WHERE WE WANT ITMC,CRAC THIS VERSION IMPLEMENTS A COMBINATION OF THE 1ST & 2ND METHODSYCNCN"C COMMON BLOCKS for NGRAPHCLCY5 COMMON /TERMIN/ ITERM,IBAUD,IPLOT,ICOLOR,IMODE,IHARDQ+ BYTE IBC,IBHX,IBLX,IBHY,IBLY,IZERO,NULL,LF LF=10 NULL=0 IBC=NULLE IBHX=NULL !SET DEFAULTS
IBHY=NULL
IBLX=NULL
IBLY=NULLCLCEC C@C LET THE USER POSITION CROSSHAIRS AND ENTER A RETURN WHEN READY2C BY WAITING FOR THE READ STATEMENT TO BE EXECUTEDCCEC> READ (5,100) IBC,IBHX,IBLX,IBHY,IBLY !METHOD 1 USES ALL THESE100 FORMAT (5(A1))CRCI4C CHECK TO SEE IF THE USER HIT A IF HE DID THEN9C ALL THE VARIABLES WILL BE => ADE=32 I FOUND THIS-:C OUT THE HARD WAY BY PRINTING OUT THE VARIABLES AFTER THE=C READ STATEMENT USING THE WRITE STATEMENT AT THE END OF THISIC SUBROUTINE !!C C > IF((((IBHX.EQ.' ').AND.(IBLX.EQ.' ')).AND.((IBHY.EQ.' ').AND.1 C(IBLY.EQ.' '))).AND.(IBC.EQ.' ')) GO TO 1159CR=C NO THEN IT MUST BE AN ASCII CHARACTER & LIFE IF SIMPLE 8C JUST TRANSLATE THE ASCII CHARACTERS TO WORDS AND EXIT C( GO TO 200 !USER ENTERED AN ASCII CHAR.C-C-CC THE REMAINING CODE UP TO STATEMENT LABEL 200 IS FOR METHOD 2 ONLY C CU<C THERE IS A POSIBILITY FOR CONFUSION HERE SINCE IF THE USER9C ENTERS A THEN IBC WILL CONTAIN IBHX AND EVERYTHING=C WILL BE SHIFTED DOWN ONE VARIABLE IN THE PREVIOUS READ LIST CC THIS WILL RESULT IN THE INCORRECT TRANSLATION OF THE COORDINATES.=?C FOR THE MOMENT WE WILL LIVE WITH THIS PROBLEM AS IT HOPEFULLY EC WILL NOT OCCUR TOO OFTEN. IT IS NOT OBVIOUS TO ME HOW TO CIRCUMVENTEC THIS TYPE OF PROBLEM ALL OTHER ASCII CHARACTER APPEAR TO WORK OKAY.IC?C AN EXTRA WILL BE INSERTED BY THE TRAILER. IN ORDER THAT 7C THE REST OF THIS ROUTINE WORKS CORRECTLY WE MUST GET TC RID OF THE EXTRA WHICHA;C RESULTS AND SO THE FOLLOWING READ STATEMENT WAS INSERTED. CBC(3C READ IN A DUMMY CHARACTER HERE FOR 4010 MODENC OR >C READ IN THE 4 BYTE CHARACTER SEQUENCE FOR 4027 MODE AND THEN-C GET OUT OF THE SECTION BY BRANCHING TO 200O2C NOTE: I ONLY FOUND OUT THIS BY PRINTING OUT THE2C ADE OF EACH READ STATEMENT TO FIND OUT WHAT THE4C PROBLEM WAS IN THIS ROUTINE WHEN RUNNING IN 4027 <C ASCII MODE USING THE 4010 PROTICAL ALA INTECOLOR TERMINALCSCRC C 6115 READ (5,100) IBHX,IBLX,IBHY,IBLY !READ EXTRA CI C DEBUGGING WRITE STATEMENT HEREC &C WRITE(8,103) IBC,IBHX,IBLX,IBHY,IBLY(C103 FORMAT(' 103 IBC......=',5(I2,1X))CAC BRANCH TO 200 IF 4027ICC+ IF((ITERM.EQ.4).OR.(ITERM.EQ.8)) GO TO 200BCY"C NOT 4027 BUT 4010 WE CONTINUE ONCSC&>C WE NOW FORCE THE TERMINAL TO GIVE US THE CROSSHAIR LOCATION ?C BY RESETTING THE GS AND GIN MODES AND READING THE GIN STATUS RC CM6 CALL TOUTPT(27) !GO BACK TO GIN MODE USING _{CALL TOUTPT(26)CT1C NOW FORCE THE ISSUE WITHOUT THE USER KNOWING IT 9C THIS MAY CAUSE THE TERMINAL CURSOR TO BLINK MOMENTAIRLYACT, CALL TOUTPT(27) !REQUEST STATUS OF TERMINAL= CALL TOUTPT(5) !THIS SEND A REPORT OF CROSSHAIR COORDINATESL5C !I.E. 4 BYTE SEQUENCE (WITHOUT LEADING CHARACTER),CRC READ THESE INTO THE PROGRAML0C MUST HAVE TRAILER CODES FROM THE TERMINAL EC FOR THIS READ STATEMENT TO BE EXECUTED WITHOUT OPERATOR KNOWING IT'C READ(5,100) IBHX,IBLX,IBHY,IBLYC'C DEBUGGING WRITE STATEMENTYC&C WRITE(8,103) IBC,IBHX,IBLX,IBHY,IBLYCECCRC CONVERT BYTES TO WORDSC200 IHX=IBHX ILX=IBLX IHY=IBHY ILY=IBLYSCX>C THE FOLLOWING WRITE STATEMENT IS FOR DEBUGGING PURPOSES ONLY?C TO SEE WHAT CHARACTERS (ADE'S) ARE BEING RECEIVED BY THE HOSTSCP&C WRITE(8,101) IBC,IBHX,IBLX,IBHY,IBLY(C101 FORMAT(' IC,HX,LX,HY,LY=',5(I2,1X))
C REWIND 8C!2C ALL DONE TRANSLATE BACK IN THE CROSSHAIR ROUTINEC. RETURNP ENDCCC LC--------------------------------------------------------------------------- SUBROUTINE TOUT (N)LC---------------------------------------------------------------------------CL5 COMMON /TERMIN/ ITERM,IBAUD,IPLOT,ICOLOR,IMODE,IHARDECO4C THIS SUBROUTINE ALLOWS THE GRAPHICS MODE TO CHOOSE8C BETWEEN TEKTRONICS EQUIVALENT OUTPUT AND THAT REQUIRED:C BY THE PERITEK BIT MAP GRAPHICS BY SETTING THE VALUE OF ?C IPLOT TO ZERO (0) TO DISABLE PLOTTING IN THE PERITEK TERMINALDCS IF(N.EQ.29) IPLOT=0 IF(N.EQ.31) IPLOT=0< IF(ITERM.NE.3) CALL TOUTPT(N) !NORMAL OUTPUT IF NOT PERITEK. IF(ITERM.NE.3) RETURN !RETURN IF NOT PERITEK4C IPLOT FLAGS ARE BEING SET FOR LINE MODE OPERATION RETURNC ENDMC----------------------------------------------------------------------------L SUBROUTINE TOUTPT (N)MC----------------------------------------------------------------------------YC "C 31-MAR-85 NJZ VERSION 1 (RT-11))C 9 -APR-85 NJZ VERSION 2 (VAX DEBUGGED) NCX9C THIS SUBROUTINE IS THE FORTRAN EQUIVALENT OF TOUTPT.MACYCLEC THIS SUBROUTINE TRANSMITS THE CHARACTER (N) IN ASCII DECIMAL EQUIV.P?C TO THE TEKTRONICS TERMINAL IN ORDER TO CONTROL ITS OPERATIONDC )C LUNIT = LOGICAL UNIT NUMBER OF TERMINAL,!C NULL = NULL CHARACTER FOR FILLL:C N = DECIMAL EQUIVALENT OF ASCII CHARACTER TO BE SENTCLCLCX"C COMMON BLOCKS for NGRAPHCLC 7C COMMON /CRTLST/ XMIN,DX,YMIN,DY,OFFX,OFFY,XL,YL,XZ,YZ-5 COMMON /TERMIN/ ITERM,IBAUD,IPLOT,ICOLOR,IMODE,IHARD-"C COMMON /LABEL/ ILX,ILY,NILX,NILYC-C-C- INTEGER LUNIT, NULL,PLUS- DATA NULL,LUNIT /0,7/C REWIND (LUNIT)CTCH?C SPECIAL NOTE: IF YOUR COMPUTER (ALA THE VAX) KEEPS TRACK OFD?C TERMINAL CHARACTERISTICS AND APPENDS A IF THE NUMBERAC OF CHARACTERS TRANSMITTED EXCEEDS THE LINE LENGTH THEN YOU WILL2?C HAVE PROBLEMS. IN THIS SITUATION YOU SHOULD SET THE TERMINAL-C TO NOWRAP CONDITIONSC-C WRITE (LUNIT,20) NULL,N20 FORMAT($,A1,A1)-C-AC A $ CARRIAGE CONTROL CHARACTER IS NEEDED TO REMOVE THE T?C COMBINATION FROM THE NORMAL TT OUTPUT , IF IT IS REMOVED THISM:C ROUTINE WILL NOT FUNCTION PROPERLY ON RT11 BASED SYSTEMSCP RETURNN END ECEC4LC---------------------------------------------------------------------------$ SUBROUTINE TRANXY(X,Y,XPT,YPT)LC---------------------------------------------------------------------------C48C THIS SUBROUTINE CONVERTS ABSOLUTE SCREEN COORDINATES >C OBTAINED BY USING THE CROSSHAIR INTO DATA VALUES APPROPRIATE9C TO THE LAST SET OF SCALE FACTORS USED FOR PLOTTING DATAA%C X=ABSOLUTE SCREEN COORDINATE X AXISE#C Y= " " " Y " C XPT= DATA VALUE X AXISC YPT= DATA VALUE Y AXISCOCO; COMMON /CRTLST/ XMIN,DX,YMIN,DY,OFFX,OFFY,XL,YL,XZ,YZ XPT=(X-OFFX)/DX + XMIN YPT=(Y-OFFY)/DY + YMIN RETURN ENDTC1CHC----------------------------------------------------------------------- SUBROUTINE VECTOR (X1,Y1,X2,Y2)HC-----------------------------------------------------------------------C0CN4C THIS SUBROUTINE DRAWS A VECTOR BETWEEN THE POINTS C (X1,Y1) AND (X2,Y2) C-1C X = X AXIS ABSOLUTE SCREEN COORDINATES (0-1023)S1C Y = Y AXIS ABSOLUTE SCREEN COORDINATES (0- 759)-C-C-5 COMMON /TERMIN/ ITERM,IBAUD,IPLOT,ICOLOR,IMODE,IHARDB IF(ITERM.LT.0) RETURN CALL TOUT(31)! CALL TOUT(29) !TURN ON GRAPHICSM CALL XYTRAN (X1,Y1) CALL XYTRAN (X1,Y1) CALL XYTRAN (X2,Y2)" CALL TOUT(31) !TURN OFF GRAPHICS RETURN ENDCSCHIC------------------------------------------------------------------------N SUBROUTINE VECREL (DX,DY)IC------------------------------------------------------------------------NCQC'?C THIS SUBROUTINE DRAW A CONTINOUS VECTOR LINE FROM THE CURRENT54C GRAPHICS BEAM LOCATION TO A NEW RELATIVE LOCATION =C BY FINDING THE CURRENT POSITION AND THEN COMPUTING THE NEW C5C POSITION (WHICH THE SUBROUTINE FINDS OUT BY SENDING-8C AN STATUS REQUEST ENQUIRY), TO THE POSITION X+DX,Y+DY C-C*C ------------------'C SPECIAL NOTE-*C ------------------CE8C THIS ROUTINE DOESNOT FUNCTION FOR 4027 TERMINALS !!!!!CE=C DX= ABSOLUTE DISPLACEMENT SCREEN COORDINATE X-AXIS (0-1023).<C DY= ABSOLUTE DISPLACEMENT SCREEN COORDINATE Y-AXIS (0-749)C,C0"C COMMON BLOCKS for NGRAPHC CP5 COMMON /TERMIN/ ITERM,IBAUD,IPLOT,ICOLOR,IMODE,IHARD, BYTE IBC,IBHX,IBLX,IBHY,IBLY, IF(ITERM.LT.0) RETURN$ IF(ITERM.EQ.4.OR.ITERM.EQ.8) RETURNCMC0BC WE NOW FORCE THE TERMINAL TO GIVE US THE GRAPHICS BEAM LOCATION <C BY RESETTING THE GS MODES AND READING THE TERMINAL STATUS C5C,CCC1 CALL TOUT (29) !GO TO GRAPHICS MODE USING -C-1C NOW FORCE THE ISSUE WITHOUT THE USER KNOWING IT-<C NOTE IN GIN/GRAPHICS/TEXT MODES THE REPORTS ARE DIFFERENT!C-8 IF((ITERM.NE.4).OR.(ITERM.NE.8)) CALL R4010 (XGBP,YGBP)9C IF((ITERM.EQ.4).OR.(ITERM.EQ.8)) CALL R4027 (XGBP,YGBP) ,C IF((ITERM.EQ.4).OR.(ITERM.EQ.8)) GO TO 100C 7C NOW THAT WE HAVE Graphics Beam Positions USE THE INFO CO CALL TOUT(29) !GRAPHICS ONC CALL XYTRAN (XGBP,YGBP) !OLD COORDINATES OF Graphics Beam PositionC1 CALL XYTRAN (XGBP,YGBP) !SEND TWICE FOR PLOTTING91 CALL XYTRAN (XGBP + DX,YGBP + DY) !NEW END POINTHF IF((ITERM.NE.4).OR.(ITERM.NE.8)) CALL TOUT (31) !TURN OFF VECTOR MODEC>C THE FOLLOWING WRITE STATEMENT IS FOR DEBUGGING PURPOSES ONLY?C TO SEE WHAT CHARACTERS (ADE'S) ARE BEING RECEIVED BY THE HOSTRC&C WRITE(8,101) IBC,IBHX,IBLX,IBHY,IBLY.C101 FORMAT(' 101 = IC,HX,LX,HY,LY=',5(I2,1X))
C REWIND 8CIC ALL DONE OCC RETURNR ENDLC--------------------------------------------------------------------------- SUBROUTINE VT1000LC---------------------------------------------------------------------------C0CI6C THIS SUBROUTINE RETURNS ALL EMULATORS TO VT-100 MODECQC'CC C COMMON BLOCKS FOR NELSC(C.5 COMMON /TERMIN/ ITERM,IBAUD,IPLOT,ICOLOR,IMODE,IHARD'C CLC IMODE=-1IA IF(ITERM.EQ.2) CALL ENLSIRG !EXIT LSI/ADM RETROGRAPHICS TO ASCIIS% IF(ITERM.EQ.5) CALL ENDHP !EXIT HPI( IF(ITERM.EQ.6) CALL ENDLA !EXIT LA1006 IF(ITERM.EQ.7) CALL ENI4010 !EXIT INTECOLOR 4010 MODEA IF(ITERM.EQ.8) CALL ENI4010 !EXIT INTECOLOR 4027 MODE USING 4010S0 IF(ITERM.EQ.9) CALL END4010 !EXIT DEC 4010 MODE5 IF(ITERM.EQ.10)CALL ENT4105 !EXIT TEK 4105/4107/4109L RETURN7 ENDCLCOLC--------------------------------------------------------------------------- SUBROUTINE XYHP(IX,IY)-LC---------------------------------------------------------------------------CSCX=C THIS SUBROUTINE TRANSMITS CORRDINATES TO THE HP7470 PLOTTER-(C IN THE APPROPRIATE FORMAT FOR PLOTTING+C PLOTTER IS ASSUMED TO BE RT-11 DEVICE #80SCR5 COMMON /TERMIN/ ITERM,IBAUD,IPLOT,ICOLOR,IMODE,IHARDR&10 IF(IPLOT.LE.0.4) WRITE(80,20) IX,IY" IF(IPLOT.GE.1) WRITE(80,30) IX,IY IPLOT=IPLOT+1 IF(IPLOT.GT.2) IPLOT=1"20 FORMAT(' PU;PA ',I4,',',I4,';')"30 FORMAT(' PD;PA ',I4,',',I4,';') CALL DELAY(5) RETURNT ENDKC--------------------------------------------------------------------------I#C BUSY BODY ROUTINES DO NOTHING YET*CXLC--------------------------------------------------------------------------- SUBROUTINE XYLA(IX,IY)E RETURNM ENDC CRCICMLC--------------------------------------------------------------------------- SUBROUTINE XYPTEK(X,Y)3LC---------------------------------------------------------------------------5 COMMON /TERMIN/ ITERM,IBAUD,IPLOT,ICOLOR,IMODE,IHARD C=4C THIS ROUTINE REPLACES XYTRAN IF TERMINAL = PERITEKC( CALL GCRS(-1) !DISABLE GRAPHICS CURSOR) NPV=-1 !DONOT ALLOW PIXEL VALUE CHANGE-4 IF(IPLOT.GT.0) NPV=ICOLOR !ALLOW PIXEL VALUE CHANGE. IX=X/2 !SCALE THINGS FOR 512X512 RESOLUTION+ IY=Y/2 !INSTEAD OF 1024X1024 = 4010 MODEA, CALL SETPV(0,NPV) !TELL PERITEK PIXEL MODE< IF(IPLOT.LE.0) CALL PNT(IX,IY)!MOVE TO POINT BUT DONOT PLOT: IF(IPLOT.GT.0) CALL DRAW(IX,IY)!DRAW FROM LAST TO PRESENT IPLOT=IPLOT+1 IF(IPLOT.GE.2) IPLOT=1E RETURND END COC CALC--------------------------------------------------------------------------- SUBROUTINE XYTRAN(X,Y)LC---------------------------------------------------------------------------5 COMMON /TERMIN/ ITERM,IBAUD,IPLOT,ICOLOR,IMODE,IHARD<C C CHECK FOR TERMINAL TYPEHCR4 IF(ITERM.EQ.3) CALL XYPTEK(X,Y)!TERMINAL = PERITEK ; IF(ITERM.EQ.3) RETURN !TERM = PERITEK SKIP REST OF ROUTINE CI6C THIS SUBROUTINE TRANSMITS COORDINATE INFORMATION9C TO THE TEKTRONIX TERMINAL IN THE APPROPRIATE MANNER,C $C BREAK UP X,Y INTO HI/LO COMPONENTS
IX=X
IY=Y4 IF(ITERM.EQ.5) CALL XYHP(IX,IY)!TERM=HP7470 PLOTTER IF(ITERM.EQ.5) RETURN+ IF(ITERM.EQ.6) CALL XYLA(IX,IY)!TERM=LA1008 LOX=MOD(IX,32)+64S IHOX=MOD(IX/32,32)+32U LOY=MOD(IY,32)+96U IHOY=MOD(IY/32,32)+32CC TRANSMITT TO TEKSCOPEH CALL TOUT(IHOY)K CALL TOUT(LOY) CALL TOUT(IHOX)U CALL TOUT(LOX) RETURN END}}}