! 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