c esccod - decodes tek escape sequences for tekcvt subroutine esccod(b) byte gettkb,b,e integer debug integer getnum integer radius integer vx1,y1,vx2,vy2 common/vuport/vx1,vy1,vx2,vy2 integer px1,py1,px2,py2 real arcsmo,segmin common/arccom/arcsmo,segmin integer width,height,charsp,linesp,rotang,slnang integer tabsep,mrgsep,spacon,font,stdfnt,altfnt real xratio,yratio,xscale,yscale,tr(2,3) common/alfcom/width,height,charsp,linesp,rotang,slnang,tabsep, & mrgsep,spacon,font,stdfnt,altfnt,xratio,yratio,xscale,yscale,tr c plotting limits data px1,py1,px2,py2/0,0,4095,3019/ data debug/0/ c get next byte after 'A' e=gettkb(b) if(.not.(b.eq.'A'))goto 23000 e=gettkb(b) if(.not.(b.eq.'A'))goto 23002 c draw arc ax1=btof(b) ay1=btof(b) ax2=btof(b) ay2=btof(b) call tarc(ax1,ay1,ax2,ay2) goto 23003 c else 23002 continue if(.not.(b.eq.'C'))goto 23004 c draw circle radius=getnum(b) call tcirc(radius) goto 23005 c else 23004 continue if(.not.(b.eq.'H'))goto 23006 c move to home call pmove(px1,py2) e=getnum(b) goto 23007 c else 23006 continue e=gettkb(b) if(.not.(debug.eq.1))goto 23008 type 19,'esccod:? ESC-A-',b 23008 continue 23007 continue 23005 continue 23003 continue goto 23001 c else 23000 continue if(.not.(b.eq.'B'))goto 23010 e=gettkb(b) if(.not.(b.eq.'A'))goto 23012 c set arc smoothness arcsmo=btof(b) goto 23013 c else 23012 continue if(.not.(b.eq.'P'))goto 23014 c pen select e=gettkb(b) if(.not.(b.ge.'0' .and. b.le.'9'))goto 23016 call pmove(px1,py2) call ppen(b) e=gettkb(b) goto 23017 c else 23016 continue call ppen('0') 23017 continue goto 23015 c else 23014 continue if(.not.(b.eq.'G'))goto 23018 c alpha slant slnang=getnum(b) call alfctr(charsp,linesp,rotang,slnang,tr) goto 23019 c else 23018 continue if(.not.(b.eq.'Q'))goto 23020 c set alternate font altfnt=getnum(b) goto 23021 c else 23020 continue c ? e=gettkb(b) if(.not.(debug.eq.1))goto 23022 type 19,'esccod: ESC-B-',b 23022 continue 23021 continue 23019 continue 23015 continue 23013 continue goto 23011 c else 23010 continue if(.not.(b.eq.'E'))goto 23024 c plotter on e=gettkb(b) goto 23025 c else 23024 continue if(.not.(b.eq.'F'))goto 23026 c plotter off e=gettkb(b) goto 23027 c else 23026 continue if(.not.(b.eq.'I'))goto 23028 c set alpha dimension charsp=getnum(b) if(.not.(b.eq.','))goto 23030 linesp=getnum(b) 23030 continue call alfctr(charsp,linesp,rotang,slnang,tr) goto 23029 c else 23028 continue if(.not.(b.eq.'J'))goto 23032 c set alpha rotation rotang=getnum(b) call alfctr(charsp,linesp,rotang,slnang,tr) goto 23033 c else 23032 continue if(.not.(b.eq.'K'))goto 23034 c new page call ppage e=gettkb(b) goto 23035 c else 23034 continue if(.not.(b.eq.'N'))goto 23036 c device reset num=getnum(b) call devres(num) goto 23037 c else 23036 continue if(.not.(b.eq.'T'))goto 23038 c change standard font stdfnt=getnum(b) goto 23039 c else 23038 continue if(.not.(b.eq.'V'))goto 23040 c reset alpha parameters call alfrsp e = getnum(b) goto 23041 c else 23040 continue if(.not.(debug.eq.1))goto 23042 type 19,'esccod: ESC-',b e = getnum(b) 23042 continue 23041 continue 23039 continue 23037 continue 23035 continue 23033 continue 23029 continue 23027 continue 23025 continue 23011 continue 23001 continue return 19 format(x,a,a) end c getnum - get a number from the input stream integer function getnum(b) byte gettkb,b,e num=0 e=gettkb(b) c while 23044 if(.not.(b.ge.'0'.and.b.le.'9'))goto 23045 num=num*10+(b-'0') e=gettkb(b) goto 23044 c endwhile 23045 continue getnum=num return end c btof - get a floating-point number from the input stream real function btof(b) byte gettkb byte b,digits(10),e integer index integer d,i,j,frac,neg real x,f data digits/'0','1','2','3','4','5','6','7','8','9'/ frac=0 f=1. e=gettkb(b) c while 23046 if(.not.(b.eq.' '.or.b.eq.9))goto 23047 c skip over white space e=gettkb(b) goto 23046 c endwhile 23047 continue if(.not.(b.eq.'-'))goto 23048 c look for minus sign e=gettkb(b) neg=1 goto 23049 c else 23048 continue if(.not.(b.eq.'+'))goto 23050 c look for plus sign e=gettkb(b) neg=0 goto 23051 c else 23050 continue neg=0 23051 continue 23049 continue c for x=0. 23052 if(.not.(b.ne.0))goto 23054 if(.not.(b.eq.'.'))goto 23055 c decimal point if(.not.(frac.eq.0))goto 23057 frac=1 goto 23053 c else 23057 continue goto 23054 23058 continue 23055 continue c for d=0 23059 if(.not.(d.lt.10))goto 23061 if(.not.(digits(d+1).eq.b))goto 23062 goto 23061 23062 continue d=d+1 goto 23059 c endfor 23061 continue if(.not.(d.lt.10))goto 23064 c digit if(.not.(frac.eq.0))goto 23066 x=10.*x+d goto 23067 c else 23066 continue f=f*.1 x=x+d*f 23067 continue goto 23065 c else 23064 continue goto 23054 23065 continue 23053 e=gettkb(b) goto 23052 c endfor 23054 continue if(.not.(neg.eq.1))goto 23068 btof=-x goto 23069 c else 23068 continue btof=x 23069 continue return end c devres - device reset subroutine devres(num) integer num integer width,height,charsp,linesp,rotang,slnang integer tabsep,mrgsep,spacon,font,stdfnt,altfnt real xratio,yratio,xscale,yscale,tr(2,3) common/alfcom/width,height,charsp,linesp,rotang,slnang,tabsep, & mrgsep,spacon,font,stdfnt,altfnt,xratio,yratio,xscale,yscale,tr integer vx1,y1,vx2,vy2 common/vuport/vx1,vy1,vx2,vy2 integer tx,ty,currx,curry,lastx,lasty common/tcom/tx,ty,currx,curry,lastx,lasty real arcsmo,segmin common/arccom/arcsmo,segmin integer px1,py1,px2,py2 c plotting limits data px1,py1,px2,py2/0,0,4095,3019/ c minimum arc segment data segmin/1./ c set alpha mode mode=1 c clear graphic bytes xhi=0 xlo=0 xeb=0 yhi=0 ylo=0 yeb=0 c place pen outside plotting range tx=px2+1 ty=py2+1 currx=tx curry=ty c move to load point call tmove(px2,py2) c set viewport vx1=px1 vy1=py1 vx2=px1 vy2=py2 c arc smoothness arcsmo=0.5 c reset alpha parameters call alfrsp return end c alfrsp - reset alpha parameters subroutine alfrsp integer width,height,charsp,linesp,rotang,slnang integer tabsep,mrgsep,spacon,font,stdfnt,altfnt real xratio,yratio,xscale,yscale,tr(2,3) common/alfcom/width,height,charsp,linesp,rotang,slnang,tabsep, & mrgsep,spacon,font,stdfnt,altfnt,xratio,yratio,xscale,yscale,tr charsp=56 linesp=88 rotang=0 slnang=0 stdfnt=0 altfnt=11 font =0 spacon=0 call alfctr(charsp,linesp,rotang,slnang,tr) return end c alfctr - comput coordinate transformation subroutine alfctr(awidth,ahgt,arot,asln,tr) integer awidth,ahgt,arot,asln real tr(2,3) c degrees to radians degrad=3.1415927/180. rot=arot*degrad c sine of arot sr=sin(rot) c cosine of arot cr=cos(rot) sln=max0(-89,min0(89,asln))*degrad ts=sin(sln)/cos(sln) wid=awidth/55. hgt=ahgt/105. tr(1,1)= cr*wid tr(1,2)=-sr*hgt+cr*hgt*ts tr(2,1)= sr*wid tr(2,2)= cr*hgt+sr*hgt*ts return end