c c subroutine CHRSET(ISETNO,IOP,IFONT) COMMON/CLIP/X1,Y1,Z1,W1,WEC1(6),IOCOD1,THERE,iplot LOGICAL THERE,set,op if (iplot.eq.3) then if (isetno.eq.1) then set='S' else if (isetno.eq.2) then set='A' else set=0 endif if (iop.eq.0) then call ascout('C') call ascout(set) if (ifont.lt.0 .or. ifont.gt.4) ifont=0 ifont=ifont+48 call ascout(ifont) else call chrplt(0.,0.) call ascout('S') call ascout(set) endif call ascout(';') else type *,' CHRSET unavailable for IPLOT:',iplot endif return end c c subroutine ALFDIR(RUN,RISE,ABSREL) COMMON/CLIP/X1,Y1,Z1,W1,WEC1(6),IOCOD1,THERE,iplot LOGICAL THERE,OUTVAL(12) if (iplot.eq.3) then call ascout('D') if (absrel.ne.1) call ascout('I') if (absrel.eq.1) call ascout('R') encode(12,100,outval) run,rise 100 format(f5.1,',',f5.1,';') call vecout(12,outval) else type *,' ALFDIR unavailable for IPLOT:',iplot endif return end c c subroutine ALFSIZ(WIDTH,HEIGHT,ABSREL) COMMON/CLIP/X1,Y1,Z1,W1,WEC1(6),IOCOD1,THERE,iplot LOGICAL THERE,OUTVAL(12) real width,height if (iplot.eq.3) then call ascout('S') if (absrel.ne.1) call ascout('I') if (absrel.eq.1) call ascout('R') if (width.ne.0.0 .and. height.ne.0.0) then encode(12,100,outval) width,height 100 format(f5.1,',',f5.1,';') call vecout(12,outval) else call ascout(';') endif else type *,' ALFSIZ unavailable for IPLOT:',iplot endif return end c c subroutine CHRROT(ANGLE) COMMON/CLIP/X1,Y1,Z1,W1,WEC1(6),IOCOD1,THERE,iplot LOGICAL THERE byte outval(7) if (iplot.eq.3) then RADS=ANGLE*3.1415926/180.0 TANGNT=TAN(RADS) call ascout('S') call ascout('L') ENCODE(7,100,OUTVAL) TANGNT 100 format(f6.1,';') call vecout(7,outval) else type *,' CHRROT unavailable for IPLOT:',iplot endif return end c c subroutine CHRPLT(rINCWD,rINCHT) COMMON/CLIP/X1,Y1,Z1,W1,WEC1(6),IOCOD1,THERE,iplot LOGICAL THERE byte outval(16) if (iplot.eq.3) then encode(16,100,outval) rincwd,rincht 100 format('CP',f6.2,',',f6.3,';') call vecout(16,outval) else type *,' CHRPLT unavailable for IPLOT:',iplot endif return end c c subroutine ENQUIR(IOP,STAT1,STAT2,STAT3) COMMON/CLIP/X1,Y1,Z1,W1,WEC1(6),IOCOD1,THERE,iplot LOGICAL THERE INTEGER STAT1,STAT2,STAT3 if (iplot.eq.3) then if (iop.le.1) then call ascout('O') call ascout('A') else if (iop.eq.2) then call ascout('O') call ascout('C') else if (iop.eq.3) then call ascout('O') call ascout('E') else if (iop.eq.4) then call ascout('O') call ascout('S') else if (iop.eq.5) then call ascout(27) call ascout('.') call ascout('L') else if (iop.eq.6) then call ascout(27) call ascout('.') call ascout('B') else if (iop.eq.7) then call ascout(27) call ascout('.') call ascout('E') endif if (iop.le.4) call ascout(';') if (iop.le.2) then read (6,*) stat1,stat2,stat3 else if (iop.le.7) then read (6,*) stat1 stat2=0 stat3=0 endif else type *,' ENQUIR unavailable for IPLOT:',iplot endif return end c c subroutine INWNDW(ixlwlt,iylwlt,ixuprt,iyuprt) COMMON/CLIP/X1,Y1,Z1,W1,WEC1(6),IOCOD1,THERE,iplot LOGICAL THERE BYTE OUTVAL(26) if (iplot.eq.3) then encode(26,100,outval) ixlwlt,iylwlt,ixuprt,iyuprt 100 format('IW',i6,',',i6,',',i6,',',i6,';') call vecout(26,outval) else type *,' INWNDW unavailable for IPLOT:',iplot endif return end c c subroutine DIGITZ(IOP,IX,IY,IP) COMMON/CLIP/X1,Y1,Z1,W1,WEC1(6),IOCOD1,THERE,iplot LOGICAL THERE if (iplot.eq.3) then if (iop.eq.1) then call ascout('D') call ascout('P') call ascout(';') else if (iop.eq.2) then call enquir(4,istat,idum,idumb) istat=iand(4,istat) ix=istat else if (iop.eq.3) then call ascout('O') call ascout('D') call ascout(';') read (6,*) ix,iy,ip else call ascout('D') call ascout('C') call ascout(';') endif else type *,' DIGITZ unavailable for IPLOT:',iplot endif return end