c HVPLOT Part II c c Sundry 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 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 Sundry Subroutines for HVPLOT C c Subroutine SETCA(n) c Subroutine SETCS(n) c Subroutine SETIP(ip1x,ip1y,ip2x,ip2y) c Subroutine SETIW(xll,yll,xur,yur) c Subroutine SETLT(npat,patl) c Subroutine SETLTS c Subroutine SETSA c Subroutine SETSL(ang) c Subroutine SETSM(ch) c Subroutine SETSR(wd,hg) c Subroutine SETSS c Subroutine SETTL(tp,tn) c Subroutine SETVS(s) c Sundry Routines for HP-GL Plotters c****** Choose which character set is to be used as the standard alternate, c initialized as set zero. Subroutine SETCA(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 if(hv)return write(hp,1000)n 1000 format('CA ',I2,';') return end c****** To choose which character set is to be used as the standard main, c initialized as set zero. Subroutine SETCS(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 if(hv)return write(hp,1000)n 1000 format('CS ',I2,';') return end c****** Redefine the basic plotter reference points P1 and P2, in absolute c plotter terms. The defaults are (250,279) and (10250,7479). c Mainly of use if you want to scale plots down or asymetrically c compress them. Subroutine SETIP(ip1x,ip1y,ip2x,ip2y) 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)return write(hp,1000)ip1x,ip1y,ip2x,ip2y 1000 format('IP',4(x,I5),';') return end c****** To set the window for plotting to take place, specifying the lower- c left and upper right coordinates of window. Subroutine SETIW(xll,yll,xur,yur) 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)return write(hp,1000)xll,yll,xur,yur 1000 format('IW ',4(x,f10.3),';') return end c****** To define the line type used in drawing lines. Npat is an integer c from 0 to 6. Patl is % diagonal distance between P1 and P2. c Default is 4%, -ve or >128 is an error. c To return to solid line call SETLTS or use npat = -1. c Npat: c -1 => ______________________________ c 0 => Dots at specified points only. c 1 => . . . . (pattern length spacing) c 2 => ____ ____ ____ ____ (50%) c 3 => _____ _____ _____ _____ c 4 => _____ . _____ . _____ . _____ . c 5 => _____ _ _____ _ _____ _ _____ _ c 6 => ___ _ _ ___ _ _ ___ _ _ ___ _ _ Subroutine SETLT(npat,patl) 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 write(hp,1000)npat,patl 1000 format('LT ',I1,f6.2,';') return 500 I=NPAT IF (NPAT.LE.0)I=1 write(tt,5010)EPp,I,Ebsl 5010 format('+',3a1,'W(P',I1,')',2a1) RETURN end c****** To set the line type back to solid (default value on initialization) c after using SETLT. Subroutine SETLTS 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 write(hp,1000) 1000 format('LT;') return 500 write(tt,5010)EPp,Ebsl 5010 format('+',3a1,'W(P1)',2a1) end c****** To select the alternate character set to be used for subsequent c labeling. Subroutine SETSA 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)return write(hp,1000) 1000 format('SA;') return end c****** To establish the slant for labeled characters: angl is the angle from c the vertical in degrees. Subroutine SETSL(angl) 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)return pi=3.1412 theta=pi*(angl/180.) write(hp,1000) sin(theta)/cos(theta) 1000 format('SL ',f7.3,';') return end c****** To set the symbol to be drawn at each plot point. See manual for c allowed range. Subroutine SETSM(ch) 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 byte ch,pc,tl DATA pc,tl/33,126/ if(hv)return if ((ch.lt.pc).or.(ch.gt.tl))write(hp,1010) if ((ch.ge.pc).and.(ch.le.tl))write(hp,1000) ch 1000 format('SM',A1,';') 1010 format('SM;') return end c****** To set the character width and height for labels. c w is relative % width of (P2x-P1x) c h is relative % height of (P2y-P1y) Subroutine SETSR(w,h) 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)return write(hp,1000) w,h 1000 format('SR ',2f6.2,';') return end c****** To select the standard character set to be used for subsequent c labelling. Subroutine SETSS 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)return write(hp,1000) 1000 format('SS;') return end c****** To specify the length of tick marks, in percentages of distances c between scaling points. Tp... up and right length, tn...down c and left. Subroutine SETTL(tp,tn) 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 /zzhpf/xmin,xmax,ymin,ymax,tlenp,tlenn,angle if(hv)return write(hp,1000)tp,tn 1000 format('TL ',2f6.2,';') return end c****** Set the pen velocity. Subroutine SETVS(s) 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)return write(hp,1000)s 1000 format('VS ',F6.2,';') return end