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 addition of terminal identification,colour and line types on C regis terminals,device names & controlled abort flag C C 3-Mar-88 by E Grigolato C Boyne Smelters Ltd C Gladstone, Qld. 4680 C Australia 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.,449./ 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 C CONTROLLED ABORT FLAG INTEGER Q COMMON /TEMP/Q C C HP and TT contain the device numbers for the terminal and the plotter integer hp,tt common /HPTTNO/hp,tt c Pre-INIT value data hv,plonsw,flh,flv/0,.false.,.false.,.false./ data flsh,flsv/.false.,.false./ c RT-11 specific data INTEGER PL(4) DATA PL/3RPL ,0,0,0/ real*4 handlr data handlr/3RPL / C Terminal & plotter type Real*8 tttype,plotter,unknow integer colour data tttype/'UNKNOWN '/ data plotter/'UNKNOWN '/ data unknow/'UNKNOWN '/ common/ttid/tttype,colour real*4 sclx1,sclx2,scly1,scly2 data sclx1,sclx2,scly1,scly2/1.0,0.,1.0,0./ common /plotid/plotter,sclx1,sclx2,scly1,scly2 C LOCAL DATA logical*1 termid(80),reply(80) real*8 vttype,vt(5) integer nooftt data nooftt/5/ data vt(1)/'VT125 '/ data vt(2)/'VT240 '/ data vt(3)/'VT241 '/ data vt(4)/'VT330 '/ data vt(5)/'VT340 '/ equivalence(vttype,termid(1)) c RT-11/TSX+ Specific code: alter to suit for other systems. c if (TSX().eq..FALSE.)GOTO 10 CALL IALOC(PL,I,J) IF (J.LE.0)GOTO 10 WRITE(TT,5)J 5 FORMAT(X,'HVPLOT-W-Error - allocate error no.',I5, 1 /,x,'Can not allocate PL handler to user.Will only support', 2 ' Regis terminals.') goto 17 10 open(unit=hp, name='PL:', type= 'NEW', 1 carriagecontrol='LIST',err=15) i=ifetch(handlr) if(i.eq.0)goto 20 15 write(tt,1015) 1015 format(x,'HVPLOT-W-Error loading PL Handler',/,X,'Can not ', 1'communicate with the plotter can only support Regis', 2' terminals.') if (TSX())CALL IDALOC(PL,I,J) 17 hv=.true. goto 500 20 plonsw=.true. flh=.true. write(hp,1020)esc,esc,esc,esc 1020 format(A1,'.Y',A1,'.P1:','IN',A1,'.I100;;17:',A1,'.N;19:') c obtain plotter identification,no reply assume line not connected. call idplot(plotter) if (plotter.ne.unknow) goto 400 write(tt,1025) 1025 format(x,'HVPLOT-W-Error',/,X,'Can not ', 1'communicate with the plotter can only support Regis', 2' terminals.') CALL PLOFF hv=.true. plonsw=.false. flh=.false. goto 500 400 plonsw=.true. flh=.true. CALL PLOFF c*** To initialize the VT125 for plotting 500 CALL IDTERM(TERMID,REPLY) tttype=vttype do 600 i=1,nooftt if (tttype.eq.vt(i)) goto 800 600 continue write(tt,700)tttype 700 format(x,'Terminal identification indicates that this ', 1 'not a regis terminal.',/,x,'The terminal type is ',A8) if (FLH) goto 750 705 write(tt,710) 710 format(x,'HVPLOT-W-Error - No graphics device available.', 1 /,X,'Continue [Y/N] ? ',$) read(tt,770,end=888)ans if ((ans.eq.'y').or.(ans.eq.'Y')) goto 999 if ((ans.eq.'n').or.(ans.eq.'N')) goto 888 goto 705 750 write(tt,760) 760 format(x,'HVPLOT-W-Error - Only plotter support available.', 1 /,X,'Continue [Y/N] ? ',$) read(tt,770,end=888)ans 770 format(a1) if ((ans.eq.'y').or.(ans.eq.'Y')) goto 999 if ((ans.eq.'n').or.(ans.eq.'N')) goto 888 goto 750 800 colour=1 if (i.eq.2)colour=4 if (i.eq.5)colour=8 if (FLH)goto 900 805 write(tt,810) 810 format(x,'HVPLOT-W-Error - Only terminal support available.', 1 /,X,'Continue [Y/N] ? ',$) read(tt,770,end=888)ans hv=.true. if ((ans.eq.'y').or.(ans.eq.'Y')) goto 1090 if ((ans.eq.'n').or.(ans.eq.'N')) goto 888 goto 805 C c Choose which output device. 900 write(tt,1000) 1000 format(x,'Output device? Plotter (H),', 1 'ReGIS Terminal (V),Exit(^Z)',$) read(tt,1010,END=888)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 900 hv=(ans.eq.'V') 1090 flv=.true. EPp(1)="033 !Init VT125 command codes EPp(2)='P' EPp(3)='p' Ebsl(1)="033 Ebsl(2)='\' write(tt,5000) 5000 format() !Might keep things tidy write(tt,5010)esc,esc,esc,Ebsl 5010 format('+',A1,'[2J',A1,'[?3l',A1,'P0pT(S1)',2a1) !Clear text scrn, c enter REGIS call vtclr !Clear the screen. CALL SELECT(1) CALL SETLTS GOTO 999 888 Q=1 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 C HP and TT contain the device numbers for the terminal and the plotter integer hp,tt common /HPTTNO/hp,tt common /zzhv/hv,plonsw byte hv,plonsw if(hv)goto 500 10 if(.not.plonsw)goto 999 !Check for already off write(hp,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 C HP and TT contain the device numbers for the terminal and the plotter integer hp,tt common /HPTTNO/hp,tt real*8 plotter common /plotid/plotter,sclx1,sclx2,scly1,scly2 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 c due to the limits of HP plotters to scale small numbers,all data will c be scaled from -100. to 100.0 RNEG=-100. R100=100. sclx1=(R100-(RNEG))/(xmx-xmn) sclx2=((RNEG*xmx)-(R100*xmn))/(xmx-xmn) scly1=(R100-(RNEG))/(ymx-ymn) scly2=((RNEG*ymx)-(R100*ymn))/(ymx-ymn) t1=xmin*sclx1+sclx2 t2=xmax*sclx1+sclx2 t3=ymin*scly1+scly2 t4=ymax*scly1+scly2 write(hp,1000) t1,t2,t3,t4 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*767./(xmaxv-xminv) !.99 to avoid very grotty ymul=0.99*449./(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) C HP and TT contain the device numbers for the terminal and the plotter integer hp,tt common /HPTTNO/hp,tt 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 C Terminal type Real*8 tttype integer colour common/ttid/tttype,colour c logical*1 scolor(10) call scopy('WRGBCYM',scolor) if(hv)goto 500 10 if(.not.plonsw)goto 999 !Check for already off write(hp,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 if (n.le.0) return i=mod(n,colour) if (colour.eq.1)i=1 if (i.eq.0)i=colour if (i.ge.8) goto 600 write(tt,5000)EPp,scolor(i),Ebsl !Change colour 5000 format('+',3a1,'W(I(',a1,'))',2a1) return c choose colour 8 ,brown standard for VT340 terminals 600 write(tt,6000)EPp,Ebsl 6000 format('+',3a1,'W(I(H120L43S39))',2a1) 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 C HP and TT contain the device numbers for the terminal and the plotter integer hp,tt common /HPTTNO/hp,tt common /zzhv/hv,plonsw byte hv,plonsw INTEGER PL(4) DATA PL/3RPL ,0,0,0/ common /zzhpb/etx,si,so,esc,EPp(3),Ebsl(2),dum byte etx,si,so,esc,EPp,Ebsl,dum if(hv) RETURN ! MODIFIED ,DO NOT USE UNLESS NECESSARY 10 if(.not.plonsw)goto 999 !Check for already off call select(0) !Put pen away write(hp,1000) esc 1000 format(A1,'.Z') rewind hp !Force output at this stage. plonsw=.false. c i=ilun(hp) !RT-11 special bit: get channel no i=ispfnw("200,i,0,,) ! and kill handler (code="200, wcnt=0) IF (TSX())CALL IDALOC(PL,I,J) c goto 999 c*** To switch off REGIS mode. 500 write(tt,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 C HP and TT contain the device numbers for the terminal and the plotter integer hp,tt common /HPTTNO/hp,tt common /zzhv/hv,plonsw byte hv,plonsw INTEGER PL(4) DATA PL/3RPL ,0,0,0/ 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 20 !On already? write(hp,1000) esc 1000 format(A1,'.Y') 20 IF (TSX().EQ..FALSE.) GOTO 30 CALL IALOC(PL,L,J) IF (J.LE.0) GOTO 30 WRITE(TT,1010)J 1010 FORMAT(X,/,X,'HVPLOT-W-Error Can not allocate PL to user/job.', 1 /,X,'Allocate error no. ',I5) plonsw=.FALSE. GOTO 999 30 plonsw=.true. call select(i) rewind hp !Force output again. goto 999 c*** To switch back to REGIS mode. 500 CALL SELECT(I) D write(tt,5000)EPp ! NOT REQUIRED D5000 format('+',3a1) 999 return end c*** To totally zap the graphics screen,BUT NOT TEXT SCREEN Subroutine VTCLR !VTCLR C HP and TT contain the device numbers for the terminal and the plotter integer hp,tt common /HPTTNO/hp,tt 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 write(tt,5000)esc,EPp,Ebsl !Clear the screen 5000 format('+',A1,'[2J',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 C HP and TT contain the device numbers for the terminal and the plotter integer hp,tt common /HPTTNO/hp,tt 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 write(tt,5000)EPp ! 2 5000 format('+',3a1,'P') ! 3 1 do 510 i=1,n ! 4 . 0 write(tt,5010)ii ! 5 7 5010 format('+',I1) ! 6 510 continue write(tt,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 C HP and TT contain the device numbers for the terminal and the plotter integer hp,tt common /HPTTNO/hp,tt 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=449.-(yy-yminv)*ymul 999 return end c*** To draw n pixels in direction ii. Subroutine TICK(ii,n) !TICK C HP and TT contain the device numbers for the terminal and the plotter integer hp,tt common /HPTTNO/hp,tt 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 write(tt,5000)EPp 5000 format('+',3a1,'V') do 510 i=1,n write(tt,5010)ii 5010 format('+',I1) 510 continue write(tt,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) C HP and TT contain the device numbers for the terminal and the plotter integer hp,tt common /HPTTNO/hp,tt 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' write(tt,5000)EPp,(char1,i=1,4),(char2,i=1,9),Ebsl 5000 format('+',3a1,'P',4a1,'V',9a1,2a1) 999 return end