c HVPLOT Part O c c Control Subroutines for HVPLOT c c Dr R N Caffin and S L Hewett c CSIRO Div of Textile Physics c 338 Blaxland Rd c Ryde N S W 2112 c Australia c c 21-Sep-84 c c c****** Full initialization returning the plotter's graphic conditions to c the initial power on state. Also initailizing the RS-232 c environment. Subroutine INIT !INIT common /zzhv/hv,plonsw,flh,flv,flsh,flsv byte hv,plonsw,flh,flv,flsh,flsv common /zzhpf/xmin,xmax,ymin,ymax common /zzvf/xminv,xmaxv,yminv,ymaxv common /zzvsc/xmul,ymul common /zzhpb/etx,si,so,esc,EPp(3),Ebsl(2),dum byte etx,si,so,esc,EPp,Ebsl,dum data xminv,xmaxv,yminv,ymaxv/0.,767.,0.,479./ data xmul,ymul/1.0,1.0/ data etx,si,so,esc/"003,"017,"016,"033/ data EPp/0,0,0/,Ebsl/0,0/ byte ans c Pre-INIT value data hv,plonsw,flh,flv/0,.false.,.false.,.false./ data flsh,flsv/.false.,.false./ c RT-11 specific data real*4 handlr data handlr/3RPL / c Choose which output device. 10 type 1000 1000 format(x,'Output device? Plotter (H) or VT125 (V)',$) accept 1010,ans 1010 format(a1) if(ans.eq.'h')ans='H' if(ans.eq.'v')ans='V' if(ans.ne.'H'.and.ans.ne.'V')goto 10 hv=(ans.eq.'V') if(hv)goto 500 plonsw=.true. flh=.true. c RT-11 Specific code: alter to suit for other systems. c open(unit=9, name='PL:', type= 'NEW', carriagecontrol='LIST') i=ifetch(handlr) if(i.eq.0)goto 20 stop 'HVPLOT-F-Error loading PL Handler' 20 write(9,1020)esc,esc,esc 1020 format(A1,'.Y','IN',A1,'.I100;;17:',A1,'.N;19:') goto 999 c*** To initialize the VT125 for plotting 500 flv=.true. EPp(1)="033 !Init VT125 command codes EPp(2)='P' EPp(3)='p' Ebsl(1)="033 Ebsl(2)='\' type 5000, 5000 format() !Might keep things tidy type 5010,esc,esc,Ebsl 5010 format('+',A1,'[2J',A1,'P0p',2a1) !Clear text scrn, enter REGIS call vtclr !Clear the screen. 999 return end c****** To enable switching between devices Subroutine DEVSWT(ans) common /zzhv/hv,plonsw,flh,flv byte hv,plonsw,flh,flv byte ans if(ans.eq.'H'.and.flh)hv=.false. if(ans.eq.'V'.and.flv)hv=.true. return end c****** Returns plotter to default conditions Subroutine RESTOR !RESTOR common /zzhv/hv,plonsw byte hv,plonsw if(hv)goto 500 10 if(.not.plonsw)goto 999 !Check for already off write(9,1000) 1000 format('DF;') goto 999 c*** Not implemented on VT125 500 continue 999 return end c****** Establishes a user-unit coordinate system by mapping values onto c the scaling points P1 and P2. Subroutine SCALE(xmn,xmx,ymn,ymx) !SCALE common /zzhpf/xmin,xmax,ymin,ymax common /zzvf/xminv,xmaxv,yminv,ymaxv common /zzvsc/xmul,ymul common /zzhv/hv,plonsw,flh,flv,flsh,flsv byte hv,plonsw,flh,flv,flsh,flsv if(hv)goto 500 10 if(.not.plonsw)goto 999 !Check for already off flsh=.true. xmin=xmn xmax=xmx ymin=ymn ymax=ymx write(9,1000) xmin,xmax,ymin,ymax 1000 format('SC ',4(x,f10.3),';') goto 999 c*** To establish the user-unit coordinate system for use in SCL. 500 flsv=.true. xminv=xmn xmaxv=xmx yminv=ymn ymaxv=ymx xmul=0.99*769./(xmaxv-xminv) !.99 to avoid very grotty ymul=0.99*479./(ymaxv-yminv) ! behaviour on overflow! 999 return end c****** To select and/or store one of two pens. c 0....to store the pen. c Odd number for the left pen. c Even number for the righthand pen. Subroutine SELECT(n) !SELECT(n) common /zzhv/hv,plonsw byte hv,plonsw common /zzhpb/etx,si,so,esc,EPp(3),Ebsl(2),dum byte etx,si,so,esc,EPp,Ebsl,dum byte b if(hv)goto 500 10 if(.not.plonsw)goto 999 !Check for already off write(9,1000) n 1000 format('SP ',I1,';') goto 999 c*** To alter the standard character set, to a loadable one. c I don't think this is going to be of any use!!! c For variable character sets, you are better off using VT100 mode. 500 continue 999 return end c***** To turn the plotter OFF after a plot. c This helps to avoid a whole lot of garbage left in the Fortran buffer c from being executed. Under RT-11 the special bit also kills the c interupt enables on the serial port, thereby improving the life and c welfare of the entire system. Subroutine PLOFF() !PLOFF common /zzhv/hv,plonsw byte hv,plonsw common /zzhpb/etx,si,so,esc,EPp(3),Ebsl(2),dum byte etx,si,so,esc,EPp,Ebsl,dum if(hv)goto 500 10 if(.not.plonsw)goto 999 !Check for already off call select(0) !Put pen away write(9,1000) esc 1000 format(A1,'.Z') rewind 9 !Force output at this stage. plonsw=.false. c i=ilun(9) !RT-11 special bit: get channel no i=ispfnw("200,i,0,,) ! and kill handler (code="200, wcnt=0) c goto 999 c*** To switch off REGIS mode. 500 type 5000,Ebsl 5000 format('+',2a1) 999 return end c****** To turn the plotter ON after PLOFF has turned it off, and to c load pen i. Subroutine PLON(i) !PLON common /zzhv/hv,plonsw byte hv,plonsw common /zzhpb/etx,si,so,esc,EPp(3),Ebsl(2),dum byte etx,si,so,esc,EPp,Ebsl,dum if(hv)goto 500 10 if(plonsw)goto 999 !On already? write(9,1000) esc 1000 format(A1,'.Y') call select(i) rewind 9 !Force output again. plonsw=.true. goto 999 c*** To switch back to REGIS mode. 500 type 5000,EPp 5000 format('+',3a1) 999 return end c*** To totally zap the graphics screen Subroutine VTCLR !VTCLR common /zzhv/hv,plonsw byte hv,plonsw common /zzhpb/etx,si,so,esc,EPp(3),Ebsl(2),dum byte etx,si,so,esc,EPp,Ebsl,dum if(hv)goto 500 c Not required for plotter goto 999 500 type 5000,EPp,Ebsl !Clear the screen 5000 format('+',3a1,'S(e)',2a1) 999 return end c VT125 auxilary routines used inside the package c*** To move n pixels in direction ii. Subroutine PICK(ii,n) !PICK common /zzhv/hv,plonsw byte hv,plonsw common /zzhpb/etx,si,so,esc,EPp(3),Ebsl(2),dum byte etx,si,so,esc,EPp,Ebsl,dum if(hv)goto 500 c Not required for plotter goto 999 500 if(ii.lt.0.or.ii.gt.7)return type 5000,EPp ! 2 5000 format('+',3a1,'P') ! 3 1 do 510 i=1,n ! 4 . 0 type 5010,ii ! 5 7 5010 format('+',I1) ! 6 510 continue type 5020,Ebsl 5020 format('+',2a1) 999 return end c*** To scale the location chosen to screen coordinates. c User space is (xx,yy); VT125 space is (x,y) Subroutine SCL(xx,yy,x,y) !SCL common /zzhv/hv,plonsw,flh,flv,flsh,flsv byte hv,plonsw,flh,flv,flsh,flsv common /zzvf/xminv,xmaxv,yminv,ymaxv common /zzvsc/xmul,ymul if(hv)goto 500 c Not required by plotter goto 999 500 if(.not.(flv.and.flsv))stop 'Call INIT and SCALE first' x=(xx-xminv)*xmul y=479.-(yy-yminv)*ymul 999 return end c*** To draw n pixels in direction ii. Subroutine TICK(ii,n) !TICK common /zzhv/hv,plonsw byte hv,plonsw common /zzhpb/etx,si,so,esc,EPp(3),Ebsl(2),dum byte etx,si,so,esc,EPp,Ebsl,dum if(hv)goto 500 c Not required by plotter goto 999 500 if(ii.lt.0.or.ii.gt.7)return type 5000,EPp 5000 format('+',3a1,'V') do 510 i=1,n type 5010,ii 5010 format('+',I1) 510 continue type 5020,Ebsl 5020 format('+',2a1) 999 return end c*** To draw the ticks on the axis. c false= vert c true=horiz Subroutine ATICK(flag) common /zzhv/hv,plonsw byte hv,plonsw common /zzhpb/etx,si,so,esc,EPp(3),Ebsl(2),dum byte etx,si,so,esc,EPp,Ebsl,dum byte flag,char1,char2 if(hv)goto 500 c Not required by plotter goto 999 500 char1='4' !Assume flag false char2='0' if(flag)char1='6' if(flag)char2='2' type 5000,EPp,(char1,i=1,4),(char2,i=1,9),Ebsl 5000 format('+',3a1,'P',4a1,'V',9a1,2a1) 999 return end