! ERCC GRAPHPACK - Malcolm Brown - Moved to VAX AUG 80 by JGH (RCO version) ! Updated May 82 to bring JCL into line with ERCC version. CONSTINTEGER PLTRS=6,DEFPLTR=1,DEFSYM=5,NSYMS=15,DOT=11,DEFCH='-' constinteger DEFCLR=1,CLRS=11,SPJOB='U',SYSFIL=96,CONTROL=M'CTRL',CLEAR=M'OUT' constinteger ABSVEC=32,SV=63,SVB=1,MV=8191,MVB=2,LV=32767,LVB=3,NULL=64 constinteger NEWFILE=65,NEWSTEP=66,PENSELECT=67,PENINFO=68,OPMESS=69,OPDIR=70 constinteger HWCHARS=71,HWCHPARS=72,CLOSE=127,BUFF1=1,BUFF2=2,BEND=80 CONSTBYTEINTEGERARRAY PENCODE(1:44)= C 0,0,1,0, 0,2,1,2, 0,3,1,3, 0,1,1,1, 1,0,0,4, 1,0,1,5, 1,0,2,6, 1,0,3,7, 1,0,4,7, 1,0,5,7, 1,0,7,7 !%CONSTBYTEINTEGERARRAY GRETOI(0:255)= %C ! 208(14),25, ! 24, 23, 8, 17, 2, 9, 10, 3, 4, 95, 0, 28, 30, 19, 18, ! 126, 1,125,123,172,176,181,168,183,182,184,171,161,164,165, ! 167, 14, 15,146, 5, 6, 7,132, 91, 93, 92,163, 22, 26, 27, ! 16, 21,226, 11, 32, 65, 66, 67, 68, 69, 70, 71, 72, 73, 20, ! 46, 60, 40, 43,124, 38, 74, 75, 76, 77, 78, 79, 80, 81, 82, ! 33,127, 42, 41, 59,227, 45, 47, 83, 84, 85, 86, 87, 88, 89, ! 90, 31, 44, 37, 29, 62, 63, 48, 49, 50, 51, 52, 53, 54, 55, ! 56, 57, 58, 35, 64, 39, 61, 34, 36, 97, 98, 99,100,101,102, ! 103,104,105,161,162,163,164,165,166,154,106,107,108,109,110, ! 111,112,113,114,167,168,169,170,171,172,194,208,115,116,117, ! 118,119,120,121,122,173,174,175,176,177,178, 96, 94,208,208, ! 208,208,208,208,208,208,179,180,181,182,183,184,208, 65, 66, ! 67, 68, 69, 70, 71, 72, 73,129,130,131,132,133,134,208, 74, ! 75, 76, 77, 78, 79, 80, 81, 82,135,136,137,138,139,140,224, ! 225, 83, 84, 85, 86, 87, 88, 89, 90,141,142,143,144,145,146, ! 48, 49, 50, 51, 52, 53, 54, 55, 56, 57,147,148,149,150,151,152 CONSTSTRING(11)ARRAY RT(-15:15)= C "GRPAPR","MERGGR","FILGR" ,"SCALGR","GRAREA", "OPENGR","CURVGR","LINESG","PSYMGR","AXISGR", "DRNUMG","DRSTRG","DRSYMG","ANNOGR","PLOTGR", "" ,"PLOT" ,"ANNOTATE" ,"PLOTSYMBOL","PLOTSTRING", "PLOTNUMBER" ,"AXIS" ,"POINTSYMBOL","LINEGRAPH" ,"CURVE" , "OPENPLOTTER","SETPLOT","SCALE" ,"FILEGRAPH" ,"MERGEGRAPH", "GRAPHPAPER" OWNINTEGER CURPEN,GRON,MAIN,WOPN=1,BCT1,BFLG,BPTR,CHAN,D,DBLK,ERR, C EXC,EXS,F,FFLAG,INIT,MESS,PENS,PLTR,PLU,PLUNITS,PLXN,PLYN,PNST, C RTFLG,SP,STEPNO,TOTDBLK,WFLG OWNLONGREAL UNIT,PLWDTH,WMAX,SEP,PPMIN,NRLIM,SPLIM,OPRTR,TIC,SYMSIZ ownlongreal CHSIZ,XSMTH,YSMTH,CNVRT,C,CTH,ITALIC,PHI,PPCNT,PPLIM,S,SCPHI ownlongreal SSPHI,STH,TANIT,THETA,UNLX,UNLY,UPBX,UPBY,UXMX,UXN,UX0,UYN,UY0 ownlongreal WTPL,WXH,WXHO,WXHV,WXL,WYH,WYHO,WYL,XH,XL,XSC,XSCC,XSCS,YH,YL,YSC ownlongreal YSCC,YSCS,YTX OWNSTRING(7)CHARCODE="ISO" OWNSTRING(31)DELIVERY OWNSTRING(79) CURFILE,INFILE,TITLE OWNSTRING(255)STR OWNBYTEINTEGERARRAY HDR(1:80) OWNBYTEINTEGERARRAY BUFF(0:80) OWNINTEGERARRAY RTCALL(1:15) OWNSTRING(15)ARRAY PENTYPE(1:11)= C "Black","Blue","Green","Red", ".1",".2",".3",".4",".5",".6",".8" from Imp include Maths include "GPACKUTIL.IMP" !%SYSTEMROUTINESPEC GRAFIO(%INTEGERNAME F,%INTEGER A,B) !%SYSTEMROUTINESPEC ETOI(%INTEGER A,B) !%EXTERNALSTRING (63) %FNSPEC ITOSTR(%INTEGER I,M) !%EXTERNALSTRING (63) %FNSPEC RTOSTR (%LONGREAL Z,%INTEGER M,N) !%EXTERNALSTRING (63) %FNSPEC FILEINF(%INTEGER N,%INTEGERNAME FLAG) ROUTINESPEC GRERRS(INTEGER M,N) ! !----------------------------------------------------------------------- ! EXTERNALROUTINE CHCODE(INTEGERNAME N) IF N&1=0THEN CHARCODE="ISO"ELSE CHARCODE="EBCDIC" END ! !----------------------------------------------------------------------- ! EXTERNALINTEGERFN PLOTFAULT INTEGER I I=ERR ERR=0 RESULT=I END ! !----------------------------------------------------------------------- ! ! Fortran: %EXTERNALINTEGERFN IGRERR(%INTEGERNAME N) ! Fortran: %RESULT=PLOTFAULT ! Fortran: %END ! !----------------------------------------------------------------------- ! EXTERNALINTEGERFN PLOTRECS IF WOPN=0THENRESULT=TOTDBLK+DBLKELSERESULT=0 END ! !----------------------------------------------------------------------- ! ! Fortran: %EXTERNALINTEGERFN IGRREC(%INTEGERNAME N) ! Fortran: %RESULT=PLOTRECS ! Fortran: %END ! !----------------------------------------------------------------------- ! EXTERNALROUTINE AREAFLAG(STRING(3)S) IF S="OFF"THEN MESS=M'OFF'ELSE MESS=M'ON' END ! !----------------------------------------------------------------------- ! ! Fortran: %EXTERNALROUTINE GRARFL(%INTEGERNAME N) ! Fortran: %INTEGER M ! Fortran: M=INTEGER(ADDR(N)) ! Fortran: ETOI(ADDR(M),4)%IF CHARCODE="EBCDIC" ! Fortran: %IF M>>8=M'OFF'%THEN MESS=M'OFF'%ELSE MESS=M'ON' ! Fortran: %END ! !----------------------------------------------------------------------- ! ROUTINE BUFOUT BUFF(BUFF1)=STEPNO&16_7F BUFF(BUFF2)=DBLK&16_7F BPTR=BPTR+1AND BUFF(BPTR)=NULLWHILE BPTR<BEND GRAFIO(F,1,BCT1) DBLK=DBLK+1 BPTR=BUFF2 END ! !----------------------------------------------------------------------- ! ROUTINE ININT(INTEGER M,N) INTEGER I,J J=7*(N-1) BUFOUTIF BPTR+N>BEND for I=1,1,N cycle BUFF(BPTR+I)=M>>J&16_7F J=J-7 REPEAT BPTR=BPTR+N BUFOUTIF BPTR=BEND END ! !----------------------------------------------------------------------- ! ROUTINE INSTR(INTEGER M,STRING(71)S) INTEGER N N=LENGTH(S) BUFOUTIF BPTR+2+N>BEND BUFF(BPTR+1)=M STRING(ADDR(BUFF(BPTR+2)))=S BPTR=BPTR+2+N BUFOUTIF BPTR=BEND END ! !----------------------------------------------------------------------- ! ROUTINE NEWFRAME(LONGREAL WIDTH,HEIGHT,INTEGER OVLY,STRING(71)S) ! Frig to make compatable with EMAS version with true frame sizes. height = height / 3 if stepno=0 BUFOUTIF BPTR>BUFF2 TOTDBLK=TOTDBLK+DBLK STEPNO=STEPNO+1 DBLK=0 ININT(NEWSTEP,1) ININT(8,1) ININT(STEPNO,1) ININT(OVLY,1) ININT(INT(WIDTH/UNIT),3) ININT(INT(HEIGHT/UNIT),3) INSTR(OPMESS,S)UNLESS S="" IF OVLY=0THEN STR=""ELSE STR="(overlaid)" INSTR(OPMESS,"SUBFILE".ITOSTR(STEPNO,2).STR) BUFOUTIF S="" END ! !----------------------------------------------------------------------- ! ROUTINE MESSAGE(INTEGER N) INTEGER I I=OUTPUTSTREAM SELECTOUTPUT(0) STR="Call no.".ITOSTR(RTCALL(N),1)." to '".RT(N*MAIN)."'".STRUNLESS N=0 PRINTSTRING(" ***(CHANNEL".ITOSTR(CHAN,1).") ".STR.".*** ") SELECTOUTPUT(I)IF MAIN=1 END ! !----------------------------------------------------------------------- ! ROUTINE GRPLOT(INTEGER PEN,LONGREAL X,Y,DASH,GAP) INTEGER DX,DY,F,I,J,K,L,P,S,SDX,SDY,SZX,SZY LONGREAL C,COMP,D,XM,XN,XT,YM,YN,YT LONGREALARRAY A(1:2) ! !*********************************************************************** ! INTEGERFN INTERCEPT(INTEGER F,LONGREALNAME XN,YN,X,Y) I=0 IF F&5#0THENSTART D=XN-X IF F&4#0THEN XN=WXLELSE XN=WXH YN=(XN-X)*(YN-Y)/D+Y ->OUTIF YL<=YN<=YH FINISH D=YN-Y IF F&2#0THEN YN=WYLELSE YN=WYH XN=(XN-X)*(YN-Y)/D+X I=1UNLESS XL<=XN<=XH OUT:RESULT=I END ! !*********************************************************************** ! ROUTINE BLIND(LONGREALNAME X,Y) UPBX=X UPBY=Y BFLG=1 END ! !*********************************************************************** ! ROUTINE DRAW(INTEGER I,LONGREALNAME X,Y) INTEGER XN,YN ! !*********************************************************************** ! INTEGERFN VECSIZE(INTEGER V) IF V>MVTHEN V=LVBELSESTART IF V>SVTHEN V=MVBELSESTART V=SVBIF V>0 FINISH FINISH RESULT=V END ! !*********************************************************************** ! S=PNST IF I=M'UP'THEN PNST=0ELSE PNST=K BFLG=0 DX=INT(X/UNIT)-PLXN DY=INT(Y/UNIT)-PLYN PLXN=PLXN+DX PLYN=PLYN+DY UPBX=X UPBY=Y UXMX=XIF PNST=1AND X>UXMX P=PNST<<4 IF PLXN!PLYN=0THENSTART ININT(ABSVEC+P,1)UNLESS DX!DY=0 FINISHELSESTART IF DX!DY=0THENSTART IF PNST<=STHEN PNST=SELSE ININT(P,1) FINISHELSESTART IF DX<0THEN SDX=1ELSE SDX=0 IF DY<0THEN SDY=1ELSE SDY=0 DX=|DX| DY=|DY| IF DX>=DYTHEN L=DXELSE L=DY J=1 CYCLE IF L>LVTHENSTART D=LV/L XN=INT(DX*D) YN=INT(DY*D) DX=DX-XN DY=DY-YN L=L-LV FINISHELSE XN=DXAND YN=DYAND J=0 SZX=VECSIZE(XN) SZY=VECSIZE(YN) BUFOUTIF BPTR+1+SZX+SZY>BEND ININT(P+SZX<<2+SZY,1) ININT(SDX<<(7*SZX-1)+XN,SZX)UNLESS SZX=0 ININT(SDY<<(7*SZY-1)+YN,SZY)UNLESS SZY=0 REPEAT until J=0 FINISH FINISH END ! !*********************************************************************** ! IF DASH<0THENSTART IF PEN=1THEN BLIND(X,Y)ELSESTART IF PEN=2THEN K=1ELSE K=0 DRAW(CLEAR,X,Y) NEWFRAME(WXHV,WYH,INT(GAP),"")IF PEN=CONTROL FINISH FINISHELSESTART IF GAP<0THEN XM=XAND YM=YELSESTART XM=X*XSCC-Y*YSCS+UX0 YM=X*XSCS+Y*YSCC+UY0 FINISH F=0 F=4IF XM<XL F=1IF XM>XH F=F+2IF YM<YL F=F+8IF YM>YH IF WFLG#0THENSTART ->EXITIF WFLG&F#0OR INTERCEPT(WFLG,UXN,UYN,XM,YM)#0 BLIND(UXN,UYN) FINISH X=XM Y=YM I=INTERCEPT(F,X,Y,UXN,UYN)IF F#0 IF PEN=1THEN BLIND(X,Y)ELSESTART I=CLEAR ->EXECIF PEN=2 PEN=2 A(1)=GAP*XSC ->EXECIF A(1)<UNIT PEN=1 A(2)=DASH*XSC BLIND(X,Y)AND->EXITIF A(2)<UNIT XT=X-UXN YT=Y-UYN C=SQRT(XT*XT+YT*YT) ->EXITIF C<UNIT XT=XT/C YT=YT/C I=M'DOTD' COMP=0 XN=X YN=Y DOTD:PEN=3-PEN COMP=COMP+A(PEN) IF COMP<CTHENSTART X=COMP*XT+UXN Y=COMP*YT+UYN FINISHELSESTART I=CLEAR PEN=2 X=XN Y=YN FINISH EXEC:DRAW(M'UP',UPBX,UPBY)IF BFLG=1 K=PEN-1 DRAW(I,X,Y) ->DOTDIF I=M'DOTD' FINISH EXIT:UXN=XM UYN=YM WFLG=F IF MESS=M'ON'AND WFLG#0THENSTART EXC=EXC+1 IF EXC=EXC//50*50THENSTART EXS=EXS+1 STR=" is drawing out of area" MESSAGE(RTFLG) GRERRS(11,RTFLG)IF EXS=20 FINISH FINISH FINISH END ! !----------------------------------------------------------------------- ! ROUTINE GRMARK(INTEGER L) LONGREAL A,X PLXN=0AND PLYN=0AND UPBX=0AND UPBY=0IF L='L' X=UPBX A=2*TIC GRPLOT(2,X,A,-1,0) GRPLOT(2,X,0,-1,0) A=-AIF L='J' GRPLOT(2,X+A,0,-1,0) GRPLOT(2,X,0,-1,0) END ! !----------------------------------------------------------------------- ! EXTERNALROUTINE CLOSEPLOTTER LONGREAL X IF WOPN=0THENSTART X=UXMX+SEP X=WXHVIF X>WXHV GRPLOT(CLEAR,X,0,-1,0) GRMARK('J') GRPLOT(CLEAR,UPBX+SEP,0,-1,0) GRERRS(0,0) WOPN=-1 INIT=-1 TOTDBLK=0 FINISH GRON=-1UNLESS GRON=1 END ! !----------------------------------------------------------------------- ! ! Fortran: %EXTERNALROUTINE CLOSGR ! Fortran: CLOSEPLOTTER ! Fortran: %STOPIF |INIT|=1<=ERR ! Fortran: %END ! !----------------------------------------------------------------------- ! ROUTINE GRERRS(INTEGER M,N) CONSTSTRING(38)ARRAY S(0:19)=" records", "Invalid drawing area declaration","Plotter output exceeded", "Invalid scaling factor(s)","Invalid pen up/down code", "Dash/gap value(s) negative","Data and drawing range incompatible", "Independent variable data out of order","Direction code error", "Illegal use of channel 96","Not a valid plotter file", "Excessive out-of-area drawing","File extension not allowed", "Too few data points","Graduation intervals specified wrongly", "Units not 'INS' or 'CMS' codes","No file definition statement", "Plotter file not defined as SQFILE", "Plotter file not F80, i.e. card images","File is not accessible" INTEGER J,L IF M=0THENSTART BUFOUTIF BPTR>BUFF2 TOTDBLK=TOTDBLK+DBLK+1 STR="End of plotter file '".CURFILE."' after".ITOSTR(TOTDBLK,1).S(M) STEPNO=0 DBLK=0 INSTR(OPMESS,STR.".") ININT(CLOSE,1) ININT(0,1) BUFOUT GRAFIO(F,1,0) STR="No recovery - ".STRIF MAIN=-1AND ERR#0 MESSAGE(M) FINISHELSESTART ERR=M STR=":-".snl J=M IF N=10OR N=14THEN L=16_FFELSE L=16_F CYCLE STR=STR." ***".S(J&L) EXITIF L=16_FFOR J>>4=0 J=J>>4 STR=STR."*** and".snl REPEAT STR=STR." - ".INFILEIF N=14AND9#M#16 STR=STR." - ".CURFILEIF N=10AND M#16 MESSAGE(N) IF M=2OR9<=M<=12OR M>15THENSTART GRAFIO(F,0,0)IF M=10 !%IF MAIN=1%THEN CLOSEPLOTTER%ELSE CLOSGR close plotter STOPIF |INIT|=1 FINISHELSESTART GRPLOT(CLEAR,UPBX,UPBY,-1,0)IF BFLG=1 BUFOUTIF BPTR>BUFF2 FINISH FINISH END ! !----------------------------------------------------------------------- ! INTEGERFN JOBTYP OWNINTEGER J STRING(7)MACHINE !%EXTERNALROUTINESPEC JOBINF(%string (*) %name MACHINE,JOBNAME,%INTEGER M, %C ! %string (*) %name DELIVERY,%INTEGER N) JOBINF(MACHINE,STR,8,DELIVERY,30) IF J=0THENSTART TITLE=STR.MACHINE J=6 J=J-1UNTIL'A'<=CHARNO(TITLE,J)<='Z' J=CHARNO(TITLE,J) FINISH RESULT=J END ! !----------------------------------------------------------------------- ! ROUTINE SELECTPEN(INTEGER CLR) INTEGER J,M M=4*CLR IF CLR>7THENSTART STR="" for J=M-3,1,M cycle STR=STR.TOSTRING(PENCODE(J)) REPEAT INSTR(PENINFO,STR) FINISH INSTR(PENSELECT,TOSTRING(PENCODE(M))) CURPEN=CLR PNST=0 END ! !----------------------------------------------------------------------- ! EXTERNALROUTINE CHANGEPEN(INTEGER CLR) INTEGER N IF WOPN=0AND JOBTYP#SPJOBTHENSTART CLR=DEFCLRUNLESS1<=CLR<=CLRS SELECTPEN(CLR)UNLESS CLR=CURPEN FINISH END ! !----------------------------------------------------------------------- ! ! Fortran: %EXTERNALROUTINE CHPNGR(%INTEGERNAME CLR) ! Fortran: CLOSGR%IF INIT=1<=ERR ! Fortran: CHANGEPEN(CLR) ! Fortran: %END ! !----------------------------------------------------------------------- ! EXTERNALROUTINE FILEGRAPH RTCALL(13)=RTCALL(13)+1 GRERRS(9,13)IF CHAN=SYSFIL GRPLOT(CONTROL,0,0,-1,2)AND CLOSEPLOTTERIF WOPN=0 END ! !----------------------------------------------------------------------- ! ! Fortran: %EXTERNALROUTINE FILGR ! Fortran: CLOSGR%IF INIT=1<=ERR ! Fortran: MAIN=-1 ! Fortran: FILEGRAPH ! Fortran: MAIN=1 ! Fortran: %END ! !----------------------------------------------------------------------- ! EXTERNALROUTINE MERGEGRAPH(INTEGER CHAN) INTEGER I LONGREAL C,XI,YI RTCALL(14)=RTCALL(14)+1 GRERRS(9,14)IF CHAN=SYSFIL FFLAG=14 FILEINF(CHAN,INFILE,FFLAG) GRERRS(FFLAG+15,14)ANDRETURNUNLESS FFLAG=0 GRAFIO(F,0,CHAN) IF WOPN=0THENSTART XI=UPBX YI=UPBY GRPLOT(CLEAR,0,0,-1,0) BUFOUTIF BPTR>BUFF2 FINISHELSE BCT1=ADDR(BUFF(1)) GRAFIO(F,0,BCT1) GRERRS(10,14)ANDRETURNIF F<0 for I=1,1,80 cycle GRERRS(10,14)ANDRETURNUNLESS BUFF(I)=HDR(I) REPEAT GRAFIO(F,0,BCT1) GRERRS(10,14)ANDRETURNUNLESS F>=0AND BUFF(1)=BUFF(2)=0AND BUFF(3)= C NEWFILE IF BUFF(14)=PLUNITSTHEN C=1ELSE C=CNVRT GRERRS(10,14)ANDRETURNUNLESS INT(((BUFF(12)&16_7F)<<7+ C BUFF(13)&16_7F)/C)=INT(1/UNIT) IF WOPN=0THENSTART CYCLE GRAFIO(F,0,BCT1) GRERRS(10,14)IF F<0 EXITIF BUFF(1)=2AND BUFF(2)=0AND BUFF(3)=NEWSTEP REPEAT I=2 MORE:CYCLE GRAFIO(F,0,BCT1) GRERRS(10,14)IF F<0 EXITUNLESS BUFF(1)=I BPTR=BEND BUFOUT REPEAT I=I+1AND->MOREIF BUFF(1)=I+1AND BUFF(6)=1 GRAFIO(F,0,0) PNST=1 GRPLOT(1,XI,YI,-1,0) FINISH END ! !----------------------------------------------------------------------- ! ! Fortran: %EXTERNALROUTINE MERGGR(%INTEGERNAME CHAN) ! Fortran: CLOSGR%IF INIT=1<=ERR ! Fortran: MAIN=-1 ! Fortran: MERGEGRAPH(CHAN) ! Fortran: MAIN=1 ! Fortran: %END ! !----------------------------------------------------------------------- ! EXTERNALROUTINE PLOTTERTYPE(INTEGER N) CONSTBYTEINTEGERARRAY NPENS(1:6)=3,1(5) CONSTINTEGERARRAY M(1:6)=M'CMS',M'INS'(2),M'CMS',M'INS',M'CMS' CONSTREALARRAY C(1:48)= C .0050,82.50,3000,5,38,185,90,300, .0025,28.50,1200,2,15, 72,36,120, .0025,10.25,1200,2,15, 72,36,120, .0100,72.50,3000,5,38,185,90,300, .0050,28.50,1200,2,15, 72,36,120, .0100,28.00,3000,5,38,185,90,300 CONSTREALARRAY D(1:10)=.05,.04(2),.01(2),.125,.1(2),.025(2) INTEGER I,J LONGREALARRAYNAME PARS !%LONGREALARRAYFORMAT F(1:13) record format F (long real array A(1:13)) record (F) name PARSR N=DEFPLTRUNLESS1<=N<=PLTRS UNLESS N=PLTRTHENSTART CLOSEPLOTTERIF WOPN=0 PLTR=N GRON=1IF GRON<0 !PARS==ARRAY(ADDR(UNIT),F) PARSR == Record (addr (unit)) PARS == PARSR_A J=8*PLTR-7 for I=1,1,8 cycle PARS(I)=C(J) J=J+1 REPEAT PLU=M(PLTR) IF PLU=M'INS'THEN PLUNITS=2AND CNVRT=.3937AND J=1ELSE PLUNITS=1 C AND CNVRT=2.54000508AND J=6 for I=9,1,13 cycle PARS(I)=D(J) J=J+1 REPEAT PENS=NPENS(PLTR) IF JOBTYP=SPJOBTHEN PPLIM=SPLIMELSE PPLIM=NRLIM FINISH END ! !----------------------------------------------------------------------- ! ! Fortran: %EXTERNALROUTINE PLTYPE(%INTEGERNAME I) ! Fortran: CLOSGR%IF INIT=1<=ERR ! Fortran: PLOTTERTYPE(I) ! Fortran: %END ! !----------------------------------------------------------------------- ! EXTERNALROUTINE OPENPLOTTER(INTEGER I) INTEGER J IF INIT=0THENSTART J=JOBTYP BCT1=ADDR(BUFF(1)) for J=1,1,BEND cycle HDR(J)=J-1 REPEAT for J=1,1,CLRS cycle IF J<5THEN STR=" Ballpoint"ELSE STR="mm liquid ink" PENTYPE(J)=PENTYPE(J).STR REPEAT TANIT=TAN(PI/12) PLOTTERTYPE(DEFPLTR)IF PLTR=0 FINISH INIT=1 RTCALL(10)=RTCALL(10)+1 CLOSEPLOTTERIF WOPN=0 RTCALL(10)=1UNLESS I=CHAN CHAN=I FFLAG=10 FILEINF(CHAN,STR,FFLAG) CURFILE=STRAND GRERRS(FFLAG+15,10)UNLESS FFLAG=0 IF STR=CURFILETHENSTART GRERRS(12,10)IF WOPN=-1 FINISHELSESTART for J=1,1,15 cycle RTCALL(J)=0 REPEAT RTCALL(10)=1 CURFILE=STR MESS=M'ON' EXC=-1 EXS=-1 FINISH IF JOBTYP=SPJOBTHEN PPLIM=SPLIMELSE PPLIM=NRLIM LENGTH(TITLE)=15 TITLE=TITLE." ".DATE." ".TIME." ".DELIVERY WOPN=1 GRON=0 END ! !----------------------------------------------------------------------- ! ! Fortran: %EXTERNALROUTINE OPENGR(%INTEGERNAME I) ! Fortran: CLOSGR%IF INIT=1<=ERR ! Fortran: MAIN=-1 ! Fortran: OPENPLOTTER(I) ! Fortran: MAIN=1 ! Fortran: %END ! !----------------------------------------------------------------------- ! EXTERNALROUTINE SCALE(LONGREAL X,Y,XN,YN,ANGLE) RTCALL(12)=RTCALL(12)+1 IF XN<=0OR YN<=0THENSTART GRERRS(3,12) SIGNALEVENT11,3IF MAIN=1=INIT RETURN FINISH IF WOPN=0THENSTART UX0=X*WTPL+WXL UY0=Y*WTPL+WYL XSC=XN*WTPL YSC=YN*WTPL YTX=YSC/XSC THETA=PI*ANGLE/180 STH=SIN(THETA) CTH=COS(THETA) XSCS=XSC*STH XSCC=XSC*CTH YSCS=YSC*STH YSCC=YSC*CTH FINISH END ! !----------------------------------------------------------------------- ! ! Fortran: %EXTERNALROUTINE SCALGR(%LONGREALNAME X,Y,XN,YN,ANGLE) ! Fortran: CLOSGR%IF INIT=1<=ERR ! Fortran: MAIN=-1 ! Fortran: SCALE(X,Y,XN,YN,ANGLE) ! Fortran: MAIN=1 ! Fortran: %END ! !----------------------------------------------------------------------- ! EXTERNALROUTINE PLOT(INTEGER PEN,LONGREAL X,Y,DASH,GAP) INTEGER K RTCALL(1)=RTCALL(1)+1 IF0<=PEN<=2THEN K=0ELSE K=4 K=K<<4!5IF DASH<0OR GAP<0 IF K#0THENSTART GRERRS(K,1) SIGNALEVENT11,KIF MAIN=1=INIT FINISHELSESTART RTFLG=1AND GRPLOT(PEN,X,Y,DASH,GAP)IF WOPN=0 FINISH END ! !----------------------------------------------------------------------- ! ! Fortran: %EXTERNALROUTINE PLOTGR(%INTEGERNAME PEN,%LONGREALNAME X,Y,DASH,GAP) ! Fortran: CLOSGR%IF INIT=1<=ERR ! Fortran: MAIN=-1 ! Fortran: PLOT(PEN,X,Y,DASH,GAP) ! Fortran: MAIN=1 ! Fortran: %END ! !----------------------------------------------------------------------- ! EXTERNALROUTINE PENPOSITION(LONGREALNAME X,Y) LONGREAL C,XM,YM IF WOPN=0OR SP=1THENSTART C=1/(XSCS*YSCS+XSCC*YSCC) XM=UPBX-UX0 YM=UPBY-UY0 X=C*(YSCS*YM+YSCC*XM) Y=C*(XSCC*YM-XSCS*XM) FINISH END ! !----------------------------------------------------------------------- ! ! Fortran: %EXTERNALROUTINE PPOSGR(%LONGREALNAME X,Y) ! Fortran: CLOSGR%IF INIT=1<=ERR ! Fortran: PENPOSITION(X,Y) ! Fortran: %END ! !----------------------------------------------------------------------- ! EXTERNALROUTINE ANNOTATE(LONGREAL X,Y,SIZE,ANGLE) RTCALL(2)=RTCALL(2)+1UNLESS SP=1 IF WOPN=0OR SP=1THENSTART SIZE=.25*SIZE*XSC SIZE=.25*CHSIZIF SIZE<UNIT RTFLG=2 GRPLOT(1,X,Y,0,0) PHI=THETA+PI*ANGLE/180 SSPHI=SIZE*SIN(PHI) S=SSPHI SCPHI=SIZE*COS(PHI) C=SCPHI D=0 ITALIC=0 UNLX=UXN UNLY=UYN FINISH END ! !----------------------------------------------------------------------- ! ! Fortran: %EXTERNALROUTINE ANNOGR(%LONGREALNAME X,Y,SIZE,ANGLE) ! Fortran: CLOSGR%IF INIT=1<=ERR ! Fortran: MAIN=-1 ! Fortran: ANNOTATE(X,Y,SIZE,ANGLE) ! Fortran: MAIN=1 ! Fortran: %END ! !----------------------------------------------------------------------- ! EXTERNALROUTINE PLOTSYMBOL(INTEGER CODE) CONSTINTEGERARRAY ID(0:127)= C 16_FFF00808,16_4B461565,16_0F454F8C,16_0E451A64,16_FFF209C5, 16_FFF306C5,16_FFF3FFF6,16_FFF4FFF5,16_0AC539E2,16_25C32486, 16_368A10A4,16_2A0452C2,16_53423006,16_54465448,16_53C25223, 16_2346564C,16_FFF12B4A,16_594A15A8,16_B04A400C,16_5BCD5945, 16_18844384,16_0FA80FA4,16_2F251022,16_2CA542C1,16_1B095F03, 16_5FC9620D,16_6AC47409,16_79CC3DE2,16_1F717CCC,16_2CAA2DEA, 16_0E4315A4,16_1AA301CD,16_11708968,16_8B6B86C8,16_8E263E87, 16_3E8686CA,16_8FA51766,16_76057765,16_784378E4,16_90E34CC9, 16_91A64CCB,16_91A81F6C,16_95847606,16_3E039385,16_42C39485, 16_96241944,16_43224444,16_C4C38482,16_C5423B2B,16_3AEA3B28, 16_3B2C492A,16_856747CD,16_97271E22,16_47C59EE6,16_5F02A1A9, 16_97663B29,16_812C81EB,16_976571CA,16_85237F87,16_25C39B45, 16_9A2325C5,16_9AA4A3C9,16_5F02A8C9,16_08041ECE,16_FFF7AD24, 16_B46BBBE3,16_BC84B787,16_B904BDA5,16_650F33A6,16_BEE5AD22, 16_C024B723,16_676A6509,16_6967A066,16_B285BB64,16_B9C7314F, 16_B3A333AC,16_AAE9FFF7,16_05C5FFF7,16_2F25FFF7,16_2CA52DEA, 16_FFF79C4A,16_26EE0007,16_1F6E0BCB,16_450C9767,16_1B0B1E23, 16_9F2539E5,16_7F889905,16_6BD03729,16_A5C7816B,16_372B1D84, 16_A746368B,16_C106C289,16_ADCBFFF7,16_FFF7FFF7,16_FFF7FFF7, 16_FFF7FFF7,16_FFF7FFF7,16_6F8AFFF7,16_FFF7FFF7,16_FFF7FFF7, 16_FFF7FFF7(5), 16_FFF7FFF7(5), 16_FFF7FFF7,16_FFF7FFF7,16_FFF8FFF9,16_04C54C63,16_FFF7FFF7, 16_FFF7FFF7(5), 16_FFF7FFF7(5), 16_FFF7FFF7(3) OWNINTEGER VST = 0 !%OWNINTEGERARRAY V(0:197)= %C ! 16_16A73432,16_21225719,16_AA4A5958,16_262535B4,16_A4233334, ! 16_B8463826,16_A7373626,16_B4463438,16_15A64556,16_D7C62716, ! 16_D6375635,16_96371656,16_C7271625,16_45251423,16_43549658, ! 16_95D3B4B8,16_96D694D8,16_98D4C323,16_14172848,16_57554434, ! 16_25263747,16_5659D797,16_95D5C3C9,16_A9A3C333,16_3A2A4AB9, ! 16_3443B33A,16_4A5594D6,16_18AA4A58,16_55432315,16_18175797, ! 16_B7B34432,16_BBD9CA2A,16_19182747,16_56544323,16_14162747, ! 16_5859CB3A,16_332214C4,16_55564717,16_B3573310,16_183A4A59, ! 16_58471747,16_56544323,16_14A5333B,16_5A25AA3A,16_3525A4A3, ! 16_333424A5,16_A6363525,16_A4B42212,16_24D71744,16_38249519, ! 16_2A4A5955,16_4424A3C3,16_333B4B2B,16_9A972646,16_575A32B8, ! 16_D6C72716,16_14234354,16_56476737,16_5337291A,16_D6C72716, ! 16_14234354,16_5653575A,16_1AB35A9A,16_17471713,16_53D44443, ! 16_53A9991A,16_2A2993DA,16_9AD32AB9,16_3423B33A,16_2AB9495A, ! 16_4A161423,16_43524111,16_A0405157,16_D4C32314,16_16274756, ! 16_5515D5D7,16_9796D654,16_C3231419,16_2A4A5954,16_B5D325B5, ! 16_342425A7,16_A8383727,16_86D66603,16_8712D20B,16_EB33BAA9, ! 16_C9C5A5A7,16_C735A415,16_16273635,16_44555647,16_3627971A, ! 16_2A27C7CA,16_5A574755,16_C3231416,16_48493A2A,16_19183553, ! 16_33BA2818,16_992A4A59,16_57141353,16_19AA4A59,16_58472747, ! 16_56544323,16_149A2B4B,16_5A544323,16_14A6A827,16_474846D3, ! 16_939BDB2B,16_232B4B43,16_CA16563B,16_CA5B2A19,16_18274727, ! 16_16142343,16_524111A1,16_52532415,16_16274756,16_C7271625, ! 16_45544323,16_14A34354,16_5647171A,16_5AD44323,16_141A165A, ! 16_2753931A,16_375A5359,16_CA2A1914,16_23435456,16_47271614, ! 16_A3435459,16_4A2A1917,16_264657D3,16_54432314,16_171016D6, ! 16_C7271614,16_23435456,16_575002E2,16_19173717,16_192A4A59, ! 16_CA2A1914,16_23435456,16_46192A4A,16_59561656,16_531A4A59, ! 16_58471747,16_56544313,16_1A4A5954,16_43131A17,16_575A531A, ! 16_535A1A4A,16_59574616,16_36531AA3,16_37435AB7,16_1A3733BA, ! 16_9ADA1353,16_1A171627,16_47565340,16_17A52345,16_5797D393, ! 16_5717A335,16_4357C433,16_23141627,16_3746531A,16_17144725, ! 16_531B4B5A,16_58471716,16_27363336,16_4756534B,16_BB2A2817, ! 16_26243343,16_C7272327,16_57179623,16_4355572B,16_BB4A4857, ! 16_46443323,16_15192B4B,16_59554353,16_3B534727,16_96142334, ! 16_36344354,16_56479796,16_C6D9CA3A,16_29235393,16_371B5B9B, ! 16_D31B4B5A,16_58471747,16_56544313,16_1B535B9B,16_17471713, ! 16_53935B1B,16_AA384A5B,16_B8B3BB1B,16_5B5A03BB,16_63031B17, ! 16_575B531B,16_175B2853,16_1B375B53,16_17A74050,16_90D731B9, ! 16_97A72433,16_44475728,16_B948A900 include "GPCHSET.IMP" INTEGER I,J,K,PEN LONGREAL XI,XT,YI,YT BYTEINTEGERARRAYNAME BVST !%BYTEINTEGERARRAYFORMAT F(0:791) record format F (byte integer array A(0:791)) record (F) name BVSTFR SWITCH SW(0:9) RTCALL(3)=RTCALL(3)+1UNLESS SP=1OR4<=RTFLG<=5 IF WOPN=0OR SP=1THENSTART VST=ADDR(V(0))IF VST=0 !BVST==ARRAY(VST,F) BVSTFR == record (VST) BVST == BVSTFR_A XI=UXN YI=UYN RTFLG=3UNLESS4<=RTFLG<=5 ERRCH:CODE=DEFCHUNLESS0<=CODE<=255 J=(1-CODE&1)<<4 J=ID(CODE>>1)>>J&16_FFFF ->SW(J&15)IF J>>4=16_0FFF K=J>>6 PEN=J>>5&1+1 for I=K,1,K+J&16_1F-1 cycle J=BVST(I)>>4 J=J-8AND PEN=3-PENIF J>=8 YT=BVST(I)&15-3 XT=(J-1)+YT*ITALIC GRPLOT(PEN,XI+XT*C-YT*S,YI+XT*S+YT*C,0,-1) REPEAT SW(1):XT=6 NEXT:XI=XI+XT*C YI=YI+XT*S ->DONE SW(2):XT=-6 ->NEXT SW(3):UNLX=UNLX+12*SSPHI UNLY=UNLY-12*SCPHI SW(6):XI=UNLX YI=UNLY YT=D ->RESET SW(7):CODE=-1 ->ERRCH SW(8):ITALIC=TANIT RETURN SW(9):ITALIC=0 RETURN SW(4):SW(5):IF J&15=4THEN J=4ELSE J=-2 RETURNIF D=J IF D=0THEN YT=JAND D=JAND XT=.5ELSE YT=-DAND D=0AND XT=1 S=XT*SSPHI C=XT*SCPHI RESET:XI=XI-YT*SSPHI YI=YI+YT*SCPHI DONE:GRPLOT(1,XI,YI,0,-1) FINISH SW(0):END ! !----------------------------------------------------------------------- ! ! Fortran: %EXTERNALROUTINE DRSYMG(%INTEGERNAME I) ! Fortran: %INTEGER CODE ! Fortran: CLOSGR%IF INIT=1<=ERR ! Fortran: CODE=INTEGER(ADDR(I)) ! Fortran: CODE=CODE>>24%UNLESS CODE>>24=0 ! Fortran: CODE=GRETOI(CODE&255)%IF CHARCODE="EBCDIC" ! Fortran: MAIN=-1 ! Fortran: PLOTSYMBOL(CODE) ! Fortran: MAIN=1 ! Fortran: %END ! !----------------------------------------------------------------------- ! EXTERNALROUTINE PLOTSTRING(STRING(255)S) INTEGER L,M RTCALL(4)=RTCALL(4)+1 IF GRON=0THENSTART L=LENGTH(S) IF WOPN=1AND SP=0THENSTART S=DELIVERYAND L=LENGTH(S)IF L=0 LENGTH(S)=30IF L>30 LENGTH(TITLE)=40 TITLE=TITLE.S FINISHELSESTART IF L#0THENSTART RTFLG=4 for M=1,1,L cycle PLOTSYMBOL(CHARNO(S,M)) REPEAT RTFLG=0 FINISH FINISH FINISH END ! !----------------------------------------------------------------------- ! ! Fortran: %EXTERNALROUTINE DRSTRG(%INTEGERNAME S,N) ! Fortran: %INTEGER L,M ! Fortran: %STRING(255)ST ! Fortran: CLOSGR%IF INIT=1<=ERR ! Fortran: L=N&255 ! Fortran: %IF L=0%THEN ST=""%ELSESTART ! Fortran: LENGTH(ST)=L ! Fortran: ! ! Fortran: !*********************************************************************** ! Fortran: ! ! Fortran: %BEGIN ! Fortran: %BYTEINTEGERARRAYNAME SBYTE ! Fortran: %BYTEINTEGERARRAYFORMAT F(1:L) ! Fortran: SBYTE==ARRAY(ADDR(S),F) ! Fortran: %for M=1,1,L %cycle ! Fortran: CHARNO(ST,M)=SBYTE(M) ! Fortran: %REPEAT ! Fortran: %END ! Fortran: ! ! Fortran: !*********************************************************************** ! Fortran: ! ! Fortran: %IF CHARCODE="EBCDIC"%THENSTART ! Fortran: %for M=1,1,L %cycle ! Fortran: CHARNO(ST,M)=GRETOI(CHARNO(ST,M)) ! Fortran: %REPEAT ! Fortran: %FINISH ! Fortran: %FINISH ! Fortran: MAIN=-1 ! Fortran: PLOTSTRING(ST) ! Fortran: MAIN=1 ! Fortran: %END ! !----------------------------------------------------------------------- ! EXTERNALROUTINE PLOTNUMBER(LONGREAL Z,INTEGER M,N) INTEGER J STRING(3)S RTCALL(5)=RTCALL(5)+1 IF WOPN=0THENSTART STR=RTOSTR(Z,M,N) IF MAIN=-1AND STR->STR.("@").STHENSTART CHARNO(S,1)=CHARNO(S,2)AND CHARNO(S,2)='0'UNLESS'1'<=CHARNO(S,2)<='9' STR=STR."E".S FINISH RTFLG=5 for J=1,1,LENGTH(STR) cycle PLOTSYMBOL(CHARNO(STR,J)) REPEAT RTFLG=0 FINISH END ! !----------------------------------------------------------------------- ! ! Fortran: %EXTERNALROUTINE DRNUMG(%LONGREALNAME Z,%INTEGERNAME M,N) ! Fortran: CLOSGR%IF INIT=1<=ERR ! Fortran: MAIN=-1 ! Fortran: PLOTNUMBER(Z,M,N) ! Fortran: MAIN=1 ! Fortran: %END ! !----------------------------------------------------------------------- ! EXTERNALROUTINE GRAPHPAPER(LONGREAL X,INTEGER L) RTCALL(15)=RTCALL(15)+1 L=M'CMS'IF L=0 L=M'INS'IF L=1 IF M'INS'#L#M'CMS'THENSTART GRERRS(15,15) SIGNALEVENT11,15IF MAIN=1=INIT RETURN FINISH IF GRON+WOPN=1THENSTART X=CNVRT*XUNLESS L=PLU PPLIM=XUNLESS JOBTYP=SPJOBOR X<PPMIN FINISH END ! !----------------------------------------------------------------------- ! ! Fortran: %EXTERNALROUTINE GRPAPR(%LONGREALNAME X,%INTEGERNAME L) ! Fortran: %INTEGER M ! Fortran: CLOSGR%IF INIT=1<=ERR ! Fortran: M=INTEGER(ADDR(L)) ! Fortran: %UNLESS M>>8=0%THENSTART ! Fortran: ETOI(ADDR(M),4)%IF CHARCODE="EBCDIC" ! Fortran: M=M>>8 ! Fortran: %FINISH ! Fortran: MAIN=-1 ! Fortran: GRAPHPAPER(X,M) ! Fortran: MAIN=1 ! Fortran: %END ! !----------------------------------------------------------------------- ! EXTERNALROUTINE SETPLOT(LONGREAL XB,YB,XT,YT,INTEGER N) INTEGER K,L,M LONGREAL XI,XN,YN RTCALL(11)=RTCALL(11)+1 PLOTTERTYPE(DEFPLTR)IF PLTR=0 M=0 IF0<=N<=5THENSTART IF N&1=1THEN L=M'INS'ELSE L=M'CMS' IF N>1THENSTART IF N>3THEN M='V'ELSE M='A' FINISH FINISHELSESTART IF N>>24=0THEN L=NELSE M=N&16_FFAND L=N>>8 FINISH IF M'INS'#L#M'CMS'THEN K=15ELSESTART IF L=PLUTHEN WTPL=1ELSESTART WTPL=CNVRT XB=XB*WTPL YB=YB*WTPL XT=XT*WTPL YT=YT*WTPL FINISH XT=WMAXIF XT>WMAX YT=PLWDTHIF YT>PLWDTH IF0<=XB<XTAND0<=YB<YTTHEN K=0ELSE K=1 FINISH IF K#0THENSTART GRERRS(K,11) SIGNALEVENT11,KIF MAIN=1=INIT RETURN FINISH IF GRON=0THENSTART L=1 XI=SEP XN=XT IF WOPN>=0THENSTART IF WOPN=1THENSTART IF PLU=M'INS'THEN WXH=2ELSE WXH=5.08001016 PPCNT=WXH WXHV=WXH FINISHELSESTART XI=0UNLESS M=0 IF M='V'THENSTART IF XT>WXHVTHEN XN=XT-WXHVELSE XN=0AND L=0 FINISH FINISH FINISH PPCNT=PPCNT+XI+XN GRERRS(2,11)ANDRETURNIF PPCNT>PPLIM XI=.5*UNIT IF WOPN=1THENSTART GRAFIO(F,1,CHAN) GRAFIO(F,1,ADDR(HDR(1))) STR="Plotter file '".CURFILE."' initialised" MESSAGE(0) TOTDBLK=1 STEPNO=0 DBLK=0 BPTR=BUFF2 ININT(NEWFILE,1) ININT(20,1) ININT(1,1) ININT(INT(PPLIM/UNIT),3) ININT(INT(PLWDTH/UNIT),3) ININT(INT(1/UNIT),2) ININT(PLUNITS,1) ININT(PENS,1) STRING(ADDR(BUFF(16)))=SUB STRING(TITLE,1,8) BUFF(16)=0 BPTR=BUFF2+22 NEWFRAME(WXHV,PLWDTH,0,TITLE) IF PPLIM>=OPRTRTHENSTART IF PLU=M'INS'THEN XN=.083333AND STR="ft."ELSE XN=.01AND STR="m." N=INT(PPLIM*XN) N=99IF N>99 INSTR(OPDIR,TOSTRING(N//10+'0').TOSTRING(N-N//10*10+'0').STR. C " of paper required.") FINISH for K=5,1,7 cycle STR="" N=4*K for M=N-3,1,N cycle STR=STR.TOSTRING(PENCODE(M)) REPEAT INSTR(PENINFO,STR) REPEAT SELECTPEN(DEFCLR) K=MESS MESS=M'OFF' WXL=0 WYL=0 WYH=PLWDTH GRMARK('L') WFLG=0 XN=.5*WXH UX0=0 UY0=0 XSC=XN YSC=XN THETA=0 STH=0 CTH=1 UXN=0 UYN=0 XSCS=0 XSCC=XN YSCS=0 YSCC=XN XL=-XI YL=-XI XH=WXH+XI YH=WYH+XI SP=1 ANNOTATE(.8,0,.1,90) PLOTSTRING(" ".UINFS(1)." (".UINFS(10).") ".UINFS(2)) ANNOTATE(1.1,0,.07,90) PLOTSTRING(SNL.SNL." File ".CURFILE." created ".DATE." ".TIME) SP=0 MESS=K FINISH IF M+WOPN='V'THENSTART XN=-UPBX N=1 STR=":- ***Overlaid windows should be contained within a 'master' window" C AND MESSAGE(11)IF XT>WXHOOR YT>WYHO FINISHELSESTART IF WOPN>=0THENSTART XN=UXMX+SEP XN=WXHVIF XN>WXHV GRPLOT(CLEAR,XN,0,-1,0) GRMARK('J') FINISH IF M+WOPN='A'THEN XN=0ELSE XN=SEP N=0 WXHO=XT WYHO=YT FINISH WXL=XB WYL=YB WXH=XT WXHV=XTUNLESS L=0 WYH=YT GRPLOT(CONTROL,UPBX+XN,0,-1,N) UXMX=0AND WOPN=0UNLESS M+WOPN='V' GRMARK('L') WFLG=0 GRPLOT(1,WXL,WYL,-1,0) UXN=WXL UYN=WYL XL=WXL-XI YL=WYL-XI XH=WXH+XI YH=WYH+XI FINISH END ! !----------------------------------------------------------------------- ! ! Fortran: %EXTERNALROUTINE GRAREA(%LONGREALNAME XB,YB,XT,YT,%INTEGERNAME L) ! Fortran: %INTEGER M,N ! Fortran: CLOSGR%IF INIT=1<=ERR ! Fortran: M=INTEGER(ADDR(L)) ! Fortran: %UNLESS M>>8=0%THENSTART ! Fortran: ETOI(ADDR(M),4)%IF CHARCODE="EBCDIC" ! Fortran: N=M&16_FF ! Fortran: M=M>>8%UNLESS N='A'%OR N='V' ! Fortran: %FINISH ! Fortran: MAIN=-1 ! Fortran: SETPLOT(XB,YB,XT,YT,M) ! Fortran: MAIN=1 ! Fortran: %END ! !----------------------------------------------------------------------- ! EXTERNALROUTINE AXIS(LONGREAL X,Y,INTEGER CODE,LONGREAL D, C INTEGER N) INTEGER K,S LONGREAL XI,XT,YI,YT RTCALL(6)=RTCALL(6)+1 S=CODE>>8&16_FF CODE=CODE&16_FF IF D<=0OR N<=0THEN K=14ELSE K=0 K=K<<4!8UNLESS1<=CODE<=4OR((S='+'OR S='-'OR S=' 'OR S=0)AND'X'<=CODE<='Y') IF K#0THENSTART GRERRS(K,6) SIGNALEVENT11,KIF MAIN=1=INIT RETURN FINISH IF WOPN=0THENSTART RTFLG=6 GRPLOT(1,X,Y,0,0) D=-DIF3<=CODE<=4OR S='-' IF CODE='Y'OR CODE=2OR CODE=4THENSTART XI=0 YI=D XT=TIC/XSC YT=0 FINISHELSESTART XI=D YI=0 XT=0 YT=TIC/YSC FINISH for S=0,1,N cycle GRPLOT(2,X+XT,Y+YT,0,0) GRPLOT(2,X-XT,Y-YT,0,0) GRPLOT(2,X,Y,0,0) EXITIF S=N X=X+XI Y=Y+YI GRPLOT(2,X,Y,0,0) REPEAT FINISH END ! !----------------------------------------------------------------------- ! ! Fortran: %EXTERNALROUTINE AXISGR(%LONGREALNAME X,Y,%INTEGERNAME DIRN, %C ! Fortran: %LONGREALNAME D,%INTEGERNAME N) ! Fortran: %INTEGER DN ! Fortran: CLOSGR%IF INIT=1<=ERR ! Fortran: DN=INTEGER(ADDR(DIRN)) ! Fortran: %UNLESS1<=DN<=4%THENSTART ! Fortran: ETOI(ADDR(DN),4)%IF CHARCODE="EBCDIC" ! Fortran: %IF'X'<=DN>>24<='Y'%THEN DN=DN>>24%ELSE DN=DN>>16 ! Fortran: %FINISH ! Fortran: MAIN=-1 ! Fortran: AXIS(X,Y,DN,D,N) ! Fortran: MAIN=1 ! Fortran: %END ! !----------------------------------------------------------------------- ! EXTERNALROUTINE POINTSYMBOL(INTEGER CODE,LONGREAL SIZE) CONSTINTEGERARRAY ID(1:15)= C 16_0025,16_01A5,16_0485,16_0285,16_0849, 16_0584,16_0684,16_0384,16_0744,16_002B, 16_0AA5,16_0262,16_01A2,16_0022,16_00E2 OWNINTEGER VST OWNINTEGERARRAY V(0:11)= C 16_00442204,16_40222024,16_220242A4,16_02204284,16_00420084, 16_444000A4,16_40004484,16_2044C002,16_44309001,16_03143443, 16_41301113,16_33311100 INTEGER I,J,K,PEN LONGREAL C,S,XI,XT,YI,YT BYTEINTEGERARRAYNAME BVST !%BYTEINTEGERARRAYFORMAT F(0:47) record format F (byte integer array A(0:47)) record (F) name BVSTR RTFLG=7AND RTCALL(7)=RTCALL(7)+1UNLESS8<=RTFLG<=9 IF WOPN=0THENSTART VST=ADDR(V(0))IF VST=0 !BVST==ARRAY(VST,F) BVSTR == record (addr (VST)) BVST == BVSTR_A XI=UXN YI=UYN IF CODE=DOTTHEN SIZE=UNITELSESTART SIZE=.25*SIZE*XSC SIZE=.25*SYMSIZIF SIZE<UNIT FINISH S=SIZE*STH C=SIZE*CTH CODE=DEFSYMUNLESS1<=CODE<=NSYMS J=ID(CODE) K=J>>6 PEN=J>>5&1+1 for I=K,1,K+J&16_1F-1 cycle J=BVST(I)>>4 J=J-8AND PEN=3-PENIF J>=8 XT=J-2 YT=BVST(I)&15-2 GRPLOT(PEN,XI+XT*C-YT*S,YI+XT*S+YT*C,0,-1) REPEAT PEN=1IF3<=CODE<=9 GRPLOT(PEN,XI,YI,0,-1) FINISH END ! !----------------------------------------------------------------------- ! ! Fortran: %EXTERNALROUTINE PSYMGR(%INTEGERNAME CODE,%LONGREALNAME SIZE) ! Fortran: CLOSGR%IF INIT=1<=ERR ! Fortran: MAIN=-1 ! Fortran: POINTSYMBOL(CODE,SIZE) ! Fortran: MAIN=1 ! Fortran: %END ! !----------------------------------------------------------------------- ! EXTERNALROUTINE LINEGRAPH(LONGREALARRAYNAME X,Y,INTEGER M,N, C LONGREAL DASH,GAP,INTEGER CODE,LONGREAL SIZE) INTEGER DSH,I,PEN,S LONGREAL COMP,DX,DY,L,XI,XM,XT,YI,YM,YT LONGREALARRAY D(1:2) RTCALL(8)=RTCALL(8)+1 UNLESS WOPN#0OR(DASH=0AND CODE=0)THENSTART XM=X(M) YM=Y(M) RTFLG=8 GRPLOT(1,XM,YM,0,0) CODE=DEFSYMUNLESS0<=CODE<=NSYMS POINTSYMBOL(CODE,SIZE)UNLESS CODE=0 IF M#NTHENSTART IF DASH=0THEN PEN=1ELSE PEN=2 IF DASH*XSC>=UNITAND GAP*XSC>=UNITTHENSTART DSH='Y' D(2)=DASH D(1)=GAP COMP=0 FINISHELSE DSH='N' IF M<NTHEN S=1ELSE S=-1 for I=M+S,S,N cycle XI=X(I) YI=Y(I) IF DSH='Y'THENSTART XT=XM YT=YM NXT:DX=XI-XT DY=YI-YT L=SQRT(DX*DX+(DY*YTX)^2) COMP=COMP+L IF COMP>=D(PEN)THENSTART L=(D(PEN)-COMP+L)/L XT=XT+DX*L YT=YT+DY*L GRPLOT(PEN,XT,YT,0,0) PEN=3-PEN COMP=0 ->NXT FINISH PEN=2IF I=N XM=XI YM=YI FINISH GRPLOT(PEN,XI,YI,0,0) POINTSYMBOL(CODE,SIZE)UNLESS CODE=0 REPEAT FINISH RTFLG=0 FINISH END ! !----------------------------------------------------------------------- ! ! Fortran: %EXTERNALROUTINE LINESG(%LONGREALNAME XN,YN,%INTEGERNAME M,N, %C ! Fortran: %LONGREALNAME DASH,GAP,%INTEGERNAME CODE,%LONGREALNAME SIZE) ! Fortran: %INTEGER I ! Fortran: CLOSGR%IF INIT=1<=ERR ! Fortran: %IF M<N%THEN I=N%ELSE I=M ! Fortran: ! ! Fortran: !*********************************************************************** ! Fortran: ! ! Fortran: %BEGIN ! Fortran: %LONGREALARRAYNAME X,Y ! Fortran: %LONGREALARRAYFORMAT F(1:I) ! Fortran: X==ARRAY(ADDR(XN),F) ! Fortran: Y==ARRAY(ADDR(YN),F) ! Fortran: MAIN=-1 ! Fortran: LINEGRAPH(X,Y,M,N,DASH,GAP,CODE,SIZE) ! Fortran: MAIN=1 ! Fortran: %END ! Fortran: ! ! Fortran: !*********************************************************************** ! Fortran: ! ! Fortran: %END ! !----------------------------------------------------------------------- ! EXTERNALROUTINE CURVE(LONGREALARRAYNAME X,Y,INTEGER M,N, C LONGREAL XON,XOF,DX,DY,DASH,GAP,INTEGER CODE,LONGREAL SIZE) INTEGER DSH,I,K,L,NXT,PEN,PT3,S,SWA LONGREAL A0,A1,A2,A3,COMP,DET,DX123,DX124,DX134,DX234,DX123Y4, C DX124Y3,DX134Y2,SPX,SPY,SVX,XDF,XI,XM,XN,XND,XT,YDF,YM,YN,YON,YT LONGREALARRAY D(1:2),PX(1:16),PY(1:7) SWITCH A(1:6) RTCALL(9)=RTCALL(9)+1 XM=X(M) XND=X(N) IF XON>=XOFOR XON>XNDOR XOF<XMTHEN K=6ELSE K=0 IF M<NTHEN S=1ELSE S=-1 for I=M+S,S,N cycle XI=X(I) K=K<<4!7ANDEXITIF XI<=XM XM=XI REPEAT K=K<<4!13IF |M-N|<3 IF K#0THENSTART GRERRS(K,9) SIGNALEVENT11,KIF MAIN=1=INIT RETURN FINISH IF WOPN=0THENSTART CODE=DEFSYMUNLESS0<=CODE<=NSYMS DX=XSMTH/XSCIF DX*XSC<UNIT DY=YSMTH/YSCIF DY*YSC<UNIT IF DASH=0THEN XON=XND+DXELSESTART IF DASH*XSC>=UNITAND GAP*YSC>=UNITTHENSTART DSH='Y' COMP=0 D(1)=GAP D(2)=DASH FINISHELSE DSH='N' FINISH RTFLG=9 PTS:for I=M,S,N cycle XI=X(I) ->RNGEIF XON<XI GRPLOT(1,XI,Y(I),0,0)AND POINTSYMBOL(CODE,SIZE)UNLESS CODE=0 REPEAT GRPLOT(1,XND,Y(N),0,0) RNGE:IF XON<=XNDTHENSTART NXT=I PT3=M+S<<1 IF XI>X(PT3)THENSTART IF I=NTHEN PT3=N-SELSE PT3=I FINISH K=0 for PT3=PT3,S,N-S cycle XI=X(PT3) M=PT3-S<<1 SPX=0 for I=1,1,4 cycle PX(I)=X(M) PY(I)=Y(M) M=M+S SPX=SPX+PX(I) REPEAT L=5 for I=1,1,3 cycle for M=I+1,1,4 cycle PX(L)=PX(M)-PX(I) PX(L+6)=PX(M)*PX(I) PY(L)=PY(M)-PY(I)IF I=1 L=L+1 REPEAT REPEAT DX123=PX(5)*PX(6)*PX(8) DX124=PX(5)*PX(7)*PX(9) DX134=PX(6)*PX(7)*PX(10) DX234=PX(8)*PX(9)*PX(10) DX123Y4=DX123*PY(7) DX124Y3=DX124*PY(6) DX134Y2=DX134*PY(5) DET=PX(8)/(DX123*DX234*PX(7)) A0=((PY(1)*PX(14)*DX234-PY(2)*PX(12)*DX134+PY(3)*PX(11)*DX124)*PX(4) C -PY(4)*PX(11)*PX(3)*DX123)*DET A1=(DX134Y2*(PX(12)+PX(13)+PX(16))-DX124Y3*(PX(11)+PX(13)+PX(15)) C +DX123Y4*(PX(11)+PX(12)+PX(14)))*DET A2=(-DX134Y2*(SPX-PX(2))+DX124Y3*(SPX-PX(3))-DX123Y4*(SPX-PX(4)))*DET A3=(DX134Y2-DX124Y3+DX123Y4)*DET IF K=0THENSTART XM=XON YM=A0+XON*(A1+XON*(A2+XON*A3)) GRPLOT(1,XM,YM,0,0) PEN=2 K=1 FINISH A(1):XON=XON+DX XON=XOFAND K=4IF XON>=XOF SVX=XONAND XON=XIAND K=5IF XON>XIAND PT3#N-S YON=A0+XON*(A1+XON*(A2+XON*A3)) YDF=YON-YM ->STEPYIF |YDF|>DY NOW:XN=XON YN=YON I=K AND:SWA=I ->DRAWUNLESS DSH='Y' SPX=XN SPY=YN DIST:DET=SQRT((XN-XM)^2+((YN-YM)*YTX)^2) COMP=COMP+DET IF COMP<D(PEN)THENSTART PEN=2IF K=4 FINISHELSESTART DET=(D(PEN)-COMP+DET)/DET XN=XM+(XN-XM)*DET YN=YM+(YN-YM)*DET SWA=3 FINISH DRAW:WHILE X(NXT)<=XNAND CODE#0CYCLE GRPLOT(PEN,X(NXT),Y(NXT),0,0) POINTSYMBOL(CODE,SIZE) IF NXT=NTHEN CODE=0ELSE NXT=NXT+S REPEAT GRPLOT(PEN,XN,YN,0,0) XM=XN YM=YN ->A(SWA) A(3):PEN=3-PEN COMP=0 SWA=I XN=SPX YN=SPY ->DIST STEPY:XT=XM+(XON-XM)*DY/|YDF| IF YDF>=0THEN YT=DYELSE YT=-DY YN=YM I=2 A(2):YN=YN+YT ->NOWIF(YON-YN)*YDF<=0 cycle XN=(YN-A0+XT*XT*(A2+2*A3*XT))/(A1+XT*(2*A2+3*A3*XT)) XDF=|XT-XN| XT=XN repeat until XDF*XSC<=UNIT ->ANDIF XM<=XN<=XON I=6 XT=UNIT/XSC A(6):XN=XM+XT IF XN>=XONTHEN->NOWELSE YN=A0+XN*(A1+XN*(A2+XN*A3))AND->AND A(4):XON=XND+DX M=NXT ->PTS A(5):XON=SVX-DX K=1 REPEAT FINISH RTFLG=0 FINISH END ! !----------------------------------------------------------------------- ! ! Fortran: %EXTERNALROUTINE CURVGR(%LONGREALNAME XN,YN,%INTEGERNAME M,N, %C ! Fortran: %LONGREALNAME XON,XOF,DX,DY,DASH,GAP,%INTEGERNAME CODE, %C ! Fortran: %LONGREALNAME SIZE) ! Fortran: %INTEGER I ! Fortran: CLOSGR%IF INIT=1<=ERR ! Fortran: %IF M<N%THEN I=N%ELSE I=M ! Fortran: ! ! Fortran: !*********************************************************************** ! Fortran: ! ! Fortran: %BEGIN ! Fortran: %LONGREALARRAYNAME X,Y ! Fortran: %LONGREALARRAYFORMAT F(1:I) ! Fortran: X==ARRAY(ADDR(XN),F) ! Fortran: Y==ARRAY(ADDR(YN),F) ! Fortran: MAIN=-1 ! Fortran: CURVE(X,Y,M,N,XON,XOF,DX,DY,DASH,GAP,CODE,SIZE) ! Fortran: MAIN=1 ! Fortran: %END ! Fortran: ! ! Fortran: !*********************************************************************** ! Fortran: ! ! Fortran: %END ! !----------------------------------------------------------------------- ! ENDOFFILE