c HVPLOT Part III c c Error Checking, Digitising and Reading Subroutines c & Plotter identification 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 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 Error Checking Subroutines for HVPLOT Subroutine CHECK 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 common /zzhpb/etx,si,so,esc byte hv,plonsw byte etx,si,so,esc c if(hv)goto 500 c Error Checking for the HP Plotters c write(hp,1000) 1000 format('OE ;') !Ask for HP-GL errors 90 call pread(I1,nQ) if(nq.eq.0)goto 90 if(I1.eq.0)goto 100 write(tt,1010)I1 1010 format(x,'HP-GL Error code: ',I3) c 100 write(hp,1020) esc 1020 format(A1,'.E') !Ask for RS232C errors call pread(I1,nQ) if(nq.eq.0)goto 100 if(I1.eq.0)goto 120 write(tt,1030)I1 1030 format(x,'RS232C Error code: ',I3) c 120 write(tt,1040) 1040 format(x,'Plotter Status checked OK.') c 500 return end c Special READ routine for CHECK subroutine Pread(I1,nQ) C HP and TT contain the device numbers for the terminal and the plotter integer hp,tt common /HPTTNO/hp,tt c rewind hp !To allow Fortran to read from it i=isleep(0,0,0,10) read(hp,1020,err=150) nQ,I1 1020 format(Q,I6) rewind hp !Back to write mode return c 150 write(tt,1030)I1,nQ 1030 format(x,,'Pread error: I1=',I6,' nQ=',I6) return c end c Digitising routine for Plotter Subroutine Digitz(x,y,done) C HP and TT contain the device numbers for the terminal and the plotter integer hp,tt common /HPTTNO/hp,tt real*8 plotter real*4 sclx1,sclx2,scly1,scly2 common /plotid/plooter,sclx1,sclx2,scly1,scly2 common /zzhpf/xmin,xmax,ymin,ymax,tlenp,tlenn,angle integer ix,iy,ip,lastx,lasty logical*1 done data lastx,lasty/-32000,-32000/ rewind hp !Just in case call send('DP;') !Into digitise mode write(tt,1000)7 1000 format('+',a1,$) !Beep the operator 100 rewind hp !Required for looping from below call send('OS;') !Ask for status 110 rewind hp !Turn around/jam out i=isleep(0,0,0,10) !God knows why, but it's needed read(hp,1010)nq,i !Get status 1010 format(Q,I6) if(nQ.eq.0)goto 110 !Try again if not returned yet if((i.and.4).eq.0)goto 100 !Wait till user hits plotter "Enter" rewind hp !Turn around call send('OD;') !Send the point values 120 rewind hp !Jam out/turn around i=isleep(0,0,0,10) read(hp,1020)nq,ix,iy,ip !Read parameters 1020 format(Q,3I6) if(nQ.eq.0)goto 120 !If not returned, try again done=.false. if(lastx.eq.ix.and.lasty.eq.iy)done=.true. lastx=ix lasty=iy x=float(ix-250)*(xmax-xmin)/10000.+xmin !Now convert to user y=float(iy-279)*(ymax-ymin)/7200. +ymin ! scales return end c Plotter READ routines subroutine Pread1(I1) !Read one integer variable C HP and TT contain the device numbers for the terminal and the plotter integer hp,tt common /HPTTNO/hp,tt c 10 rewind hp !To allow Fortran to read from it i=isleep(0,0,0,10) read(hp,1020,err=150) nQ,I1 1020 format(Q,I6) if(nQ.eq.0)goto 10 !Check: was data received? c 100 rewind hp !Back to write mode return c 150 write(tt,1030)I1 1030 format(x,'Pread1 error: I1=',I6) goto 100 c end subroutine Pread2(I1,I2) !Read two integer variables C HP and TT contain the device numbers for the terminal and the plotter integer hp,tt common /HPTTNO/hp,tt c 10 rewind hp !To allow Fortran to read from it i=isleep(0,0,0,10) read(hp,1020,err=150) nQ,I1,I2 1020 format(Q,2I6) write(tt,1030)nQ 1030 format(x,'nQ=',I6) if(nQ.eq.0)goto 10 100 rewind hp !Back to write mode return c 150 write(tt,1040)I1,I2 1040 format(x,'Pread2 error: I1,2=',I6,',',I6) goto 100 c end subroutine Pread3(I1,I2,I3) !Read three integer variables C HP and TT contain the device numbers for the terminal and the plotter integer hp,tt common /HPTTNO/hp,tt c 10 rewind hp !To allow Fortran to read from it i=isleep(0,0,0,10) read(hp,1020,err=100)nQ,I1,I2,I3 1020 format(Q,3I6) if(nQ.eq.0)goto 10 rewind hp !Back to write mode return c 100 write(tt,1030)I1,I2,I3 1030 format(x,,'Pread3 error: I1,2,3=',2(I6,','),I6) return c end subroutine Pread4(I1,I2,I3,I4) !Read four integer variables C HP and TT contain the device numbers for the terminal and the plotter integer hp,tt common /HPTTNO/hp,tt c 10 i=isleep(0,0,0,10) rewind hp !To allow Fortran to read from it i=isleep(0,0,0,10) read(hp,1020,err=100) nQ,I1,I2,I3,I4 1020 format(Q,4I6) if(nQ.eq.0)goto 10 rewind hp !Back to write mode return c 100 write(tt,1030)I1,I2,I3,I4 1030 FORMAT(X,'Pread4 error: I1,2,3,4=',3(I6,','),I6) return c end subroutine Pread5(STRING) !Read in a string variable C HP and TT contain the device numbers for the terminal and the plotter integer hp,tt common /HPTTNO/hp,tt logical*1 string(1) c j=0 10 i=isleep(0,0,0,10) string(1)=0 rewind hp !To allow Fortran to read from it i=isleep(0,0,0,10) read(hp,1020,err=100)nQ,(string(i),i=1,nq) j=j+1 1020 format(Q,80a1) if((nQ.eq.0).and.(j.lt.20))goto 10 rewind hp !Back to write mode string(nq+1)=0 return c 100 write(tt,1030) 1030 FORMAT(X,'Pread5 error:') return end C C 3-Mar-88 by E Grigolato C Boyne Smelters Ltd C Gladstone, Qld. 4680 C Australia C C This section contains the following subroutines. C subroutine IDPLOT C SUBROUTINE IDPLOT(plotter) C This subroutine determines the type of your PLOTTER. C REAL*8 PLOTID,plotter LOGICAL*1 STRING(10) EQUIVALENCE (STRING(1),PLOTID) call scopy('UNKNOWN ',string) C due to communication problems due to noise on the serial line C the query may be repeated several times.A MAXIMIUM OF 6 RETRIES C IS ALLOWED. I=0 1 I=I+1 CALL SEND('OI;') CALL PREAD5(STRING) CALL TRIM(STRING) IF (LEN(STRING).GT.0)GOTO 5 IF (I.LE.5)GOTO 1 GOTO 10 5 CALL STRPAD(STRING,8) plotter=plotid 10 RETURN END