subroutine symbol(x,y,ht,ihol,angle,n) C C REGIS version 1.0 C C subroutine to plot labels C C x,y(real)=co-ordinates in inches. C ht(real)=height of the characters.The sign of ht is used with ANGLE. C ihol(integer)=string of characters to be plotted C angle(real)=angle,in degrees,which to rotate the string C Used in combination with HT to center a string C (especially when labelling axes). C C sign of HT sign of ANGLE RESULT (eg.relative to a 0 degree axis) C C + + IHOL is above the line,starting at X,Y C - + IHOL is above the line,centered at X,Y C + - IHOL is above the line,ending at X,Y C - - IHOL is below the line,centered at X,Y C C n(integer)=number of characters in the string C if -1 then use special symbols C The REGIS characters are drawn CW with respect to the current C cursor position. For compatibility with HP-GL and DMP-IV protocols, C a relative plot command is issued prior to plotting the characters C so that they will be plotted with the characters CCW with respect to C the current cursor position. C ** Above and below refer to positions at X=0 degrees of rotation.** C common/init/ilun,factor,imode,ipenst common/char/slant byte idum(81),ichar(9),ihol(1) data ichar/1HT,1H(,1HA,1H3,1H),1H',1HS,1H',1H / C C ash=sign(1.,ht) !get the sign of HT asn=sign(1.,angle) !and the sign of ANGLE hite=abs(ht) !make sure HT is positive from now on angl=abs(angle)+360. !and ANGLE is > 0 theta=angl*.0174532925 !convert to radians isize=int(hite*7.5*factor+.5) !character size itilt=iabs(int(angle)) !character tilt if(itilt.ge.360)itilt=itilt-360 call plot(x,y,3) !move to x,y - pen up if(ash.gt.0.and.asn.gt.0)goto 1 8 div=.5 if(ash.gt.0.and.asn.lt.0)div=1. chwid=9.*float(isize) hafway=float(n)*chwid*div !find halfway point of the string orth=theta+3.141592654 !find the angle + 180 degrees xa=hafway*cos(orth) !new x point ya=hafway*sin(orth) !new y point isx=45 isy=45 if(xa.ge.0.)isx=43 if(ya.ge.0.)isy=43 xa=abs(xa) ya=abs(ya) write(ilun,5)isx,xa,isy,ya 5 format(' P[',A1,F,','A1,F,']') 1 ichar(9)=0 !terminate with null byte xrel=12.*float(isize)*sin(theta)*-1.!x starting position of character yrel=12.*float(isize)*cos(theta) !y starting position of character if((asn.lt.0.and.ash.lt.0.).or.imode.eq.1)xrel=0. if((asn.lt.0.and.ash.lt.0.).or.imode.eq.1)yrel=0. ixs=45 !minus sign iys=45 if(xrel.ge.0.)ixs=43 !plus sign if(yrel.ge.0.)iys=43 xrel=abs(xrel) !use absolute values,otherwise yrel=abs(yrel) !double signs result isl=int(slant) !character slant if(n.lt.0)goto 15 j=3 !fill dummy array starting at index 3 do 10 i=1,n idum(j)=ihol(i) !copy the string into the dummy array j=j+1 10 continue idum(1)="124 !T REGIS text introducer idum(2)="47 !' idum(n+3)="47 !' idum(n+4)=0 !null byte terminator 15 write(ilun,20)ixs,xrel,iys,yrel,isl,itilt,isize 20 format(' P['A1,F','A1,F']T(I'I3')T(D'I3',S'I3')V') if(n.lt.0)goto 30 call putstr(ilun,idum,'0',err) goto 520 C C Here begins the routines which generate the 15 CALCOMP symbols C C SYMBOL NUMBER SYMBOL DESCRIPTION C C 0 square C 1 circle C 2 triangle C 3 plus sign C 4 X sign C 5 diamond C 6 up arrow C 7 ??? triangle with legs C 8 Z C 9 Y C 10 printer's star C 11 asterisk C 12 hourglass C 13 | C 14 star of DAVID C 30 strlen=1.0 isym=ihol(1) xx=float(isize*-4) yy=float(isize*-5) write(ilun,90)xx,yy 90 format(' P['F','F']') goto(100,110,120,130,140,150,160,170,180,190,200,210, + 220,230,240),isym+1 100 write(ilun,105) 105 format(' L(A3)"S"00,00,FF,81,81,81,FF,00,00,00;') !square goto 500 110 write(ilun,115) 115 format(' L(A3)"S"00,00,7E,81,81,81,7E,00,00,00;') !circle goto 500 120 write(ilun,125) 125 format(' L(A3)"S"00,00,18,24,42,81,FF,00,00,00;') !triangle goto 500 130 write(ilun,135) 135 format(' L(A3)"S"00,18,18,FF,FF,18,18,00,00,00;') !plus goto 500 140 write(ilun,145) 145 format(' L(A3)"S"00,C3,66,3C,18,3C,66,C3,00,00;') !X goto 500 150 write(ilun,155) 155 format(' L(A3)"S"00,10,28,44,82,44,28,10,00,00;') !diamond goto 500 160 write(ilun,165) 165 format(' L(A3)"S"00,00,18,24,42,81,FF,10,10,00;') !arrow goto 500 170 write(ilun,175) 175 format(' L(A3)"S"00,00,FF,44,28,10,28,44,82,00;')!triangle with legs goto 500 180 write(ilun,185) 185 format(' L(A3)"S"00,FF,FE,0C,18,30,7F,FF,00,00;') !Z goto 500 190 write(ilun,195) 195 format(' L(A3)"S"00,C3,66,3C,18,18,18,18,00,00;') !Y goto 500 200 write(ilun,205) 205 format(' L(A3)"S"00,00,81,7E,42,7E,81,00,00,00;') !star goto 500 210 write(ilun,215) 215 format(' L(A3)"S"00,49,2A,1C,7F,1C,2A,49,00,00;') !asterisk goto 500 220 write(ilun,225) 225 format(' L(A3)"S"00,00,7E,44,28,10,28,44,7E,00;') !hourglass goto 500 230 write(ilun,235) 235 format(' L(A3)"S"00,18,18,18,18,18,18,18,00,00;') !vert.bar goto 500 240 write(ilun,245) 245 format(' L(A3)"S"00,00,10,FF,42,FF,10,00,00,00;')!star of David 500 call putstr(ilun,ichar,'0',err) 520 xr=x+strlen*cos(theta) yr=y+strlen*sin(theta) write(ilun,600) 600 format(' T(A0)') call plot(xr,yr,0) call penup return end