c subroutine text (xx,yy,hgt,itext,angle,nc) c c DATE OF FIRST VERSION: 21-Jun-83 c c PURPOSE: Generates text characters with included symbols c c USAGE: c c call text (XX,YY,HGT,ITEXT,ANGLE,NC) c c WHERE: c c XX,YY = Starting coordinate of text generation c (999. for a value uses previous position) c HGT = Character height in inches. c ITEXT = String containing text to be plotted. c ANGLE = Angle at which the text is to be plotted (ccw degrees). c NC = Number of characters to be plotted. c c Special cases: c c 1. Text surrounded by angle brackets ([ and ]) is subscripted. c c 2. Text surrounded by fancy brackets ({ and }) is superscripted. c c 3. Symbols may be inserted into text strings by surrounding c the symbol number with vertical bars (|). A symbol number c designated by an asterisk indicates that the current c symbol number should be used. Symbol numbers inside strings c are decoded and plotted in place using the current symbol c size and are bottom-justified. c c 4. Dollar signs are converted to blanks. c c PROGRAMMERS: E. Javel / M. Prucka / S. T. Neely c c************************************************************************ c byteitext(1),letter(2) logical*1pentxt,filled,symbl real chrwid,chrhgt,charsp,linesp,symrad,up,down external index integer tnode c c Common block for PLT parameters c real*8prmnam,txtnam,keywrd bytexlabel,ylabel,rlabel,xfmt,yfmt,rfmt,msg,filonm(14) bytefilinm(40) logical*1dataon,pltfnd,msgflg,finflg,modflg,conton,axflg,newpag, & ecflg,typerr,dbflg c common /params/xmin,xmax,xint,xcycle,xpct,xlen,xllc,ymin,ymax, & yint,ycycle,ypct,ylen,yllc,rmin,rmax,rint,rcycle,rpct,pltype, & typlin,pltlin,symnum,sizsym,solid,sizann,wtlnan,xanlab,yanlab, & ranlab,yhor,grid,sizlab,wtlnlb,ticmrk,shade,echo,wtlnax,openax, & sizmsg,wtlnms,xmsg,ymsg,angmsg,datmsg,sizfac,smooth,header,sort, & unused(1) common /flags/dataon,pltfnd,msgflg,finflg,modflg,conton,axflg, & newpag,ecflg,typerr,dbflg common /names/prmnam(50),txtnam(6),keywrd(25),filinm,filonm common /text/xlabel(52),ylabel(52),rlabel(52),xfmt(6),yfmt(6), & rfmt(6),msg(256) common /misc/ifrom,ito,inow,ipage,model,lunin,lunout c common /axes/rxmin,rxmax,rymin,rymax,rxlen,rylen,rxllc,ryllc, & pxmin,pxmax,pymin,pymax,pxlen,pylen,pxllc,pyllc common /size/tiklen,hitann,hitlab,hitsym,hitmsg,iaxlnw,igrlnw, & ianlnw,ilblnw,ipllnw,imslnw,avgaxl common /msks/ msk1,msk2,msk3,msk4,msk5 data fctr/.7/ data letter/0,0/ data chrwid/36./,chrhgt/64./ data charsp/55./,linesp/105./ data symrad/32./,up/48./,down/18./ data filinc/.1/,ifont/0/ c c-------------------------------------------------------------------------- c c Determine the starting position for the output if(.not.(xx .eq. 999.))goto 23000 x = xcurr goto 23001 c else 23000 continue xcurr = xx x = xx 23001 continue if(.not.(yy .eq. 999.))goto 23002 y = ycurr goto 23003 c else 23002 continue ycurr = yy y = yy 23003 continue c symbol angle symang = detang (angle,sncc,sncs) c text angle ia = detang (angle,ancc,ancs) if(.not.(dbflg))goto 23004 type *,' text -> alphrt',ia 23004 continue call alphrt(ia) c Determine the factors for positioning nodes, and adjust c the starting position of the character facc = hgt / chrhgt call newsiz (chrwid*facc, chrhgt*facc) c c Draw characters until we're done c xorig = x yorig = y c for i=1 23006 if(.not.(i.le.nc))goto 23008 c move to (x,y) call plot2(x,y,3) c Make sure character code is positive k = itext(i) .and. "177 pentxt=.true. c See if this is a special character if(.not.(k .eq. "134))goto 23009 c insert character after '\' if(.not.(i.lt.nc))goto 23011 i=i+1 k=itext(i).and."177 23011 continue goto 23010 c else 23009 continue if(.not.(k .eq. "44))goto 23013 c change '$' to ' ' k=' ' goto 23014 c else 23013 continue if(.not.(k.eq."12.or.k.eq."25))goto 23015 c new line x=xorig + linesp * facc * ancs y=yorig - linesp * facc * ancc xorig=x yorig=y goto 23007 c else 23015 continue if(.not.(k.eq."15))goto 23017 c carriage return x=xorig y=yorig goto 23007 c else 23017 continue if(.not.(k.eq."10))goto 23019 c Backspace x = x - charsp * facc * ancc y = y - charsp * facc * ancs goto 23007 c else 23019 continue if(.not.(k.eq."173))goto 23021 c start superscript '{' x = x - up * ancs * facc y = y + up * ancc * facc facc = facc*fctr call newsiz(chrwid*facc, chrhgt*facc) goto 23007 c else 23021 continue if(.not.(k.eq."135))goto 23023 c end subscript ']' facc = facc/fctr call newsiz(chrwid*facc, chrhgt*facc) x = x - down * ancs * facc y = y + down * ancc * facc goto 23007 c else 23023 continue if(.not.(k.eq."175))goto 23025 c end superscript '}' facc = facc/fctr call newsiz(chrwid*facc, chrhgt*facc) x = x + up * ancs * facc y = y - up * ancc * facc goto 23007 c else 23025 continue if(.not.(k.eq."133))goto 23027 c start subscript '[' x = x + down * ancs * facc y = y - down * ancc * facc facc = facc*fctr call newsiz(chrwid*facc, chrhgt*facc) goto 23007 c else 23027 continue if(.not.(k.eq."136))goto 23029 c shift fonts '^' if(.not.(ifont.eq.0))goto 23031 ifont=1 c so k="16 goto 23032 c else 23031 continue ifont=0 c si k="17 23032 continue goto 23030 c else 23029 continue if(.not.(k .eq. "174))goto 23033 c Symbol in text? c Look for the second delimiter j = index(itext(i+1),'|') kk=itext(i+1) if(.not.((j.eq.1).or.(j.eq.2 .and. & kk.eq."52)))goto 23035 c Current symbol k=symnum i=i+j pentxt=.false. goto 23036 c else 23035 continue if(.not.(j.gt.1 .and. j.le.4))goto 23 & 037 c decode symbol number icode=0 ii=1 c while 23039 if(.not.(kk.ge."60 .and. kk.le."71 & .and. icode.lt.999))goto 23040 icode=icode*10+(kk-"60) ii=ii+1 kk=itext(i+ii) goto 23039 c endwhile 23040 continue if(.not.(ii.eq.j))goto 23041 k=icode i=i+j pentxt=.false. 23041 continue 23037 continue 23036 continue 23033 continue 23030 continue 23028 continue 23026 continue 23024 continue 23022 continue 23020 continue 23018 continue 23016 continue 23014 continue 23010 continue if(.not.(dbflg))goto 23043 type *,' text: k=',k 23043 continue if(.not.(32.le.k .or. pentxt))goto 23045 c text character. letter(1)=k if(.not.(dbflg))goto 23047 type *,' text->alpha=',k 23047 continue call alpha(letter) c advance (x,y) for printing character if(.not.(32.le.k))goto 23049 xnext=x+ancc*facc*charsp ynext=y+ancs*facc*charsp goto 23050 c else 23049 continue xnext=x ynext=y 23050 continue goto 23046 c else 23045 continue c symbol in text facsym=hgt/chrhgt c We need to know the center of the symbol c and the start of the next character. xcentr = x + (sncc - sncs) * facsym * symrad ycentr = y + (sncc + sncs) * facsym * symrad xnext = x + sncc * facsym * symrad * 2.5 ynext = y + sncs * facsym * symrad * 2.5 crot=sncc srot=sncs w=hgt h=hgt if(.not.(dbflg))goto 23051 type *,' text->drasym=',k 23051 continue call drasym(k,xcentr,ycentr,w,h,crot,srot) 23046 continue c Done with the character x = xnext y = ynext 23007 i=i+1 goto 23006 c endfor 23008 continue c All done. Remember the final position. c move to (x,y) call plot2(x,y,3) xcurr = x ycurr = y return end