WINDOW 1,"",(0,20)-(32700,32720),3
// === Globals ====================================================================

DIM gQuit%,stronly%,match%,pposx4#,pposy4#,txta1$,txta2$,txtb1$,txtb2$,txtab$,f%,ngrids%,lgrid%(8),english%,pagx#(10,12),pagy#(10,12),pwin%,clpwin%,pagdx#(10),pagdy#(10),pagi%,pagi2%,npag%(20),txton%,txpt1#,typt1#
dim trackpv%,nfles%,start%,nll%(52),bll%(52),dir%,sdx%,sdy%,sdx2%,sdy2%,selcnt%,cnt%,cnt1%,cnt2%,cnt3%,nlnes%,plotout%,gridname$,gridNum%,hdlpics&(10)

DIM cpy%(32700),l#(32700,29),lt$(32700),llst$,llst1$,llst2$,llst3$,llst4$,lst$(32700),hdl&(32700),phdl&(52),sl%,npv%,col%,col1%,col2%,col3%,length1#,diff#,diff2#,sina#,lval#
dim anglea2#,gridn$(8),dia%,pbst%(10),tt%,cb%,gtablename$,tablenum%,bb1%,btble%,radcol%,lne1%,ipmc%(10),dist#(10),cmd%,greyed%

DIM sl%(32700),posx4#,posy4#,dista1#,dista2#,distb1#,distb2#,pposx%,pposy%,posv%,oposv%,posx#(200),posy#(200),posz#(200),movex#,movey#,pn$(52),pb(52),nfles%(50),tfiles%,tpicts%
dim sc$(20),scale#(20),s#(5,5),mse%,m%(2),trk%(4),selcode%,ca%,fract#,ptx#,pty#,dimfunction%,pvint#,xxx#,msedn%
DIM grid#(8,120,7),gridname$(8,120),anglea1#,angleb1#,angleb2#,posxy$,ba#,npts#,conlne#,slcnt%,zz%
dim saveangle#,repeat%,tangle#,changle#,changepos8#,pvdir%,z11#,savepv%,nearest#,diff1#,pt#,full%,clickh%,endonly%
dim oitem10,psx1%,psx2%,psy1%,psy2%,strt%,ntxt%,strt2%,mlst$(10),stxt%(10),ltxt%,dpth1#,defcolor%,dontdraw%,stdsect#(10),stnum#(10)


dim param1#,fractmax#,sleeving%,wdth0#,bbe2$,nstjoists%,mdlength#,gap#,dopt#(10),Opt45#,popt#(10),lowerel#,mmargin#,dcode%,flp#

dim xxx2#,lvl%,ndpts%,multidim%,lvl1%,dcode1%,n4$,ccode%,lvl7%,dcode7%,nlvls%,hi#,reversit#,transition#,tr$,h#,arctan#
dim mcode%,ouangle#,reversed%,snl%,be1#,be2#,risefall#,t#(10),njoists%,distarrow#,height#,nst#,switch%,onl%,n30$,n3$,v1#,ff1%
dim nn#,n2#,sectlength#,lvl#(10),lastline%,margin#,begg$,hx3#,hy3#,vert#,nstp#,rad1#,aa#(10),andposxy%

dim i0%,i1%,i2%,i3%,i4%,n1%,n2%,n3%,n4%,s0#,s1#,s2#,s3#,s4#,in%(5),nnn#,mini#,selectroot%,ndpxy#,distx#,disty#,distxy#,sggn%,frct#,in2%,subfract$,in%,den%,ddcode%,ft#
dim rr%,ff%,prevlne%,olne%,olne2%,olne3%,ll%,ll1%,ll2%,el%,t%,n%,w%,x%,y%,z%,i%,a$,a%,scopt%,lne%,lne2%,bl%,nl%,bl2%,nl2%,bl3%,nl3%,lheight#,lwth#,presetsc1#,presetsc2#,il%
dim one#,ssc#,fpx#,fpy#,pfpx#,pfpy#,ofpx#,ofpy#,psc#,osc#,sc#,dsc#,sc10#,ab%,opresetsc2#,pat%(4),patb%(4),c$,c%
dim itemnum%,menunum%,nchar#,char$,found%,num#,num1#,num2#,num3#,incr#,incr2#,key1$,key2$,asc1#,asc2#,closest%(10)
dim VolRefNum%,ofilename$,ogfilename$,gfilename$,screenx%,screeny%,gpi#,lgth,angle4#,uangle#,changepos#(10),changepos#
dim oitem1%,oitem2%,oitem6%,border&,keyinupdate%,alterations%,update%,pb%,tpb%,filename$(52),filenum%(52),Pictname$(52),Pictnum%(52),gpictname$
dim elev#,elev1#,elev2#,difelev#,dist1#,xx1%,xx2%,xx3%,bb%,hp1#,hp2#,ht1#,ht2#,gGridname$
dim sa2#,ea2#,choice2%,l1#,l2#,l3#,a2#,node%,endopt%,choice%,l#,w2#,nsct#,dir1%,dir2%,poly%,half#
dim wdth#,hx1#,hy1#,wdth2#,depth2#,wdth3#,dd#,whichstring%,estring$,Act%,editstring%,n2$,be$,defpen&(50,6),gpen%,sameangle%,sameelev%,samewxd%
DIM DlgEV%,DlgID%,Libnum2%,Libnum1%,ovolrefnum%,libp%,mm%
dim distx2#,disty2#,bkgrnd%,drawall%,ofpt%,rlst$,pagon%,tt2%,diff3#,ok%
dim blue%(10),green%(10),red%(10),tme&,tme2&,chsewind%(50),roundit%

'drawing dims
dim xpt#(400),ypt#(400),zpt#(400),d#(10),w#(10),length#(10),cpen%,mnum%,npt1%,npt2%,fpt1%,fpt2%,hx#(10),hy#(10),depth#,dt%(10)
dim link%,sndlne#,dash%,pass%,swapit%,difangle#,bn%,en%,dimtrack%,elength#,elength1#,elength2#,elength#(10),neg#
dim mf%,plottype%(10),n$,ns%,hx#,hy#,interval#,dist#,nend%,hx6#,hy6#,oitem8%,ductindex%,dpth2#,choice1%,sgna1%,sgna2%
dim signy#,signx#,stx#,corrx#,corry#,cde#,changeangle#,zero#,min#,minrnd#,rise#,rad2#

dim cs1#,sn1#,cs2#,sn2#,cs01#,sn01#,cs02#,sn02#,cs3#,sn3#,cs4#,sn4#,cx1#,cy1#,cx#,cy#,cx2#,cy2#,sa1#,sa#,ea1#,ea#,dx2#,dy2#,stp#
dim wth1#,wth2#,wth3#,wth4#,del#,xpt#,ypt#,xpt01#,ypt01#,xpt1#,ypt1#,xpt2#,ypt2#,xpt3#,ypt3#,xpt4#,ypt4#,xpt5#,ypt5#,xpt6#,ypt6#,xpt7#,ypt7#,xpt8#,ypt8#,xpt9#,ypt9#
dim fpt%,npt%,fpt%(10),npt%(10),tlength#,tlength2#,offset#,sgna%,angle#,angle0#,angle1#,angle3#,rmu#,x#,y#,ttan1#,ttan2#
dim ntv#,radius#,dct%,dct2%,soundlne%,off1#,angle2#,nbound%,bxpt#,bypt#,om$,mllst$(10),cc%,mm$,f#(10,10)
dim wth#,dpth#,length#,length0#,length2#,wth0#,dpth0#,offset1#,offset2#,dpth#(10),wth#(9),code%,code2%,subcode,lh%(20),llh%
dim radd#,radd0#,radd1#,radd2#,radd3#,radd4#,radd5#,dpxy#,change#,onpt%,aa#,aaa#,pennpatt#,tt1%,john%,supret%
dim sina2#,cosa#,ttan#,atann#,lst#,t2%,nt%,b%,dv#,dx#,dy#,frame%,q%,dist2#,dpth4#,lstatus%,prf%(10,10),pf%,pictureselect%,screenselect%

dim obl%,rr2%,posxx#,posyy#,lengthmin#,lengthmax#,stdlength#,m$,lstolne%,ii,telev2#,belev2#,belev1#,belev3#,el1#,el2#,endpc#,yes%,ll3%,oldnl%,dct3#,x1#,y1#,elbow#,throat#,lne0%,lne3%,msex#,mseyÂ
,hz#(10),tangleon%
dim posmove#,d,tc#,nstd#,oddlength#,flength#,stdsection#,maxfm2#,maxfm#,stdl2,tl2#,odd2#,bm2#,fm2#,stdl1#,tl1#,odd1#,fm1#,posmove2#,negmove#,oddflag#,code4#,hstdl#,stdl#,telev1#,lne4%,hstd#,negmove2#,bm1#
dim paperlength#,paperwidth#,bottommargin#,leftmargin#,rightmargin#,topmargin#,papersc#,drawinglength#,drawingwidth#,pspx1#,pspy1#,pspx2#,pspy2#,win#(10,10),pltcde#,pltvle#,posdwg%,pFilename$,pRefNum%,plotscale#,plotfpx#,plotfpy#,savelne%
dim iw%,first#,second#,win%,crun#,cris#,cdots#,cheight#,cwidth#,expscreen#,answer%
dim oddflag1%,oddflag2%,nstdl1#,nstdl2#,employee%,itemname$,vRefNumVar%,makecaps
DIM pbBlock.128,Pathname$,Dirname$,OSErr%,keycnt%,ceilht#,rfitxt$(20),inmetric%,Phatch$(51),Pcolor%(51),pastlne%,skip%,bpt%,bpt1%,ept1%,bpt2%,ept2%

dim ltscale#,layername$,thick#,llayer%,lyntype#,txtangle#,ln%,hilow#,updn#(10),gwidth#,clipangle#,stp2%


'DIM gQuit%

end globals
num= (val(right$(date$,2))*10000)+(val(mid$(date$,1,2))*100)+val(mid$(date$,4,2))
if num>110831 then end
gpi#=3.14159265358979# / 180#
pltcde=2:pltvle=.2

locate 1,1:INPUT "Background black=1,white=0";bkgrnd
if bkgrnd>3 then ab=bkgrnd:bkgrnd=1:english=1:employee=2:goto skip:
LOCATE 1,2:INPUT "English=1 or Metric=0";english
LOCATE 1,3:INPUT "max scale=1 to 7";ab:IF ab=0 THEN ab=6
LOCATE 1,4:INPUT "employee number ";employee
skip:
IF bkgrnd=1 THEN long color 0,0,0,_false
gosub defaultcolors:
gosub DefaultPPat:
update=1
text _geneva,13,0,_srcCopy
ssc=84:screenx=SYSTEM(6)/2:screeny=SYSTEM(7)/2

PICTURE ON (0,0)-(32700,32700)
CALL MOVETO(0,0):CALL LINETO(32000,0):CALL LINETO(32000,32000):CALL LINETO(0,32000):CALL LINETO(0,0):PICTURE OFF,border&

restart:
if english=0 then gosub DefaultMetric: else gosub DefaultEnglish:
GOSUB Rtn1002:
gosub DefaultPPat:
DO
cmd%=event%

if mouse(_vert)<20 then handleevents
if mouse(_down)=-1 then msedn=1

gosub strtput:

UNTIL gQuit%
end
lOCAL FN HandleMenu

menunum = MENU(_menuID)
itemnum = MENU(_itemID)

on menunum gosub Rtn1:,Rtn2:,Rtn3:,Rtn4:,Rtn5:,Rtn6:,Rtn7:,Rtn8:,Rtn9:,Rtn10:

MENU


END FN

strtput:
uangle=0
c$=INKEY$:IF c$="" THEN RETURN
c=ASC(c$)
locate 5,5:print c
keycnt=keycnt+1
if msedn=1 then goto Clickstrt:
if cmd%=384 then goto CmdStrtput:
strtput2:
IF c=3 THEN goto updateupdate:
IF c=8 THEN IF l(lne,0)>0 THEN l(lne,0)=0:GOSUB updateupdate: ELSE l(lne,0)=lne-1:goto updateupdate:
IF c=9 THEN IF l(lne,2)=0 THEN posx(posv)=l(lne,20)+COS(gpi#*l(lne,3))*l(lne,6):posy(posv)=l(lne,21)-SIN(gpi#*l(lne,3))*l(lne,6):GOTO displaypv:
IF c=9 THEN IF l(lne,2)<>0 THEN posx(posv)=l(lne,20):posy(posv)=l(lne,21):posz(posv)=l(lne,22)+SGN(l(lne,2))*l(lne,6):goto printline:
'IF c=16 THEN GOSUB Perimeter:
IF c=19 THEN goto Runselect:
IF c=24 THEN locate 1,5:IF pictureselect=0 THEN pictureselect=1:BEEP:BEEP:PRINT "pictures off": ELSE pictureselect=0:BEEP:PRINT "pictures on"
IF c=26 THEN locate 1,5:IF screenselect=0 THEN screenselect=1:BEEP:BEEP:PRINT "screenselect on": ELSE screenselect=0:BEEP:PRINT "screenselect off"
IF c=27 THEN goto clearCurLne:
iF c=28 THEN posx(posv)=posx(posv)+COS(gpi#*(uangle+angle4+180))*changepos:posy(posv)=posy(posv)-SIN(gpi#*(uangle+angle4+180))*changepos:GOTO displaypv:
IF c=29 THEN posx(posv)=posx(posv)+COS(gpi#*(uangle+angle4))*changepos:posy(posv)=posy(posv)-SIN(gpi#*(uangle+angle4))*changepos:GOTO displaypv:
IF c=30 THEN posx(posv)=posx(posv)+COS(gpi#*(uangle+angle4+90))*changepos:posy(posv)=posy(posv)-SIN(gpi#*(uangle+angle4+90))*changepos:GOTO displaypv:
IF c=31 THEN posx(posv)=posx(posv)+COS(gpi#*(uangle+angle4+270))*changepos:posy(posv)=posy(posv)-SIN(gpi#*(uangle+angle4+270))*changepos:GOTO displaypv:
IF c=32 THEN whichstring=1:GOSUB inputstring::goto updateupdate:
IF c=33 THEN goto inselcode:
IF c=34 THEN GOSUB Getcode::IF (code=2 OR code=4) THEN GOSUB findradd::l(lne,11)=radd2+l(lne,16):GOSUB updateupdate: ELSE l(lne,8)=l(lne,17)+l(lne,16):GOSUB updateupdate::RETURN
IF c=35 THEN goto markpv:
'IF c=36 THEN GOSUB tstcode110:
IF c=37 THEN pf=1:prf(pf,0)=0:i=0:GOSUB inputprf::RETURN
IF c=38 THEN IF andposxy=1 THEN andposxy=0:BEEP:BEEP ELSE andposxy=1:BEEP
IF c=39 THEN goto selectroot:
IF c=42 THEN goto updatesection:
IF c=47 THEN goto updatesection:
IF c=43 THEN l(lne,6)=l(lne,6)+changepos:goto updateupdate:
IF c=44 THEN l(lne,17)=l(lne,17)+l(lne,16):l(lne,16)=0
IF c=45 THEN l(lne,6)=l(lne,6)-changepos:goto updateupdate:
IF c=46 THEN whichstring=2:GOSUB inputstring::goto updateupdate:
IF c>=48 AND c<=57 THEN goto keyin:
IF c=58 THEN GOSUB roundodd::goto updateupdate:
IF c=59 THEN locate 1,5:IF update=0 THEN update=1:BEEP:BEEP:PRINT "update on":GOSUB updateupdate::GOSUB printline: ELSE update=0:BEEP:GOSUB printline::PRINT "update off"
IF c=60 OR c=62 THEN goto forwardback:
IF c=61 THEN goto colinput:
IF c=63 THEN IF trackpv=0 THEN trackpv=1:BEEP:BEEP ELSE trackpv=0:beep
IF c=65 THEN lstatus=3:GOTO getint:
IF c=70 THEN lstatus=5:GOTO getint:
IF c=71 THEN goto listfiles:
IF c=76 THEN goto LibMerge:
'IF c=80 THEN goto Plotparameters2:
IF c=82 THEN goto Rtn404:
IF c=83 THEN lstatus=4:GOTO getint:
IF c=84 or c=66 THEN GOSUB inkey::xxx=nnn:GOSUB newelevation::goto updateupdate:

IF c=86 THEN goto lloffset:
IF c=87 THEN goto Inbeam:
IF c=90 OR c=88 THEN GOSUB Rtn504::GOTO displaypv:
IF c=91 THEN locate 1,5:posv=posv-1:BEEP:PRINT posv:IF posv<0 THEN posv=npv:RETURN ELSE RETURN
IF c=92 THEN lstatus=2:GOTO getint:
IF c=93 THEN locate 1,5:posv=posv+1:BEEP:PRINT posv:IF posv>99 THEN posv=0
'IF c=94 THEN goto Ce:
IF c=94 THEN pf=0:prf(pf,0)=0:i=0:goto inputprf:
IF c=95 THEN pf=3:prf(pf,0)=0:i=0:goto inputprf:
IF c=97 OR c=115 THEN GOSUB lneplusone::goto printline:
IF c=98 THEN mse=1:GOSUB Rtn307::RETURN
IF c=99 THEN goto grouplnes:
IF c=100 THEN GOSUB playpicture::GOSUB onlne::GOSUB toreturn::GOTO displaypv:
IF c=101 THEN posx(posv)=l(lne,20):posy(posv)=l(lne,21):posz(posv)=l(lne,22):GOSUB printline::GOTO displaypv:
IF c=102 THEN lstatus=2:GOTO getint:
IF c=103 THEN mse=1:GOSUB Rtn309::RETURN
IF c=104 THEN goto Pvdist:
IF c=106 THEN goto joiner:
IF c=107 THEN switch=1:xxx=changepos:GOSUB subfractions::lst$(lne)=subfract$:goto updateupdate:
IF c=108 THEN lne=nl:GOSUB onlne::GOTO toreturn:
IF c=109 THEN locate 1,5:INPUT "goto:";lne:GOSUB onlne::goto toreturn:
IF c=110 THEN mse=1:GOSUB Rtn308::RETURN
IF c=111 THEN SWAP l(lne,4),l(lne,5):goto updateupdate:
IF c=113 AND presetsc2>1 THEN opresetsc2=presetsc2:presetsc2=presetsc2-1:itemnum=presetsc2:goto Rtn61a:
IF c=114 THEN fpx=(l(lne,20)/sc)-screenx:fpy=(l(lne,21)/sc)-screeny:GOSUB fpxytest::CLS:GOSUB playpicture::GOSUB onlne::goto toreturn:
IF c=116 THEN goto pvmove:
IF c=117 THEN olne=lne:osc=sc:sc=psc:cursor 1:FOR lne=bl TO nl:gosub record::NEXT lne:sc=osc:lne=olne:cursor 2:RETURN
IF c=118 THEN goto nearestcol:
IF c=119 THEN nl=nl+1:l(nl,20)=posx(posv):l(nl,21)=posy(posv):l(nl,22)=posz(posv):GOTO optionw:
IF c=120 THEN goto killlne:
IF c=121 THEN l(lne,20)=posx(posv):l(lne,21)=posy(posv):l(lne,22)=posz(posv):GOSUB updateupdate::GOSUB onlne::GOTO toreturn:
IF c=122 AND presetsc2<scale(0) THEN opresetsc2=presetsc2:presetsc2=presetsc2+1:itemnum=presetsc2:goto Rtn61a:
IF c=123 THEN locate 1,5:npv=npv-1:BEEP:PRINT npv:IF npv>199 THEN npv=0
IF c=124 THEN dx2=posx(posv)-l(lne,20):dy2=posy(posv)-l(lne,21):GOSUB findangles10::l(lne,3)=angle:goto updateupdate:
IF c=125 THEN locate 1,5:npv=npv+1:BEEP:PRINT npv:IF npv>199 THEN npv=0
IF c=130 THEN IF makecaps=1 THEN makecaps=0:BEEP:BEEP ELSE makecaps=1:BEEP


IF c=140 THEN lstatus=1:GOTO getint:
if c=168 then IF roundit=1 THEN roundit=0:BEEP:BEEP ELSE roundit=1:BEEP
IF c=181 THEN GOTO selectmove:
IF c=182 THEN posx(posv)=(mouse(_horz)+fpx)*sc:posy(posv)=(mouse(_vert)+fpy)*sc:GOTO displaypv:
IF c=183 THEN nl=nl+1:lne=nl:FOR t=0 TO 22:l(nl,t)=0:NEXT t:lst$(nl)="":GOSUB toreturn::IF sl%(0)>0 THEN sl%(nl)=sl%(0)
'IF c=184 THEN GOSUB Plotparameters1:
IF c=185 THEN locate 1,5:INPUT "pict 0-29";pb:start=bl:rr=nl:goto PutPicture:
IF c=200 THEN itemnum=2:goto Rtn103a:
IF c=207 THEN goto optionq:
if c=235 then GOSUB getdim::GOSUB playpicture::GOSUB onlne::GOSUB toreturn::goto displaypv:
IF c=229 THEN locate 1,1:IF inmetric=0 THEN inmetric=1:BEEP:BEEP:PRINT "inmetric on": ELSE inmetric=0:BEEP:PRINT "inmetric off"

IF c=239 THEN locate 1,5:INPUT "john";john
IF c=241 THEN goto LibMerge:
'IF c=250 THEN LOCATE 1,1:IF limit110=0 THEN limit110=1:BEEP:BEEP:PRINT "limit110 on": ELSE limit110=0:BEEP:PRINT "limit110 off"
return
Clickstrt:
msedn=0
while mouse(_down)<>0:wend
IF c=39 THEN FOR n=bl TO nl:sl%(n)=0:NEXT n:sl%(0)=0:selectroot=0:BEEP:RETURN
IF c=59 THEN selectroot=sl%(0):BEEP:RETURN
IF c=97 OR c=9 THEN goto changeangle:
IF c=98 THEN dimfunction=1:goto Changedim:

IF c=100 THEN GOSUB getdim::GOSUB playpicture::GOSUB onlne::GOSUB toreturn::goto displaypv:
IF c=101 THEN IF selcode=0 THEN selcode=1:BEEP ELSE selcode=0:BEEP:BEEP
IF c=102 THEN GOSUB Rtn504::posx(posv)=posx4:posy(posv)=posy4:RETURN
IF c=103 OR c=106 THEN GOTO findposv:
IF c=104 THEN GOSUB getdim::clickh=1:GOSUB playpicture::GOSUB onlne::GOSUB toreturn::goto displaypv:
IF c=107 THEN goto limitposv:

IF c=108 THEN IF bl=1 THEN bl=lne:BEEP ELSE bl=1:BEEP:BEEP
IF c=110 THEN dimfunction=2:goto Changedim:
IF c=109 THEN dimfunction=3:goto Changedim:
IF c=114 THEN GOTO Rtn404:
'IF c=119 AND andposxy=1 THEN nl=nl+1:GOSUB positioninxy:GOSUB optionw:RETURN
IF c=119 THEN nl=nl+1:call getmouse (m%(0)):l(nl,20)=(m%(1)+fpx)*sc:l(nl,21)=(m%(0)+fpy)*sc:goto optionw:
IF c=115 THEN lstatus=1:gosub getint::if l(lne,1)=110 then l(lne,17)=l(lne,0):l(lne,0)=0:return else return
IF c=117 AND sl%(0)>0 THEN GOTO selectupdate:
'IF c=117 AND sl%(0)=0 THEN ChangeCursor 4:olne=lne:osc=sc:sc=psc:FOR lne=olne TO nl:PICTURE ON:GOSUB draw:PICTURE OFF:image$(lne)=PICTURE$:NEXT lne:sc=osc:lne=olne:ChangeCursor 2:RETURN
IF c=113 THEN presetsc2=1:itemnum=presetsc2:GOSUB Rtn61a:
IF c=122 THEN presetsc2=opresetsc2:itemnum=presetsc2:goto Rtn61a:
if c>27 and c<32 then goto clickarrows:
IF c=116 THEN goto Varelev:
IF c=65 THEN goto shiftpv:
IF c=83 THEN goto shiftpv:
IF c=111 THEN goto distinlinetype:
IF c=121 THEN lne=nl:GOSUB onlne::GOTO toreturn:
IF c=99 THEN GOTO Tagit:
IF c=118 THEN goto finduangle:
return
clickarrows:
if l(lne,1)<99 and l(lne,7)=4 then return
IF c=29 THEN l(lne,14)=(l(lne,4)/2)-(l(l(lne,0),4)/2):goto updateupdate:
IF c=28 THEN l(lne,14)=((l(l(lne,0),4)/2)-(l(lne,4)/2)):goto updateupdate:
IF c=31 THEN l(lne,15)=(l(lne,5)/2)-(l(l(lne,0),5)/2):goto updateupdate:
IF c=30 THEN l(lne,15)=((l(l(lne,0),5)/2)-(l(lne,5)/2)):goto updateupdate:
return
CmdStrtput:

if c=97 then goto Rtn401:
if c=115 then goto Rtn402:
if c=102 then goto Rtn403:
if c=105 then goto Rtn409:
if c=101 then goto Rtn301:
if c=119 then goto Rtn302:
if c=114 then goto Rtn304:
if c=108 then goto Rtn305:
if c=117 then goto Rtn306:
if c=98 then goto Rtn307:
if c=110 then goto Rtn308:
if c=109 then goto Rtn309:
if c=120 then goto Rtn313:
if c=39 then goto Rtn314:
if c=99 then goto Rtn315:
if c=118 then goto Rtn316:
if c=100 then goto Rtn319:
if c=48 then goto RtnD0:
if c=49 then goto RtnD1:
if c=50 then goto RtnD2:
if c=51 then goto RtnD3:
if c=52 then goto RtnD4:
if c=53 then goto RtnD5:
if c=54 then goto RtnD6:
if c=55 then itemnum=9:goto RtnD7:
if c=56 then itemnum=10:goto RtnD8:
if c=57 then goto RtnD9:
if c=122 then goto Rtn501:
if c=106 then goto Rtn503:
if c=107 then goto Rtn504:
if c=112 then goto Rtn506:
if c=103 then goto Rtn508:
return
Rtn1:
on itemnum goto Rtn101:,Rtn102:,Rtn103:,Rtn104:,Rtn105:,Rtn106:,Rtn107:,Rtn108:,Rtn109:,Rtn110:,Rtn111:,Rtn112:,Rtn113:,Rtn114:,Rtn115:,Rtn116:,Rtn117:,Rtn118:,Rtn119:,Rtn120:,Rtn121:
Rtn101:
beep
beep
locate 5,1
input "Warning### The action that will destroy your files is 0 OR >0 to abort";answer
if answer>0 then return
for t=1 to nl
for i=0 to 22:l(t,i)=0:next i:lst$(t)="":lt$(t)=""
if hdl&(t)<>0 then kill picture hdl&(t):hdl&(t)=0
next t
gFilename$ =""
VolRefNum%=0
nl=1
lne=1:bl=1:el=1
cls
return
Rtn102:
if nfles(0)>0 then goto Rtn103:

if gFilename$<>"" then goto Rtn103a:
return
Rtn103:
if nfles(0)>0 then locate 1,5:input "Save B-Files to single file=0";a:if a>0 then return
ogFilename$=gFilename$:oVolRefNum%=VolRefNum%
gFilename$ = FILES$ (_fOpen, "TEXT", , VolRefNum%)
if gFilename$="" then gFilename$ = FILES$ (_fsave, "TEXT", , VolRefNum%)
if gFilename$="" then gFilename$=ogFilename$:VolRefNum%=oVolRefNum%:return

Rtn103a:
OPEN "O",1, gFileName$,,VolRefNum%
FOR rr=1 TO nl
FOR n=0 TO 22
nchar#=l(rr,n):print #1,nchar#
NEXT n
char$=lst$(rr):print #1,char$:char$=lt$(rr):print #1,char$

NEXT rr
CLOSE #1

beep
beep
if itemnum=3 or itemnum=2 then gosub timecount:
RETURN
Rtn104:
nfles(0)=0
ogFilename$=gFilename$:oVolRefNum%=VolRefNum%
gFilename$ = FILES$ (_fOpen, "TEXT", , VolRefNum%)
if gFilename$="" then gFilename$=ogFilename$:VolRefNum%=oVolRefNum%:return
OPEN "I",1, gFileName$,,VolRefNum%
rr=0
WHILE NOT EOF(1)
rr=rr+1
FOR ff=0 TO 22:INPUT #1,nchar#:l(rr,ff)=nchar#
NEXT ff
INPUT #1,char$:lst$(rr)=char$:INPUT #1,char$:lt$(rr)=char$

WEND
nl=rr:bl=1:el=nl:lne=1
CLOSE #1

if itemnum=4 then gosub updatedwg::gosub timecount:
beep
beep
beep
PRINT "end retrieving"
return
updatedwg:
osc=sc
sc=psc
cursor 1
FOR lne=1 TO nl
sl%(lne)=0
gosub record:
NEXT lne
sc=osc:lne=olne:cursor 2
sl%(0)=0
lne=1
GOSUB playpicture::GOSUB onlne::GOSUB toreturn::GOTO displaypv:

return
Rtn105:
rr=nl
ogFilename$=gFilename$:oVolRefNum%=VolRefNum%
gFilename$ = FILES$ (_fOpen, "TEXT", , VolRefNum%)
if gFilename$="" then gFilename$=ogFilename$:VolRefNum%=oVolRefNum%:return
gosub Rtn105a:
if itemnum=5 then gosub updatedwg:

PRINT "end retrieving"
return
Rtn105a:
OPEN "I",1, gFileName$,,VolRefNum%

WHILE NOT EOF(1)
rr=rr+1

FOR ff=0 TO 22:INPUT #1,nchar#:l(rr,ff)=nchar#
NEXT ff
INPUT #1,char$:lst$(rr)=char$:INPUT #1,char$:lt$(rr)=char$
if l(rr,0)>0 then l(rr,0)=l(rr,0)+nl else l(rr,0)=0

WEND
nl=rr:bl=1:el=nl:lne=1
CLOSE #1
'if itemnum=5 then gFilename$=ogFilename$:VolRefNum%=oVolRefNum%
BEEP
BEEP
BEEP
return
Rtn106:
ogFilename$=gFilename$:oVolRefNum%=VolRefNum%
gFilename$ = FILES$ (_fOpen, "TEXT", , VolRefNum%)
if gFilename$="" then gFilename$ = FILES$ (_fsave, "TEXT", , VolRefNum%)
if gFilename$="" then gFilename$=ogFilename$:VolRefNum%=oVolRefNum%:return
gosub Rtn106a:
if itemnum=6 then gosub timecount:
return
Rtn106a:
OPEN "O",1, gFileName$,,VolRefNum%
FOR rr=bl TO nl
IF l(rr,0)>0 THEN nchar#=l(rr,0)-(bl-1) ELSE nchar#=0
print #1,nchar#
FOR n=1 TO 22:nchar#=l(rr,n):print #1,nchar#:NEXT n:char$=lst$(rr):print #1,char$:char$=lt$(rr):print #1,char$
NEXT rr
CLOSE #1
beep
beep
return

Rtn107:
ogFilename$=gFilename$:oVolRefNum%=VolRefNum%
gFilename$ = FILES$ (_fOpen, "TEXT", , VolRefNum%)
if gFilename$="" then gFilename$ = FILES$ (_fsave, "TEXT", , VolRefNum%)
if gFilename$="" then gFilename$=ogFilename$:VolRefNum%=oVolRefNum%:return
OPEN "O",1, gFileName$,,VolRefNum%
FOR rr=1 TO nl
IF sl%(rr)=sl%(0) then gosub Rtn107a:
NEXT rr
CLOSE #1
if itemnum=7 then gosub timecount:
beep
beep

return
Rtn107a:
IF l(rr,0)>0 and sl%(l(rr,0))=sl%(0) THEN nchar#=l(rr,0)-(bl-1) ELSE nchar#=0
print #1,nchar#
FOR n=1 TO 22:nchar#=l(rr,n):print #1,nchar#:NEXT n:char$=lst$(rr):print #1,char$:char$=lt$(rr):print #1,char$
return
Rtn108:
gosub gpictlist::if tpicts=0 then return
olne=lne
start=nl
IF nfles>0 THEN start=nll(nfles)
pb=0
FOR tpb=1 TO tpicts
gosub NextAvail1:

OPEN "I",1, PictName$(tpb),,Pictnum(tpb)
rr=start
WHILE NOT EOF(1)

rr=rr+1
FOR ff=0 TO 22:INPUT #1,nchar#:l(rr,ff)=nchar#
if greyed=1 then l(rr,19)=30
NEXT ff
INPUT #1,char$:lst$(rr)=char$:INPUT #1,char$:lt$(rr)=char$

if l(rr,0)>0 then l(rr,0)=l(rr,0)+start else l(rr,0)=0

WEND
CLOSE #1
IF rr>start and pb<31 then pn$(pb)=PictName$(tpb):pb(pb)=2:gosub PutPicture:
print pb(pb)
NEXT tpb
beep
beep
beep

sc=osc:cursor 2
lne=olne
RETURN
NextAvail1:
pb=pb+1:if pb>30 then return
if pb(pb)>0 then goto NextAvail1:
return
PutPicture:
osc=sc:sc=psc
if phdl&(pb)<>0 then kill picture phdl&(pb):phdl&(pb)=0
PICTURE ON (0,0)-(32700,32700)
FOR lne=start+1 TO rr
GOSUB draw:
NEXT lne:PICTURE OFF,phdl&(pb)
sc=osc:cursor 2

return



Rtn109:
if bkgrnd=1 then bkgrnd=0 else bkgrnd=1
IF bkgrnd=1 THEN long color 0,0,0,_false else long color 65535,65535,65535,_false
gosub defaultcolors:
return
LOCATE 2,1:INPUT "max scale=1 to 7";ab:IF ab=0 THEN ab=6
if english=1 then english=0 else english=1
goto restart:

return
Rtn110:

ogFilename$=gFilename$:oVolRefNum%=VolRefNum%
gFilename$ = FILES$ (_fOpen, "TEXT", , VolRefNum%)
if gFilename$="" then gFilename$ = FILES$ (_fsave, "TEXT", , VolRefNum%)
if gFilename$="" then gFilename$=ogFilename$:VolRefNum%=oVolRefNum%:return
OPEN "A",1, gFileName$,,VolRefNum%
FOR rr=1 TO nl
IF (sl%(rr)=sl%(0) AND l(rr,0)=0) then FOR n=0 TO 22:nchar#=l(rr,n):print #1,nchar#:NEXT n:char$=lst$(rr):print #1,char$:char$=lt$(rr):print #1,char$

NEXT rr
CLOSE #1
beep
beep
gFilename$=ogFilename$:VolRefNum%=oVolRefNum%

return

Rtn111:
ogFilename$=gFilename$:oVolRefNum%=VolRefNum%
gFilename$ = FILES$ (_fOpen, "TEXT", , VolRefNum%)
if gFilename$="" then gFilename$ = FILES$ (_fsave, "TEXT", , VolRefNum%)
if gFilename$="" then gFilename$=ogFilename$:VolRefNum%=oVolRefNum%:return
OPEN "O",1, gFileName$,,VolRefNum%
for t=1 to 19:rfitxt$(t)="":next t
input "completion date";rfitxt$(13)
FOR rr=1 TO nl
IF (sl%(rr)=sl%(0) AND l(rr,1)=119) then gosub Rtn111parse::gosub RTN111date::gosub Rtn111Address::gosub printpage:

NEXT rr
CLOSE #1
beep
beep
gFilename$=ogFilename$:VolRefNum%=oVolRefNum%
return
Rtn111parse:
llst1$=""
i=len(lst$(rr))
for t=1 to i
if mid$(lst$(rr),t,1)="\" then llst1$=llst1$+"" else llst1$=llst1$+mid$(lst$(rr),t,1)
next t
rfitxt$(19)=llst1$
llst1$=""
i=len(lt$(rr))
for t=1 to i
if mid$(lt$(rr),t,1)="\" then llst1$=llst1$+"" else llst1$=llst1$+mid$(lt$(rr),t,1)
next t
rfitxt$(18)=llst1$

if l(rr,12)=1 then rfitxt$(12)="Structural"
if l(rr,12)=2 then rfitxt$(12)="Architectural"

if l(rr,12)=3 then rfitxt$(12)="Mechanical"

rfitxt$(0)=str$(l(rr,10))

RTN111date:
if l(rr,11)=0 then llst3$="RfiDate":return
llst3$=str$(l(rr,11))
i=len(llst3$)
if i<5 then llst3$="RfiDate":return
if i=5 then llst3$="0"+llst3$
llst2$=mid$(llst3$,2,2)+"/"+mid$(llst3$,4,2)+"/"+mid$(llst3$,6,2)
llst3$=llst2$
if mid$(llst3$,1,1)="0" then llst3$=right$(llst3$,7)
rfitxt$(11)=llst3$
return
Rtn111Address:
for ll=1 to nl
if INSTR(1,lt$(ll),"CName")>0 then rfitxt$(2)=lst$(ll)
if INSTR(1,lt$(ll),"CStreet")>0 then rfitxt$(3)=lst$(ll)
if INSTR(1,lt$(ll),"CCity")>0 then rfitxt$(4)=lst$(ll)
if INSTR(1,lt$(ll),"CState")>0 then rfitxt$(5)=lst$(ll)
if INSTR(1,lt$(ll),"CZip")>0 then rfitxt$(6)=lst$(ll)
if INSTR(1,lt$(ll),"CPhone")>0 then rfitxt$(7)=lst$(ll)
if INSTR(1,lt$(ll),"CFax")>0 then rfitxt$(8)=lst$(ll)
if INSTR(1,lt$(ll),"CDrafting")>0 then rfitxt$(9)=lst$(ll)
if INSTR(1,lt$(ll),"Project Name")>0 then rfitxt$(10)=lst$(ll)

next ll
return
printpage:
print #1,"                 REQUEST FOR INFORMATION"
print #1,""
print #1,""
print #1,""
print #1,"RFI No_________________________"
print #1,"Control #:"rfitxt$(0)
print #1,""
if rfitxt$(2)<>"" then print #1,"Contractor Name:            ";rfitxt$(2)
if rfitxt$(3)<>"" then print #1,"Contractor's                   ";rfitxt$(3)
if rfitxt$(4)<>"" then print #1,"Address                          ";rfitxt$(4);", ";rfitxt$(5);" ";rfitxt$(6)
if rfitxt$(7)<>"" then print #1,"Contractors Phone#        ";rfitxt$(7)
if rfitxt$(8)<>"" then print #1,"Contractors Fax#            ";rfitxt$(8)
if rfitxt$(9)<>"" then print #1,"Contractors Drafting Dept#  ";rfitxt$(9)
print #1,""

if rfitxt$(10)<>"" then print #1," Project Name#               ";rfitxt$(10)
print #1,""

if rfitxt$(12)<>"" then print #1," RFI Type#:                  ";rfitxt$(12)
print #1,""
if rfitxt$(18)<>"" then print #1," Location#          "
print #1,""
if rfitxt$(18)<>"" then print #1, rfitxt$(18)
print #1,""
print #1,"Description of the problem."
print #1,""
print #1, rfitxt$(19)
print #1,""

if rfitxt$(13)<>"" then print #1,"Please note:  This drawing is scheduled for submission on ";rfitxt$(13);" with or without a reply.  Please reply by this date so that any changes can be included on this drawing."
print #1,""

print #1,"Reply:
print #1,"_____________________________________________________"
print #1,"_____________________________________________________"
print #1,"_____________________________________________________"
print #1,"_____________________________________________________"
print #1,"_____________________________________________________"
print #1,"_____________________________________________________"
print #1,""
print #1,chr$(12)
return


return

Rtn112:
gFilename$ = FILES$ (_fOpen, "TEXT", , VolRefNum%)
IF gfilename$="" THEN RETURN
nfles(0)=nfles(0)+1
nl=nl+1:l(nl,1)=9999:l(nl,20)=0:l(nl,21)=0:lst$(nl)=gFilename$:l(nl,22)=VolRefNum%:nfles(nfles(0))=nl
rr2=nfles(nfles(0)):rr=rr2:nl=rr2
l(rr,7)=rr+1
lst$(rr)=gfilename$:l(rr,22)=VolRefNum%
GOSUB Rtn105a:
l(rr2,8)=nl
GOSUB listfiles:
return
Rtn113:
GOSUB gfilelist:
nl=0
olne=lne
FOR pb=1 TO tfiles
nl=nl+1:l(nl,1)=9999:l(nl,20)=0:l(nl,21)=0:lst$(nl)=filename$(pb):l(nl,22)=filenum(pb):nfles(pb)=nl
rr=nl
gfilename$=filename$(pb)
VolRefNum%=filenum(pb)

GOSUB Rtn105a:
NEXT pb
nfles(0)=pb
if itemnum=13 then gosub timecount:
gosub updatedwg:
GOSUB listfiles:
lne=olne

return

Rtn114:
obl=bl:onl=nl
GOSUB listfiles:

nl2=nl
FOR ll=1 TO nl2
IF l(ll,1)=9999 THEN bl=l(ll,7):nl=l(ll,8):VolRefNum%=l(ll,22):gfilename$=lst$(ll):GOSUB Rtn106a:
NEXT ll
if itemnum=14 then gosub timecount:
bl=obl:nl=onl
return

Rtn115:
GOSUB listfiles:
obl=bl
onl=nl
bl=l(nfles(nfles(0)),7)
nl=l(nfles(nfles(0)),8)
VolRefNum%=l(nfles(nfles(0)),22):gfilename$=lst$(nfles(nfles(0))):GOSUB Rtn106a:
if itemnum=15 then gosub timecount:
nl=onl
bl=obl


RETURN

Rtn116:
gFilename$ = FILES$ (_fOpen, "TEXT", , VolRefNum%)
IF gfilename$="" THEN RETURN

rr2=nfles(nfles(0)):rr=rr2:nl=rr2
l(rr,7)=rr+1
lst$(rr)=gfilename$:l(rr,22)=VolRefNum%
GOSUB Rtn105a:
l(rr2,8)=nl
GOSUB listfiles:
return
Rtn117:
ogFilename$=gFilename$:oVolRefNum%=VolRefNum%
gFilename$ = FILES$ (_fOpen, "TEXT", , VolRefNum%)
if gFilename$="" then gFilename$ = FILES$ (_fsave, "TEXT", , VolRefNum%)
if gFilename$="" then gFilename$=ogFilename$:VolRefNum%=oVolRefNum%:return
GOSUB listfiles:
obl=bl
onl=nl
bl=l(nfles(nfles(0)),7)
nl=l(nfles(nfles(0)),8)
l(nfles(nfles(0)),22)=VolRefNum%:lst$(nfles(nfles(0)))=gfilename$:GOSUB Rtn106a:
if itemnum=16 then gosub timecount:
nl=onl
bl=obl

return
Rtn118:


nl=0
GOSUB gfilelist:
olne=lne
FOR pb=1 TO tfiles
gfilename$=filename$(pb)
VolRefNum%=filenum(pb)
rr=nl
GOSUB Rtn105a:
NEXT pb
nfles(0)=0

lne=olne

return
Rtn119:

nl3=nl
posx(posv)=l(lne,20):posy(posv)=l(lne,21)
GOSUB Rtn302:
ogFilename$=gFilename$:oVolRefNum%=VolRefNum%
gFilename$ = FILES$ (_fOpen, "TEXT", , VolRefNum%)
if gFilename$="" then gFilename$ = FILES$ (_fsave, "TEXT", , VolRefNum%)
if gFilename$="" then gFilename$=ogFilename$:VolRefNum%=oVolRefNum%:return
bl=nl3+1
GOSUB Rtn106a:
gFilename$=ogFilename$:VolRefNum%=oVolRefNum%
nl=nl3:bl=1
return
Rtn120:
ogFilename$=gFilename$:oVolRefNum%=VolRefNum%
gFilename$ = FILES$ (_fOpen, "TEXT", , VolRefNum%)
gFilename$ =ogFilename$
if  gFilename$="" then VolRefNum%=oVolRefNum%:return
if nfles(0)=0 then return
for ll=1 to nl
if l(ll,1)=9999 then l(ll,22)=VolRefNum%
next ll

return
Rtn121:
if gFilename$<>"" then gosub timecount:
end
return
gfilelist:

for i=1 to 50
filename$(i) = FILES$ (_fOpen, "TEXT", , filenum(i))
if filenum(i)=0 then tfiles=i-1:return
 
next i
RETURN
gpictlist:
tpicts=0
for i=1 to 50
Pictname$(i) = FILES$ (_fOpen, "TEXT", , Pictnum(i))
if Pictnum(i)=0 then tpicts=i-1:print tpicts:return
next i

RETURN


timecount:

if gfilename$="Timecount" then return
Pathname$ = gfilename$'put file name in pathname

pbBlock.ioNamePtr&      = @Dirname$'put pointer to dirName$
pbBlock.ioVRefNum%      = VolRefNum%'set vRefNun
pbBlock.ioDrParID&      = [_curDirStore]'get current directory ID
pbBlock.ioFDirIndex%    = -1'get info on folder
'
DO
OSErr% = FN GETCATINFO (@pbBlock)'get catalog info
LONG IF OSErr% = _noErr'no error then...
Pathname$ =  Dirname$ + ":" + Pathname$'add dirName to path
pbBlock.ioDrDirID& = pbBlock.ioDrParID&'get folder's parent ID
END IF

UNTIL pbBlock.ioDirID& = _fsRtParID'volume root ID
pbBlock.ioDirID& =[_curDirStore]
timecount2:

OPEN "A",3,"Timecount",,-1
print #3,0
print #3,9998
print #3,itemnum
print #3,VolRefNum%
print #3,val(mid$(date$,1,2))
print #3,val(mid$(date$,4,2))
print #3,2000+val(mid$(date$,7,2))
print #3,employee
print #3,0
print #3,keycnt
print #3,timer
print #3,0
print #3,0
print #3,0
print #3,0
print #3,0
print #3,0
print #3,0
print #3,0
print #3,0
print #3,0
print #3,0
print #3,0

print #3,Pathname$
print #3,gfilename$
CLOSE #3
keycnt=0
return



Rtn2:
MENU 2,oitem2,1
mini=2^(itemnum-1)
oitem2=itemnum
MENU 2,oitem2,2
RETURN
Rtn3:
on itemnum goto Rtn301:,Rtn302:,Rtn303:,Rtn304:,Rtn305:,Rtn306:,Rtn307:,Rtn308:,Rtn309:,Rtn310:,Rtn311:,Rtn312:,Rtn313:,Rtn314:,Rtn315:,Rtn316:,Rtn317:,Rtn318:,Rtn319:

Rtn301:
obl=bl
olne=lne
for lne=1 to nl+1
if hdl&(lne)>0 then kill picture hdl&(lne):hdl&(lne)=0
next lne
lne=olne
gosub Getcode:
FOR ll=lne+1 TO nl
if l(ll,0)>0 and l(ll,0)>=lne then l(ll,0)=l(ll,0)+1
NEXT ll

nl=nl+1
FOR ll=nl TO lne+1 STEP -1
FOR t=0 TO 22:l(ll,t)=l(ll-1,t):NEXT t:lst$(ll)=lst$(ll-1):lt$(ll)=lt$(ll-1):sl%(ll)=sl%(ll-1)
NEXT ll
l(lne,12)=0
IF l(lne,1)=107 or l(lne,1)=100 or l(lne,1)>199 THEN goto Rtn301b:
if l(lne,0)=0 and l(lne,1)>99 then goto Rtn301a:
if l(lne,0)>0 and l(lne,0)=lne-1 then l(lne+1,0)=l(lne+1,0)+1
if l(lne,0)=0 then locate 1,5:beep:input "insert=0, duplicate=1";answer:if answer=1 then goto Rtn301a:
l(lne,0)=lne-1
if l(l(lne,0),1)>19 THEN l(lne,1)=20
l(lne,3)=l(l(lne,0),3):l(lne,2)=l(l(lne,0),2):l(lne,1)=0:l(lne,4)=l(l(lne,0),4):l(lne,5)=l(l(lne,0),5):l(lne,13)=0:l(lne,14)=0:l(lne,15)=0:l(lne,6)=0
Rtn301a:
osc=sc:sc=psc:cursor 1:FOR lne=1 TO nl:gosub record::NEXT lne:sc=osc:lne=olne:cursor 2

GOSUB playpicture::GOSUB onlne::GOSUB toreturn::GOTO displaypv:
return
Rtn301b:
l(lne+1,0)=lne:l(lne,20)=posx(posv):l(lne,21)=posy(posv)
if l(lne,1)>199 then l(lne,1)=200
goto Rtn301a:
return
l(lne,0)=lne-1:
Rtn302:

IF sl%(0)=0 THEN GOTO Rtn302a:
olne=lne
bl2=nl+1
nl2=nl
FOR lne=bl TO nl2
IF sl%(lne)<>sl%(0) THEN GOTO rrout1:
GOSUB nlplusone:
sl%(nl)=lne
FOR t=0 TO 22:l(nl,t)=l(lne,t):NEXT t:lst$(nl)=lst$(lne):lt$(nl)=lt$(lne)
IF nl=bl2 THEN l(nl,0)=0
IF sl%(lne)<>sl%(l(lne,0)) THEN l(nl,0)=0
IF l(lne,0)>0 THEN diff=lne-l(lne,0):IF diff>1 THEN GOSUB pickuplink: ELSE l(nl,0)=nl-(lne-l(lne,0))
l(nl,20)=posx(posv)+(l(lne,20)-l(olne,20))
l(nl,21)=posy(posv)+(l(lne,21)-l(olne,21))
osc=sc:sc=psc
olne2=lne
lne=nl
gosub record:
sc=osc:Cursor 2
lne=olne2
rrout1:NEXT lne
FOR t=nl2+1 TO nl:sl%(t)=sl%(0)-1:NEXT t
lne=olne

RETURN
pickuplink:

FOR t=nl-1 TO nl2+1 STEP -1 
IF l(nl,0)=sl%(t) THEN l(nl,0)=t:RETURN
NEXT t
RETURN
Rtn302a:
nl2=nl
FOR ll=lne TO nl
IF l(ll,0)<>ll-1 AND ll>lne THEN lne=nl+1:nl=nl2:goto updateupdate:
nl2=nl2+1
FOR t=0 TO 22:l(nl2,t)=l(ll,t):NEXT t:lst$(nl2)=lst$(ll):lt$(nl2)=lt$(ll)
IF ll=lne THEN l(nl2,0)=0
IF l(nl2,0)>0 THEN l(nl2,0)=nl2-(ll-l(ll,0))
l(nl2,20)=posx(posv)+(l(ll,20)-l(lne,20))
l(nl2,21)=posy(posv)+(l(ll,21)-l(lne,21))
NEXT ll
lne=nl+1:nl=nl2:GOSUB updateupdate:
RETURN

Rtn303:
Cursor 2
WHILE MOUSE(_down)<>0
WEND
WHILE MOUSE(_down)=0
WEND
locate 1,5
dist2=ABS(l(lne,6))+ABS(l(l(lne,0),6))
call getmouse(m%(0))
ptx=(m%(1)+fpx)*sc:pty=(m%(0)+fpy)*sc
dx=ptx-l(l(lne,0),20):dy=pty-l(l(lne,0),21)
dist=SQR(ABS((dx^2)+(dy^2)))
IF dist<dist2 THEN l(lne,6)=dist2-dist:l(l(lne,0),6)=dist
lne2=lne
lne=l(lne,0)
GOSUB updateupdate:
lne=lne2
RETURN

Rtn304:
locate 1,5:
posx(posv)=l(lne,20):posy(posv)=l(lne,21)
INPUT "Degrees to Rotate";angle2
olne=lne
FOR lne=bl TO nl
IF sl%(lne)<>sl%(0) THEN GOTO rrout2:
IF l(lne,20)=0 AND l(lne,21)=0 THEN GOTO nextrotpart:
dx2=l(lne,20)-posx(posv):dy2=l(lne,21)-posy(posv)
dpxy=SQR(ABS((dx2^2)+(dy2^2)))
IF dpxy=0 THEN GOTO nextrotpart:
sina=-dy2/dpxy:cosa=dx2/dpxy
IF cosa=0 THEN cosa=.0000001
ttan=sina/cosa
atann=ATN(ttan)*114.591559#
angle1=atann/2
IF cosa<=0 THEN angle1=angle1+180
IF cosa>=0 AND sina<0 THEN angle1=angle1+360
l(lne,20)=posx(posv)+COS(gpi#*(angle1+angle2))*dpxy
l(lne,21)=posy(posv)-SIN(gpi#*(angle1+angle2))*dpxy
nextrotpart:
IF l(lne,1)<>107 THEN l(lne,3)=l(lne,3)+angle2:IF l(lne,3)>360 THEN l(lne,3)=l(lne,3)-360
rrout2:NEXT lne
lne=olne
return
Rtn305:
locate 1,5:
INPUT "beginning line";bl
INPUT "last line";nl
if bl=0 then bl=1
if nl=0 then nl=1
lne=nl

return
Rtn306:
locate 1,5
col2=-10
INPUT "Change Col";col1
IF col1=-1 THEN INPUT "findstring";llst3$:INPUT "replace string";llst1$
IF col1=-2 THEN INPUT "findstring";llst3$:INPUT "replace string";llst1$
IF col1=-3 THEN INPUT "Change Col";col1:INPUT "Find value in Col";col2
IF col1=-4 THEN INPUT "Change Col";col1:col2=-1:INPUT "startwith";num1:INPUT "increment";incr
IF col1>=0 THEN INPUT "Change value";s1
INPUT "Routine 0{=} 1{+} 2{-} 3{*} 4{/}";n
INPUT "start=0";start:IF start<>0 THEN RETURN
FOR ll=bl TO nl
IF col2>0 THEN s1=l(ll,col2)
IF col2=-1 THEN llst1$=STR$(num1):num1=num1+incr:PRINT llst1$
IF sl%(0)=sl%(ll) THEN GOSUB changevalues:
NEXT ll

RETURN
Tagit:
olne3=lne
lstatus=6:GOSUB getint::GOSUB Tagit2:
GOSUB updateupdate:
RETURN

Tagit2:
ll=closest(0)
xpt=l(ll,20)
ypt=l(ll,21)
IF l(ll,1)<>128 THEN xpt=l(ll,20)+COS(gpi*l(ll,3))*l(ll,6):ypt=l(ll,21)-SIN(gpi*l(ll,3))*l(ll,6)
l(olne3,13)=xpt-l(olne3,20)
l(olne3,14)=ypt-l(olne3,21)
lne=olne3
RETURN

changevalues:
IF col1=-1 THEN GOTO changevalues2:
IF col1=-2 THEN GOTO changevalues3:
IF n=0 THEN l(ll,col1)=s1
IF n=1 THEN l(ll,col1)=l(ll,col1)+s1
IF n=2 THEN l(ll,col1)=l(ll,col1)-s1
IF n=3 THEN l(ll,col1)=l(ll,col1)*s1
IF n=4 THEN l(ll,col1)=l(ll,col1)/s1
RETURN
changevalues2:
IF n=0 THEN lst$(ll)=llst1$
IF n=1 THEN lst$(ll)=lst$(ll)+llst1$
IF n=2 THEN lst$(ll)=llst1$+lst$(ll)
IF n=4 OR n=3 THEN GOSUB cut1:
RETURN
changevalues3:
IF n=0 THEN lt$(ll)=llst1$
IF n=1 THEN lt$(ll)=lt$(ll)+llst1$
IF n=2 THEN lt$(ll)=llst1$+lt$(ll)
IF n=4 OR n=3 THEN GOSUB cut2:
RETURN

cut1:
n1=LEN(lst$(ll))
cnt=INSTR(1,lst$(ll),llst3$):IF cnt>0 THEN cnt=cnt-1 ELSE RETURN
llst4$=LEFT$(lst$(ll),cnt)
cnt2=n1-cnt-LEN(llst3$)
llst2$=RIGHT$(lst$(ll),cnt2)
IF n=3 THEN lst$(ll)=llst4$+llst1$+llst2$
IF n=4 THEN lst$(ll)=llst4$+llst1$+llst3$+llst2$
RETURN
cut2:
n1=LEN(lt$(ll))
cnt=INSTR(1,lt$(ll),llst3$):IF cnt>0 THEN cnt=cnt-1 ELSE RETURN
llst4$=LEFT$(lt$(ll),cnt)
cnt2=n1-cnt-LEN(llst3$)
llst2$=RIGHT$(lt$(ll),cnt2)
IF n=3 THEN lt$(ll)=llst4$+llst1$+llst2$
IF n=4 THEN lt$(ll)=llst4$+llst1$+llst3$+llst2$
RETURN

return
Rtn307:
if l(lne,1)<99 and l(lne,7)=4 then return

IF l(lne,0)>0 THEN GOTO nxtlne37: ELSE RETURN
nxtlne37:
cursor 2
IF mse=1 THEN call getmouse(m(0)):ptx=(m%(1)+fpx)*sc:pty=(m%(0)+fpy)*sc ELSE ptx=posx(posv):pty=posy(posv)
dx2=ptx-l(l(lne,0),20):dy2=pty-l(l(lne,0),21)
GOSUB findangles10:
IF INT(l(lne,1)/100)=2 AND l(lne,0)>0 THEN angle=ABS(angle-l(lne,3)) ELSE angle=ABS(angle-l(l(lne,0),3))
l(lne,13)=(COS(gpi#*angle)*dpxy)+(l(lne,4)/2)
GOSUB updateupdate:
mse=0
return
Rtn308:
if l(lne,1)<99 and l(lne,7)=4 then return

IF l(lne,1)=107 THEN RETURN
IF l(lne,2)<>0 AND l(lne,1)<100 THEN RETURN
cursor 2
IF mse=1 THEN call getmouse(m(0)):ptx=(m%(1)+fpx)*sc:pty=(m%(0)+fpy)*sc ELSE ptx=posx(posv):pty=posy(posv)
dx2=ptx-l(lne,20):dy2=pty-l(lne,21)
IF INT(l(lne,1)/100)=2 AND l(lne,0)>0 THEN dx2=ptx-l(l(lne,0),20):dy2=pty-l(l(lne,0),21)
GOSUB findangles10:
angle=ABS(angle-l(lne,3))
l(lne,6)=(COS(gpi#*angle)*dpxy)
GOSUB updateupdate:
if roundit=1 then gosub roundodd:

mse=0

return
Rtn309:
if l(lne,1)<99 and l(lne,7)=4 and l(lne,0)>0 then return
cursor 2
olne2=lne
IF mse=1 THEN call getmouse(m(0)):ptx=(m%(1)+fpx)*sc:pty=(m%(0)+fpy)*sc ELSE ptx=posx(posv):pty=posy(posv)
IF l(lne,0)=0 OR l(lne,1)>99 THEN l(lne,20)=ptx:l(lne,21)=pty:gosub updateposition::GOSUB updateupdate::mse=0:RETURN
IF l(lne,3)=l(l(lne,0),3) THEN dx2=ptx-l(lne,20):dy2=pty-l(lne,21) ELSE dx2=ptx-l(l(lne,0),20):dy2=pty-l(l(lne,0),21)
IF dx2=0 AND dy2=0 THEN RETURN
link=l(lne,0)
gosub Getcode:
dx2=ptx-l(lne,20):dy2=pty-l(lne,21)
GOSUB findangles10:
angle=(angle-l(lne,3))
distx=COS(gpi#*angle)*dpxy
disty=SIN(gpi#*angle)*dpxy
dx2=ptx-l(link,20):dy2=pty-l(link,21)
GOSUB findangles10:

angle=(angle-l(link,3))
distx2=COS(gpi#*angle)*dpxy
disty2=SIN(gpi#*angle)*dpxy

difangle=0:IF (l(lne,3)<>l(link,3)) THEN difangle=l(lne,3)-l(link,3):IF ABS(difangle)>180 THEN difangle=difangle+(SGN(difangle*-1)*360)

IF difangle=0 and l(lne,2)=0 THEN l(l(lne,0),6)=l(l(lne,0),6)+distx:l(lne,6)=l(lne,6)-distx:GOSUB Rtn39z::olne2=lne:lne=l(lne,0):GOSUB updateupdate::mse=0:lne=olne2:RETURN
IF difangle<>0 and  l(lne,2)=0 THEN gosub Rtn309a:
if l(link,2)=0 and  l(lne,2)<>0 THEN gosub Rtn309b:
GOSUB updateupdate::mse=0
lne=olne2
return
Rtn309a:



IF endonly=0 THEN l(lne,13)=distx2
if endonly=1 THEN l(link,6)=l(link,6)-sgn(difangle)*disty
return
Rtn309b:



IF endonly=0 THEN l(lne,13)=distx2:l(lne,14)=disty2
'if (code>1 AND code<6) THEN l(link,6)=l(link,6)+distx
return
Rtn39z:



FOR ll=lne+1 TO nl
IF l(ll,0)=0 THEN RETURN
IF l(ll,0)=lne AND l(ll,3)<>l(lne,3) THEN l(ll,13)=l(ll,13)-distx
NEXT ll
RETURN
updateposition:
for i=0 to npv
if abs(posx(i)-ptx)<one and abs(posy(i)-pty)<one then print abs(posx(i)-ptx);abs(posy(i)-pty):l(lne,20)=posx(i):l(lne,21)=posy(i):return

next i

return

Rtn310:
pposx=l(lne,20):pposy=l(lne,21)
olne=lne
FOR lne=bl TO nl
IF sl%(lne)<>sl%(0) THEN GOTO rrout3:
l(lne,20)=posx(posv)-(l(lne,20)-posx(posv))
cosa=COS(gpi#*l(lne,3)):sina=SIN(gpi#*l(lne,3))
cosa=cosa*-1
IF cosa=0 THEN cosa=.000000001#
ttan=sina/cosa
atann=ATN(ttan)*114.591559#
angle=atann/2
IF cosa<=0 THEN angle=angle+180
IF cosa>=0 AND sina<0 THEN angle=angle+360
IF l(lne,1)=102 OR l(lne,1)=105 THEN l(lne,5)=l(lne,5)*-1
IF l(lne,1)=110 THEN GOSUB testcode110: ELSE l(lne,3)=angle:l(lne,14)=l(lne,14)*-1
rrout3:NEXT lne
lne=olne
return
testcode110:
IF angle>89.999 AND angle<90.001 THEN angle=90
IF angle>269.999 AND angle<270.001 THEN angle=270
IF angle=90 THEN l(lne,20)=l(lne,20)+l(lne,4):RETURN
IF angle=270 THEN l(lne,20)=l(lne,20)-l(lne,4):RETURN
IF l(lne,6)=0 THEN ns=LEN(lst$(lne)):dist2=l(lne,7)+l(lne,13):l(lne,13)=0 ELSE dist2=l(lne,6)
l(lne,20)=l(lne,20)+COS(gpi#*angle)*dist2:l(lne,21)=l(lne,21)-SIN(gpi#*angle)*dist2
l(lne,3)=angle+180:IF l(lne,3)>360 THEN l(lne,3)=l(lne,3)-360
RETURN
Rtn311:
olne=lne
FOR lne=bl TO nl
IF sl%(lne)<>sl%(0) THEN GOTO rrout4:

l(lne,21)=posy(posv)-(l(lne,21)-posy(posv))
cosa=COS(gpi#*l(lne,3)):sina=SIN(gpi#*l(lne,3))
sina=sina*-1
IF cosa=0 THEN cosa=.000000001#
ttan=sina/cosa
atann=ATN(ttan)*114.591559#
angle=atann/2
IF cosa<=0 THEN angle=angle+180
IF cosa>=0 AND sina<0 THEN angle=angle+360
l(lne,14)=l(lne,14)*-1
IF l(lne,1)=102 OR l(lne,1)=105 THEN l(lne,5)=l(lne,5)*-1
IF l(lne,1)=110 THEN GOSUB testcode110: ELSE l(lne,3)=angle
rrout4:NEXT lne
lne=olne
return
Rtn312:
olne=lne
FOR lne=bl TO nl
IF sl%(lne)=sl%(0) AND sl%(0)>0 THEN FOR t=0 TO 22:l(lne,t)=0:NEXT t:lst$(lne)="":lt$(lne)="":if hdl&(lne)>0 then kill picture hdl&(lne):hdl&(lne)=0
NEXT lne
lne=olne

return
Rtn313:
BEEP
olne=lne
for lne=1 to nl+1
if hdl&(lne)>0 then kill picture hdl&(lne):hdl&(lne)=0
next lne
lne=olne

FOR ll=lne+1 TO nl
IF l(ll,0)>lne-1 THEN l(ll,0)=l(ll,0)-1
IF l(ll,1)=110 THEN IF l(ll,17)>lne-1 THEN l(ll,17)=l(ll,17)-1
FOR t=0 TO 22:l(ll-1,t)=l(ll,t):NEXT t:lst$(ll-1)=lst$(ll):lt$(ll-1)=lt$(ll)
NEXT ll
nl=nl-1

osc=sc:sc=psc:cursor 1:FOR lne=1 TO nl:gosub record::NEXT lne:sc=osc:lne=olne:cursor 2

GOSUB playpicture::GOSUB onlne::GOSUB toreturn::GOTO displaypv:
return

Rtn314:
sl%(0)=1
FOR ll=bl TO nl
sl%(ll)=1
NEXT ll
return
Rtn315:
IF sl%(0)=0 THEN RETURN
cpy(0)=0
FOR ll=bl TO nl
IF sl%(ll)=sl%(0) THEN cpy(0)=cpy(0)+1:cpy(cpy(0))=ll
NEXT ll

return
Rtn316:
for n=1 to cpy(0)
nl=nl+1

FOR t=0 TO 22:l(nl,t)=l(cpy(n),t):NEXT t:lst$(nl)=lst$(cpy(n)):lt$(nl)=lt$(cpy(n))
IF l(lne,0)>0 THEN l(nl,0)=nl-(cpy(n)-l(cpy(n),0))
l(nl,20)=posx(posv)+(l(cpy(n),20)-l(olne,20))
l(nl,21)=posy(posv)+(l(cpy(n),21)-l(olne,21))
sl%(nl)=sl%(0)
osc=sc:sc=psc
olne2=lne
lne=nl
gosub record:
sc=osc:cursor 2

RETURN
next n
return
Rtn317:

olne=lne
for lne=1 to nl
if l(lne,1)<99 then gosub getcode:
if endonly=1 and l(l(lne,0),20)=0 and l(l(lne,0),21)=0 and l(lne,20)>0 and l(lne,21)>0 then sl%(lne)=1
next lne
sl%(0)=1
lne=olne
return
Rtn318:
locate 1,5
INPUT "wth0";w(0)
INPUT "dpth0";d(0)

INPUT "wth1";w(1)
INPUT "dpth1";d(1)
INPUT "wth2";w(2)
INPUT "dpth2";d(2)
INPUT "wth3";w(3)
INPUT "dpth3";d(3)
d(4)=w(0)*d(0)
d(5)=w(1)*d(1)
d(6)=w(2)*d(2)
d(7)=w(3)*d(3)
d(8)=d(5)+d(6)+d(7)
w(4)=((d(5)/d(8))*d(4))/d(0)
w(5)=((d(6)/d(8))*d(4))/d(0)
w(6)=((d(7)/d(8))*d(4))/d(0)
PRINT w(4);dpth0
PRINT w(5);dpth0
PRINT w(6);dpth0
return
Rtn319:
INPUT "Col";col
cnt=0
FOR ll=1 TO nl
IF col>=0 AND col<23 THEN IF l(ll,col)=l(lne,col) THEN cnt=cnt+1:sl%(ll)=sl%(ll)+1
IF col=-1 THEN IF lst$(lne)=lst$(ll) THEN cnt=cnt+1:sl%(ll)=sl%(ll)+1
IF col=-2 THEN IF lt$(lne)=lt$(ll) THEN cnt=cnt+1:sl%(ll)=sl%(ll)+1
NEXT ll
IF cnt>0 THEN sl%(0)=sl%(0)+1
return
Rtn4:

on itemnum goto Rtn401:,Rtn402:,Rtn403:,Rtn404:,Rtn405:,Rtn406:,Rtn407:,Rtn408:,Rtn409:,Rtn410:,Rtn411:,Rtn412:,Rtn413:,Rtn414:,Rtn415:,Rtn416:,Rtn417:,Rtn418:,Rtn419:
Rtn401:
locate 1,5:
n2=1
INPUT " find column";col:IF col<0 THEN INPUT "find substring";llst$ ELSE INPUT "Search for ";s1:INPUT "0= 1> 2< 3³ 4²";n1
INPUT "start=0";start:IF start<>0 THEN RETURN
IF sl%(0)=0 THEN RETURN
FOR ll=bl TO nl
IF sl%(ll)<sl%(0) THEN GOSUB searchroutine1:
NEXT ll
BEEP
RETURN
Rtn402:
locate 1,5:
n2=2
INPUT " find column";col:IF col<0 THEN INPUT "find substring";llst$ ELSE INPUT "Search for ";s1:INPUT "0= 1> 2< 3³ 4²";n1
INPUT "start=0";start:IF start<>0 THEN RETURN
IF sl%(0)=0 THEN RETURN
FOR ll=bl TO nl
IF sl%(ll)=sl%(0) THEN GOSUB searchroutine1:
NEXT ll
BEEP
RETURN
Rtn403:
locate 1,5:
n2=3
INPUT " find column";col:IF col<0 THEN INPUT "find substring";llst$ ELSE INPUT "Search for ";s1:INPUT "0= 1> 2< 3³ 4²";n1
INPUT "start=0";start:IF start<>0 THEN RETURN
FOR ll=bl TO nl
IF sl%(ll)=sl%(0) THEN GOSUB searchroutine1:
NEXT ll
sl%(0)=sl%(0)+1
BEEP
RETURN
searchroutine1:
IF col=-1 THEN IF llst$="empty" AND lst$(ll)="" THEN goto whattodo:
IF col=-1 THEN IF llst$="full" AND lst$(ll)<>"" THEN goto whattodo:
IF col=-2 THEN IF llst$="empty" AND lt$(ll)="" THEN goto whattodo:
IF col=-2 THEN IF llst$="full" AND lt$(ll)<>"" THEN goto whattodo:

IF (col=-1 AND INSTR(1,lst$(ll),llst$)=0) THEN RETURN
IF (col=-1 AND INSTR(1,lst$(ll),llst$)>0) THEN goto whattodo:
IF (col=-2 AND INSTR(1,lt$(ll),llst$)=0) THEN RETURN
IF (col=-2 AND INSTR(1,lt$(ll),llst$)>0) THEN goto whattodo:

IF n1=0 AND l(ll,col)=s1 THEN goto whattodo:
IF n1=1 AND l(ll,col)>s1 THEN goto whattodo:
IF n1=2 AND l(ll,col)<s1 THEN goto whattodo:
IF n1=3 AND l(ll,col)>=s1 THEN goto whattodo:
RETURN
whattodo:
IF n2=1 THEN sl%(ll)=sl%(0)
IF n2=2 THEN sl%(ll)=sl%(0)-1
IF n2=3 THEN sl%(ll)=sl%(0)+1
RETURN

Rtn404:
fpx=(posx(posv)/sc)-screenx
fpy=(posy(posv)/sc)-screeny
GOSUB fpxytest:
GOSUB playpicture:
GOTO displaypv:
return
Rtn405:
FOR ll=1 TO nl
IF sl%(ll)=sl%(0) THEN gosub Rtn405a:
NEXT ll

return
Rtn405a:
l(ll,20)=l(ll,20)+COS(gpi#*l(ll,3))*l(ll,6):l(ll,21)=l(ll,21)-SIN(gpi#*l(ll,3))*l(ll,6):l(ll,3)=l(ll,3)+180
IF l(ll,3)>360 THEN l(ll,3)=l(ll,3)-360
if l(ll,15)<>0 then if (l(ll,1)>122 and l(ll,1)<127) then l(ll,22)=l(ll,22)+l(ll,15):l(ll,15)=l(ll,15)*-1
return
Rtn406:
locate 1,5:
INPUT "Universal Angle";uangle

return
Rtn407:
Locate 1,5
input "Initial number";start
input "col";col
for ll=1 to nl
if sl%(ll)=sl%(0) then start=start+1:l(ll,col)=start 
next ll
return
Rtn408:
olne=lne
if sl%(0)=0 then posx4=l(lne,20):posy4=l(lne,21):gosub Rtn504a::lt$(lne)=lt$(lne)+"near cols "+posxy$+"\":return
for lne=1 to nl
if sl%(lne)=sl%(0) then posx4=l(lne,20):posy4=l(lne,21):gosub Rtn504a::lt$(lne)=lt$(lne)+"near cols "+posxy$+"\"
next lne
lne=olne
return
Rtn409:
locate 1,5
IF stronly=0 THEN stronly=1:PRINT "Edit string only on":BEEP:BEEP ELSE stronly=0:PRINT "Edit string only off":BEEP

return
Rtn410:
FOR ll=1 TO nl
IF sl%(ll)=sl%(0) THEN GOSUB Rtn410a:
NEXT ll

RETURN

Rtn410a:
angle2=l(ll,2):angle3=l(ll,3)
IF l(ll,2)>0 THEN angle2=0:angle3=90:l(ll,15)=l(l(ll,0),4)/2
IF l(ll,2)<0 THEN angle2=0:angle3=270:l(ll,15)=-l(l(ll,0),4)/2
IF l(ll,3)=90 AND l(ll,2)=0 THEN angle2=-5:angle3=l(l(ll,0),3)
IF l(ll,3)=270 AND l(ll,2)=0  THEN angle2=5:angle3=l(l(ll,0),3)
l(ll,2)=angle2:l(ll,3)=angle3
SWAP l(ll,4),l(ll,5):SWAP l(ll,14),l(ll,15)
IF l(ll,0)>0 AND l(l(ll,0),3)=180 THEN l(ll,14)=l(ll,14)*-1:l(ll,2)=l(ll,2)*-1
GOSUB updateupdate:
RETURN

return
Rtn411:
FOR ll=bl TO nl
IF sl%(0)=sl%(ll) AND l(ll,1)=107 AND l(ll,7)>0 THEN GOSUB Rtn411a:
NEXT ll
RETURN
Rtn411a:
match=0
dx2=l(ll,20)-l(l(ll,0),20):dy2=l(ll,21)-l(l(ll,0),21):IF ABS(dx2)<.5 AND ABS(dy2)<.5 THEN RETURN
GOSUB findangles10::length=dpxy:IF length<12 AND length>96 THEN RETURN
nl=nl+1:GOSUB clearline::l(nl,20)=l(l(ll,0),20):l(nl,21)=l(l(ll,0),21):l(nl,1)=117:l(nl,6)=dpxy:l(nl,3)=angle:sl%(ll)=0
IF l(nl,3)=360 THEN l(nl,3)=0 
FOR ll2=bl TO nl
IF sl%(0)=sl%(ll2) AND l(ll2,1)=107 AND ll2<>ll AND l(ll2,7)>0 THEN GOSUB Rtn411b::IF match=1 THEN RETURN
NEXT ll2
nl=nl-1
RETURN
Rtn411b:
dx2=l(ll2,20)-l(nl,20):dy2=l(ll2,21)-l(nl,21):IF ABS(dx2)<.5 AND ABS(dy2)<.5 THEN RETURN
GOSUB findangles10::length1=dpxy:angle1=angle
dx2=l(l(ll2,0),20)-l(nl,20):dy2=l(l(ll2,0),21)-l(nl,21):IF ABS(dx2)<.5 AND ABS(dy2)<.5 THEN RETURN
GOSUB findangles10::length2=dpxy:angle2=angle
match=0:length=0:angle=0
IF length1<length2 THEN length=length1:angle=angle1 ELSE length=length2:angle=angle2
angle2=ABS(angle-l(nl,3)):angle2=angle2/90-INT(angle2/90):IF angle2>.05 AND angle2<.95 THEN RETURN
IF length>12 THEN RETURN
l(nl,4)=length:l(nl,20)=l(nl,20)+COS(gpi#*angle)*length*.5:l(nl,21)=l(nl,21)-SIN(gpi#*angle)*length*.5:sl%(ll2)=0
match=1
return
Rtn412:
locate 1,5:
PRINT "1=128to110"
PRINT "2=lst=cfm"
PRINT "3=Reduce lst"
PRINT "4=Table"
PRINT "5=duct type"
PRINT "6=plenum box"
PRINT "7=flat on top"
PRINT "8=lower boots"
PRINT "9=Sleeves"
INPUT "change code";c
IF c=999 THEN INPUT "johnskeys";john

IF c=0 OR c>9 THEN RETURN

ON c GOSUB Rtn412a:,Rtn412b:,Rtn412c:,Rtn412d:,Rtn412e:,Rtn412f:,Rtn412g:,Rtn412h:,Rtn412i:
RETURN
Rtn412a:
nl2=nl
FOR ll=bl TO nl2
gosub Rtn412a1:
NEXT ll
RETURN
Rtn412a1:
IF sl%(ll)=sl%(0) THEN nl=nl+1:l(nl,0)=0:l(nl,1)=110:l(nl,2)=0:l(nl,3)=0:l(nl,4)=3.5:l(nl,5)=2.5:l(nl,6)=0:l(nl,7)=20:l(nl,8)=8:l(nl,18)=128:l(nl,13)=18:l(nl,20)=l(ll,20)+3:l(nl,21)=l(ll,21)-4:lst$(nl)=lst$(ll)
return
Rtn412b:
olne=lne
multidim=1
FOR lne=bl TO nl
if l(lne,1)=128 and sl%(lne)=sl%(0) then nl=nl+1:gosub clearline::gosub dimdiff:
nEXT lne
multidim=0
lne=olne
RETURN
takeoutspaces:
ns=LEN(llst$)
n$=""
FOR i=1 TO ns
m$=MID$(llst$,i,1):num=ASC(m$):IF num<>32 THEN n$=n$+m$
NEXT i
llst$=n$
RETURN
Rtn412c:
RETURN
Rtn412d:
RETURN

Rtn412e:
RETURN

Rtn412f:
RETURN
Rtn412g:
input "dir";dir
for ll=1 to nl
if sl%(ll)=sl%(0) and (l(ll,1)=1 or l(ll,1)=21) then l(ll,15)=(l(l(ll,0),5)-l(ll,5))/2*dir
next ll
RETURN
Rtn412h:
input "dir";dir

for ll=1 to nl
if sl%(ll)=sl%(0) and (l(ll,1)>5 and l(ll,1)<9) or (l(ll,1)>25 and l(ll,1)<29) then gosub Rtn412h1:

next ll

RETURN
Rtn412h1:
l(ll,15)=(l(l(ll,0),5)-l(ll,5))/2*dir
if abs(l(ll,15))>0 then l(ll,15)=l(ll,15)-(one*dir)
if l(l(ll,0),5)<l(ll,5) then l(ll,19)=6
return
Rtn412i:
olne=lne
nl2=nl
input "Add Description";n1
ddcode=1
for lne=1 to nl2
if sl%(lne)=sl%(0) and l(lne,1)=101 then gosub Rtn412ia:
if sl%(lne)=sl%(0) and l(lne,1)=102 then gosub Rtn412ic:
next lne
RETURN
Rtn412ia:

nl=nl+1:gosub clearline:
aaa=l(lne,4)
gosub Rtn412ib:
if l(lne,4)>l(lne,5) then s1=l(lne,4) else s1=l(lne,5)
s1=((s1+l(lne,8))/2):s1=s1-1
l(nl,0)=0:l(nl,1)=110:l(nl,2)=0:l(nl,3)=0:l(nl,4)=3.5:l(nl,5)=2.5:l(nl,6)=0:l(nl,7)=20:l(nl,8)=8:l(nl,13)=18:l(nl,20)=l(lne,20)+s1:l(nl,21)=l(lne,21)-s1
return
Rtn412ib:
xxx=aaa:xxx2=aaa:GOSUB subfractions::llst$=subfract$
IF l(lne,1)=101 THEN llst$=llst$+";"
lst$(nl)=llst$:if n1=1 then lst$(nl)=lst$(nl)+" "+lst$(lne)
if n1=0 then if l(lne,1)=101 then lst$(nl)=lst$(nl)+" "+"PIPE" 'else gosub Rtn412ic:
if l(lne,8)=0 then return
lst$(nl)=lst$(nl)+"\"
IF l(lne,1)=101 THEN aaa=l(lne,4)+l(lne,8)
IF l(lne,1)=102 THEN aaa=l(lne,4)

if aaa-fix(aaa)>.01 then aaa=fix(aaa)+1
xxx=aaa:xxx2=aaa:print aaa:GOSUB subfractions::llst$=subfract$:
IF l(lne,1)=101 THEN llst$=llst$+";"
lst$(nl)=lst$(nl)+llst$+"SLEEVE"
if l(lne,6)>0 then aaa=l(lne,6):xxx=aaa:xxx2=aaa:GOSUB subfractions::llst$=subfract$:lst$(nl)=lst$(nl)+"\"+llst$+" DEEP"
RETURN
Rtn412ic:
nl=nl+1:gosub clearline:
l(nl,0)=0:l(nl,1)=110:l(nl,2)=0:l(nl,3)=0:l(nl,4)=3.5:l(nl,5)=2.5:l(nl,6)=0:l(nl,7)=20:l(nl,8)=8:l(nl,13)=18:l(nl,20)=l(lne,20):l(nl,21)=l(lne,21)
aaa=l(lne,4)
xxx=aaa:xxx2=aaa:GOSUB subfractions::llst$=subfract$
n4$=llst$+"x":aaa=l(lne,5):xxx=aaa:xxx2=aaa:GOSUB subfractions::llst$=subfract$:llst$=n4$+llst$
lst$(nl)=llst$:if n1=1 then lst$(nl)=lst$(lne)+"\"+lst$(nl)
lst$(nl)=lst$(nl)+"SLV"
if l(lne,6)>0 then aaa=l(lne,6):xxx=aaa:xxx2=aaa:GOSUB subfractions::llst$=subfract$:lst$(nl)=lst$(nl)+"\"+llst$+" DEEP"

return

Rtn413:
locate 5,1
input "col";col
for ll=1 to nl
if sl%(ll)=sl%(0) then gosub Rtn413b:
next ll
return
Rtn413b:
if col>0 then l(ll,col)=l(lne,col)
if col=-1 then lst$(ll)=lst$(lne)
if col=-2 then lt$(ll)=lt$(lne)
return
Rtn414:
pagon=0
for ll=1 to nl
if l(ll,1)=116 and l(ll,10)>0 then l(ll,10)=0
next ll
return
Rtn415:
return
Rtn416:
locate 1,5:
INPUT "col2";col
FOR ll=1 TO nl
IF sl%(ll)=sl%(0) THEN diff=l(ll,col)-INT(l(ll,col)):IF ABS(diff)<.5 THEN l(ll,col)=INT(l(ll,col)) ELSE l(ll,col)=INT(l(ll,col))+1
NEXT ll
RETURN

return
Rtn417:
locate 1,5:
INPUT "nearest";nearest
FOR ll=1 TO nl
IF sl%(ll)=sl%(0) AND l(ll,1)<99 THEN GOSUB Rtn417a:
NEXT ll
RETURN
Rtn417a:
diff=l(ll,16)/nearest
a=nearest*.5
b=INT(diff)*nearest
c=l(ll,16)-b
IF c<a THEN diff1=-c ELSE diff1=nearest-c
diff2=diff1*-1
l(ll,6)=l(ll,6)+diff1
IF l(ll+1,0)<>ll OR l(ll+1,3)<>l(ll,3) THEN RETURN
ll1=ll+1
l(ll1,6)=l(ll1,6)+diff2
l(ll1,16)=l(ll1,16)+diff2
FOR ll2=ll1+1 TO nl
IF l(ll2,0)=ll1 THEN IF l(ll2,3)<>l(ll1,3) AND l(ll2,2)=0 THEN l(ll2,13)=l(ll2,13)+diff2
NEXT ll2

return
Rtn418:
olne=lne
pt=0
xpt(pt)=l(lne,6):ypt(pt)=lne

Rtn418a:
lne2=lne
lne=l(lne,0)
dx=l(lne,20)-l(lne2,20):dy=l(lne,21)-l(lne2,21)
dist=SQR(ABS((dx^2)+(dy^2)))
pt=pt+1:xpt(pt)=dist:ypt(pt)=lne
IF l(lne,0)>0 THEN GOTO Rtn418a:
length=changepos(9)
FOR i=pt TO 0 STEP -1
IF xpt(i)>length OR i=0 THEN lne=ypt(i):posx(posv)=l(lne,20)+COS(gpi#*l(lne,3))*length:posy(posv)=l(lne,21)-SIN(gpi#*l(lne,3))*length:lne=olne:RETURN
length=length-xpt(i)
NEXT
return

Rtn419:
FOR ll=1 TO nl
GOSUB Rtn419a:
IF full=0 THEN GOSUB Rtn419b:
NEXT ll

RETURN

Rtn419a:
full=0
FOR t=0 TO 22
IF l(ll,t)<>0 THEN full=1:RETURN
NEXT t
IF lst$(ll)<>"" THEN full=1:RETURN
IF lt$(ll)<>"" THEN full=1:RETURN
RETURN
Rtn419b:
FOR ll2=ll+1 TO nl
IF l(ll2,0)>0 THEN IF l(ll2,0)>ll THEN l(ll2,0)=l(ll2,0)-1
FOR tt=0 TO 22
l(ll2-1,tt)=l(ll2,tt)
NEXT tt
lst$(ll2-1)=lst$(ll2)
lt$(ll2-1)=lt$(ll2)

NEXT ll2
nl=nl-1
RETURN

return
Rtn5:
on itemnum goto Rtn501:,Rtn502:,Rtn503:,Rtn504:,Rtn505:,Rtn506:,Rtn507:,Rtn508:,Rtn509:,Rtn510:,Rtn511:,Rtn512:,Rtn513:,Rtn514:,Rtn515:,Rtn516:,Rtn517:,Rtn518:,Rtn519:
Rtn501:
return
Rtn502:
return
Rtn503:
locate 1,5:
INPUT "top=0 or bottom=1 elevations";a
IF a=1 THEN c=66
BEEP
GOSUB inkey::xxx=nnn
olne=lne
FOR lne=bl TO nl
IF sl%(lne)<>sl%(0) THEN GOTO rrout6:

GOSUB newelevation:
rrout6:NEXT lne
lne=olne
return
Rtn504:

cursor 2
call getmouse(m(0))
posx4=(m%(1)+fpx)*sc:posy4=(m%(0)+fpy)*sc
Rtn504a:
txta1$="":txta2$=""
txtb1$="":txtab$=""
dista1=999999:distb1=999999:dista2=999999:distb2=999999
FOR f=1 TO ngrids
IF pb(f+40)<2 THEN GOTO nxtf1:
FOR ll=1 TO lgrid(f)
angle1=ABS(SIN(gpi#*(uangle-grid(f,ll,3))))
IF angle1>.99 THEN GOSUB Rtn504b:
IF angle1<.01 THEN GOSUB Rtn504c:
NEXT ll
nxtf1:NEXT f
IF c=90  then GOTO Rtn504d:
IF c=88  then GOTO Rtn504e:
IF dista1<>999999 AND c<>88 THEN posx4=posx4+COS(gpi#*anglea1)*dista1:posy4=posy4-SIN(gpi#*anglea1)*dista1
IF distb1<>999999 AND c<>90 THEN posx4=posx4+COS(gpi#*angleb1)*distb1:posy4=posy4-SIN(gpi#*angleb1)*distb1
posxy$=txta1$+"-"+txtb1$
pposx=(posx4/sc)-fpx:pposy=(posy4/sc)-fpy:CIRCLE pposx,pposy ,4
CALL MOVETO(pposx+4,pposy+4):PRINT posxy$;
RETURN

Rtn504b:
xpt1#=grid(f,ll,1):ypt1#=grid(f,ll,2):xpt2#=grid(f,ll,4):ypt2#=grid(f,ll,5)
xpt4#=posx4:ypt4#=posy4:xpt3#=xpt4#+COS(gpi#*uangle)*20:ypt3#=ypt4#-SIN(gpi#*uangle)*20
GOSUB elength2::IF rmu<0 OR rmu>1 THEN RETURN
dx2=xpt3#-xpt4#:dy2=ypt3#-ypt4#:GOSUB findangles10:
IF dpxy<dista1 THEN dista2=dista1:txta2$=txta1$:txta1$=gridname$(f,ll):anglea2=anglea1:anglea1=angle:dista1=dpxy ELSE IF dpxy<dista2 THEN anglea2=angle:dista2=dpxy:txta2$=gridname$(f,ll)
RETURN
Rtn504c:
xpt1#=grid(f,ll,1):ypt1#=grid(f,ll,2):xpt2#=grid(f,ll,4):ypt2#=grid(f,ll,5)
xpt4#=posx4:ypt4#=posy4:xpt3#=xpt4#+COS(gpi#*(uangle+90))*20:ypt3#=ypt4#-SIN(gpi#*(uangle+90))*20
GOSUB elength2::IF rmu<0 OR rmu>1 THEN RETURN
dx2=xpt3#-xpt4#:dy2=ypt3#-ypt4#:GOSUB findangles10:
IF dpxy<distb1 THEN distb2=distb1:txtb2$=txtb1$:txtb1$=gridname$(f,ll):angleb2=angleb1:angleb1=angle:distb1=dpxy ELSE IF dpxy<distb2 THEN angleb2=angle:distb2=dpxy:txtb2$=gridname$(f,ll)
RETURN
Rtn504d:
IF dista1=999999 THEN RETURN
posx4=posx4+COS(gpi#*anglea1)*dista1:posy4=posy4-SIN(gpi#*anglea1)*dista1
dx2=posx4-posx(posv):dy2=posy4-posy(posv):GOSUB findangles10:
angle=angle-anglea1
distx=COS(gpi#*angle)*dpxy
posx(posv)=posx(posv)+COS(gpi#*anglea1)*distx
posy(posv)=posy(posv)-SIN(gpi#*anglea1)*distx
pposx=(posx(posv)/sc)-fpx:pposy=(posy(posv)/sc)-fpy
CALL MOVETO(pposx+4,pposy+4):PRINT txta1$;

RETURN
Rtn504e:
IF distb1=999999 THEN RETURN
posx4=posx4+COS(gpi#*angleb1)*distb1:posy4=posy4-SIN(gpi#*angleb1)*distb1
dx2=posx4-posx(posv):dy2=posy4-posy(posv):GOSUB findangles10:
angle=angle-angleb1
distx=COS(gpi#*angle)*dpxy
posx(posv)=posx(posv)+COS(gpi#*angleb1)*distx
posy(posv)=posy(posv)-SIN(gpi#*angleb1)*distx
pposx=(posx(posv)/sc)-fpx:pposy=(posy(posv)/sc)-fpy
CALL MOVETO(pposx+4,pposy+4):PRINT txtb1$;

RETURN
Rtn505:
locate 1,5
ba=l(lne,2)
ea=l(lne,3)
INPUT "increment";incr
INPUT "number of pts";npts
radius=l(lne,6)
INPUT "connect with line number";conlne:
xpt=l(lne,20):ypt=l(lne,21)
slcnt=1
IF npts=0 AND incr=0 THEN RETURN
IF npts=0 THEN npts=((ea-ba)/incr)+1
IF incr=0 THEN incr=(ea-ba)/npts
IF conlne>0 THEN lne=conlne
FOR ll=0 TO npts
angle=ba+(ll*incr)
IF slcnt<100 THEN slcnt=slcnt+1:posx(slcnt)=xpt+(COS(gpi#*angle)*radius):posy(slcnt)=ypt-(SIN(gpi#*angle)*radius)
IF conlne>0 THEN lne=conlne:posv=slcnt:nl=nl+1:l(nl,20)=posx(posv):l(nl,21)=posy(posv):l(nl,22)=posz(posv):GOSUB optionw::l(nl,3)=angle
NEXT ll
npv=slcnt:BEEP

return
Rtn506:
IF posdwg=0 THEN posdwg=1:BEEP ELSE posdwg=0:BEEP:BEEP
Rtn506a:
gpen=7:gosub returnpen2:
GOSUB penpattern1:
CALL MOVETO(0,0):CALL LINETO(pspx1,0):CALL LINETO(pspx1,pspy1):CALL LINETO(0,pspy1):CALL LINETO(0,0)
GOSUB penpattern0:
CALL MOVETO(0,0):CALL LINETO(pspx2,0):CALL LINETO(pspx2,pspy2):CALL LINETO(0,pspy2):CALL LINETO(0,0)

FOR i=1 TO 6
color i
CALL MOVETO(win(i,4),win(i,5)):CALL LINETO(win(i,6),win(i,5)):CALL LINETO(win(i,6),win(i,7)):CALL LINETO(win(i,4),win(i,7)):CALL LINETO(win(i,4),win(i,5))
NEXT i

return

Rtn507:
return
LOCAL FN ResetRadioGroup (BtnClicked%)
if pb(BtnClicked%)=1 then pb(BtnClicked%)=2 else pb(BtnClicked%)=1
BUTTON BtnClicked%, pb(BtnClicked%)
gpen=7:gosub returnpen2:
if BtnClicked%=31 then for bn=1 to 5: BUTTON bn, pb(31):pb(bn)=pb(31):next bn
if BtnClicked%=32 then for bn=6 to 10: BUTTON bn, pb(32):pb(bn)=pb(32):next bn
if BtnClicked%=33 then for bn=11 to 15: BUTTON bn, pb(33):pb(bn)=pb(33):next bn
if BtnClicked%=34 then for bn=16 to 20: BUTTON bn, pb(34):pb(bn)=pb(34):next bn
if BtnClicked%=35 then for bn=21 to 25: BUTTON bn, pb(35):pb(bn)=pb(35):next bn
if BtnClicked%=36 then for bn=26 to 30: BUTTON bn, pb(36):pb(bn)=pb(36):next bn
if BtnClicked%=37 then for bn=1 to 10: BUTTON bn, pb(37):pb(bn)=pb(37):next bn
if BtnClicked%=38 then for bn=11 to 20: BUTTON bn, pb(38):pb(bn)=pb(38):next bn
if BtnClicked%=39 then for bn=21 to 30: BUTTON bn, pb(39):pb(bn)=pb(39):next bn
if BtnClicked%=40 then for bn=1 to 30: BUTTON bn, pb(40):pb(bn)=pb(40):next bn
END FN
LOCAL FN HandleDialog
'---> Variables
'DIM DlgEV%,DlgID%
'---> Get Event Info
DlgEV% = DIALOG(0)
DlgID% = DIALOG(DlgEV%)
'---> Do Something Useful
SELECT DlgEV%
CASE _btnClick
'---> Button Clicked
FN resetRadioGroup (DlgID%)
CASE _wndClose
gQuit% = _true
END SELECT
END FN
Initialize:

'---> Create Window
'---> Then Create Buttons
WINDOW 2,"",(300,100)-(700,800),17

FOR i=1 TO 30
if pb(i)<2 then pb(i)=1
BUTTON i,pb(i),pn$(i),(200,50+(i*20))-(400,60+(i*20)),_radio

NEXT i
bn=30
FOR i=1 TO 30 step 5

bn=bn+1
if pb(bn)<2 then pb(bn)=1
BUTTON bn,pb(bn),"",(180,50+(i*20))-(192,60+(i*20)),_radio
NEXT i
FOR i=2 TO 30 step 10

bn=bn+1
if pb(bn)<2 then pb(bn)=1
BUTTON bn,pb(bn),"",(180,50+(i*20))-(192,60+(i*20)),_radio
NEXT i
bn=bn+1
pb(bn)=1
BUTTON bn,pb(bn),"",(180,50+(3*20))-(192,60+(3*20)),_radio
FOR i=41 TO 48

bn=bn+1
if pb(i)<2 then pb(i)=1
BUTTON i,pb(i),gridn$(i-40),(20,50+((i-40)*20))-(200,60+((i-40)*20)),_radio
nEXT i
return
Rtn508:

gosub Initialize:
Rtn508a:
ON DIALOG FN HandleDialog

if mouse(_horz)>400 or mouse(_horz)<0 then goto Rtn508b:
HANDLEEVENTS

goto Rtn508a:
return
Rtn508b:
for bn=1 to 48:BUTTON close bn:next bn

window close 2

GOSUB playpicture::GOSUB onlne::GOSUB toreturn::gosub displaypv:

cursor 0
flushevents

return







return
Rtn509:
return
Rtn510:
input col1
input col2
for ll=1 to nl
if col1>0 and col2>0 and sl%(ll)=sl%(0) then swap l(ll,col1),l(ll,col2)
if col1<0 and sl%(ll)=sl%(0) then swap lst$(ll),lt$(ll)
next ll
return
Rtn511:
gTablename$ = FILES$ (_fOpen, "TEXT", , TableNum%)
OPEN "I",1, gTablename$,,TableNum%
rr=15000
WHILE NOT EOF(1)
rr=rr-1:FOR ff=0 TO 22:INPUT #1,nchar#:l(rr,ff)=nchar#:NEXT ff:INPUT #1,char$:lst$(rr)=char$:INPUT #1,char$:lt$(rr)=char$

WEND
bb1=rr
btble=rr
CLOSE #3
BEEP
beep
beep
PRINT "end retrieving"

return
Inbeam:
if l(lne,1)=101 or l(lne,1)=102 then goto Insleeve:
if l(lne,1)>199 then goto inpipe:
FOR bb=bb1 TO 32700
IF l(lne,4)=l(bb,2) AND l(lne,5)=l(bb,3) THEN l(lne,4)=l(bb,4):l(lne,5)=l(bb,5):lst$(lne)=lst$(bb):l(lne,9)=0:GOSUB updateupdate::RETURN

NEXT bb
PRINT "not found"
RETURN
Insleeve:
locate 5,1
FOR bb=15000 TO bb1 step -1
print l(bb,2);" ";lst$(bb);" ";l(bb,4);" ";l(bb,5)
nEXT bb

FOR bb=bb1 TO 32700
if l(bb,2)=l(lne,2) then lst$(lne)=lst$(bb):l(lne,19)=l(bb,19):l(lne,4)=l(bb,4):l(lne,5)=l(bb,5):l(lne,7)=l(bb,7):l(lne,8)=l(bb,8):GOSUB updateupdate::RETURN
NEXT bb
beep
PRINT "not found"
RETURN
inpipe:
return
Rtn512:
sa=l(lne,2)
ea=l(lne,3)
IF sa>ea THEN ea=ea+360
IF sa=ea THEN RETURN
IF l(lne,8)=0 THEN l(lne,8)=(ea-sa)/5
cx=l(lne,20):cy=l(lne,21)
FOR t=4 TO 7
IF l(lne,t)=0 THEN GOTO Rtn512a:
radius=l(lne,t):incr=(ea-sa)/l(lne,8)
FOR a=sa TO ea STEP incr
nl=nl+1:GOSUB clearline::l(nl,1)=107:IF a>sa THEN l(nl,0)=nl-1
l(nl,20)=cx+(COS(gpi#*a)*radius)
l(nl,21)=cy-(SIN(gpi#*a)*radius)

NEXT a
nl=nl+1:GOSUB clearline::l(nl,1)=107
l(nl,20)=cx+(COS(gpi#*ea)*radius)
l(nl,21)=cy-(SIN(gpi#*ea)*radius)
Rtn512a:NEXT t
return
Rtn513:

return
Rtn514:
locate 1,5:
INPUT "step";stp:IF stp=0 THEN stp=5
sa=l(lne,2):ea=l(lne,3):IF sa>ea THEN ea=ea+360
INPUT "radius col";radcol
radius=l(lne,radcol):IF l(lne,1)=103 THEN radius=radius/2
FOR a=sa TO ea STEP stp
xpt2#=l(lne,20)+(COS(gpi#*a)*radius)
ypt2#=l(lne,21)-(SIN(gpi#*a)*radius)
IF a<>sa THEN dx2=xpt2#-xpt1#:dy2=ypt2#-ypt1#:GOSUB findangles10::nl=nl+1:GOSUB clearline::l(nl,20)=xpt1#:l(nl,21)=ypt1#:l(nl,3)=angle:l(nl,6)=dpxy
xpt1#=xpt2#:ypt1#=ypt2#
NEXT a
xpt2#=l(lne,20)+(COS(gpi#*a)*radius)
ypt2#=l(lne,21)-(SIN(gpi#*a)*radius)
dx2=xpt2#-xpt1#:dy2=ypt2#-ypt1#:GOSUB findangles10::nl=nl+1:GOSUB clearline::l(nl,20)=xpt1#:l(nl,21)=ypt1#:l(nl,3)=angle:l(nl,6)=dpxy

return
Rtn515:
'beep:print "iam here"
txton=1
olne=lne
nl2=nl
for lne=1 to nl2
if (l(lne,1)=113 or l(lne,1)=114 or l(lne,1)=111 or l(lne,1)=118) then gosub Rtn515a: else gosub Rtn515b:

next lne
bl=nl2+1
txton=0

return
Rtn515a:
gosub sncsn:
xpt3#=l(lne,20):ypt3#=l(lne,21):xpt4#=l(lne,20)+cs1*l(lne,6):ypt4#=l(lne,21)+sn1*l(lne,6)
gosub cliplines:
if xpt4#=0 then return
dx2=xpt5#-xpt4#:dy2=ypt5#-ypt4#:gosub findangles10:
nl=nl+1:gosub clearline:
for t=0 to 19:l(nl,t)=l(lne,t):next t:lst$(nl)=lst$(lne):lt$(nl)=lt$(lne)

l(nl,20)=xpt4#:l(nl,21)=ypt4#:l(nl,1)=l(lne,1):l(nl,3)=angle:l(nl,6)=dpxy
return
Rtn515b:
gosub sncsn:
xpt3#=l(lne,20):ypt3#=l(lne,21):xpt4#=l(lne,20)+cs1*12:ypt4#=l(lne,21)+sn1*12
gosub cliplines:
if xpt4#=0 then return
nl=nl+1
for t=0 to 22:l(nl,t)=l(lne,t):next t:lst$(nl)=lst$(lne):lt$(nl)=lt$(lne)
if l(lne,0)>0 then l(nl,0)=nl-(lne-l(lne,0))
return

Rtn516:
nl2=nl
FOR i=1 TO npv
start=0
FOR ll=1 TO nl
IF sl%(ll)=sl%(0) THEN GOSUB Rtn516a:
NEXT ll
NEXT i
nl=nl2
RETURN
Rtn516a:
IF start=0 THEN start=ll
dx=l(ll,20)-l(start,20):dy=l(ll,21)-l(start,21)
nl2=nl2+1
l(nl2,20)=posx(i)+dx
l(nl2,21)=posy(i)+dy
l(nl2,22)=l(ll,22)
FOR i1=1 TO 19:l(nl2,i1)=l(ll,i1):NEXT i1:lst$(nl2)=lst$(ll):lt$(nl2)=lt$(ll):IF l(ll,0)>0 THEN l(nl2,0)=nl2-(ll-l(ll,0)) ELSE l(nl2,0)=0
RETURN

Rtn517:
return
Rtn518:
xpt(1)=l(trk(3),20):ypt(1)=l(trk(3),21)
xpt(2)=xpt(1)+COS(.017453292#*l(trk(3),3))*l(trk(3),6)
ypt(2)=ypt(1)-SIN(.017453292#*l(trk(3),3))*l(trk(3),6)
dx2=xpt(1)-l(trk(1),20):dy2=ypt(1)-l(trk(1),21)
GOSUB findangles10:
a=ABS(l(trk(1),3)-angle)
dx=COS(.017453292#*a)*dpxy
hp1=l(trk(1),22)+(l(trk(1),5)/2)
hp2=hp1+l(trk(1),15)
IF dx>=0 AND dx<=l(trk(1),6) THEN ht1=(dx/l(trk(1),6))*l(trk(1),15):ht1=ht1+hp1
IF dx<0 THEN ht1=hp1
IF dx>l(trk(1),6) THEN ht1=hp2
dx2=xpt(2)-l(trk(2),20):dy2=ypt(2)-l(trk(2),21)
GOSUB findangles10:
a=ABS(l(trk(2),3)-angle)
dx=COS(.017453292#*a)*dpxy
hp1=l(trk(2),22)+(l(trk(2),5)/2)
hp2=hp1+l(trk(2),15)
IF dx>=0 AND dx<=l(trk(2),6) THEN ht2=(dx/l(trk(2),6))*l(trk(2),15):ht2=ht2+hp1
IF dx<0 THEN ht2=hp1
IF dx>l(trk(2),6) THEN ht2=hp2
l(trk(3),22)=ht1-(l(trk(3),5)/2)
l(trk(3),15)=ht2-ht1
GOSUB updateupdate:
RETURN
Rtn519:
IF sl%(0)=0 THEN RETURN
olne=lne
FOR lne=bl TO nl
GOSUB Getcode:
IF sl%(lne)=sl%(0) AND code=1 THEN l(lne,8)=l(lne,17)+l(lne,16)
NEXT lne
lne=olne

return
Rtn520:
lne1=trk(2):lne2=trk(1)
xpt1#=l(lne1,20)
ypt1#=l(lne1,21)
xpt2#=l(lne1,20)+COS(gpi#*l(lne1,3))*10
ypt2#=l(lne1,21)-SIN(gpi#*l(lne1,3))*10
xpt3#=l(lne2,20)
ypt3#=l(lne2,21)
xpt4#=l(lne2,20)+COS(gpi#*l(lne2,3))*10
ypt4#=l(lne2,21)-SIN(gpi#*l(lne2,3))*10
GOSUB elength2:
posx(posv)=x:posy(posv)=y
GOSUB displaypv:
return


Rtn6:
presetsc2=itemnum
Rtn61a:
pfpx=fpx:pfpy=fpy
fpx=(screenx+fpx)*sc
fpy=(screeny+fpy)*sc
MENU 6,oitem6,1
MENU 6,presetsc2,2
PRINT sc$(presetsc2)
oitem6=presetsc2
sc=scale(presetsc2)
dsc=psc/sc
fpx=(fpx/sc)-screenx
fpy=(fpy/sc)-screeny
GOSUB fpxytest:
RETURN
Rtn7:
ON itemnum GOTO Rtn701:,Rtn702:,Rtn703:,Rtn704:
Rtn701:
locate 1,5:
INPUT "grid";f
INPUT "ngrids";ngrids
INPUT "grid-name";gridn$(f)
ll2=0
FOR ll=1 TO nl
IF sl%(ll)=sl%(0) THEN GOSUB Rtn701a:
NEXT ll
lgrid(f)=ll2
pb(f+40)=2
GOSUB columnlines:

RETURN
Rtn701a:
IF ll2>119 THEN RETURN
ll2=ll2+1
grid(f,ll2,1)=l(ll,20)
grid(f,ll2,2)=l(ll,21)
grid(f,ll2,3)=l(ll,3)
grid(f,ll2,4)=l(ll,20)+COS(gpi#*l(ll,3))*l(ll,6)
grid(f,ll2,5)=l(ll,21)-SIN(gpi#*l(ll,3))*l(ll,6)
grid(f,ll2,6)=l(ll,6)
gridname$(f,ll2)=lst$(ll)

RETURN
Rtn702:

RETURN
Rtn703:
gGridname$ = FILES$ (_fSave, "TEXT", , gridNum%)
IF gridNum%=0 THEN RETURN
print gridNum%
OPEN "O",1, gGridname$,,gridNum%

FOR f=1 TO ngrids
IF lgrid(f)>0 THEN GOSUB Rtn703a:
NEXT f
CLOSE #1
BEEP
BEEP
BEEP
RETURN
Rtn703a:
nchar#=lgrid(f):print #1,nchar#
char$=gridn$(f):print #1,char$
FOR ll=1 TO lgrid(f)
FOR i=0 TO 6
nchar#=grid(f,ll,i)
print #1,nchar#
NEXT i
char$=gridname$(f,ll)
print #1,char$
NEXT ll
RETURN
Rtn704:
gridname$ = FILES$ (_fOpen, "TEXT", , gridNum%)
if gridname$="" then return
OPEN "I",1, gridname$,,gridNum%
f=1
WHILE NOT EOF(1)
INPUT #1,nchar#:lgrid(f)=nchar#
INPUT #1,char$:gridn$(f)=char$
FOR ll=1 TO lgrid(f)
FOR i=0 TO 6
INPUT #1,nchar#
grid(f,ll,i)=nchar#
NEXT i
INPUT #1,char$
gridname$(f,ll)=char$
NEXT ll
pb(f+40)=2
f=f+1
WEND
ngrids=f-1
CLOSE #1
BEEP
BEEP
beep

GOSUB columnlines:
RETURN

columnlines:
CALL PENPAT(VARPTR(pat%(0)))
FOR f=0 TO ngrids

if hdlpics&(f%)>0 then kill picture hdlpics&(f%):hdlpics&(f%)=0
picture on (0,0)-(32700,32700)
IF lgrid(f)>0 THEN GOSUB columnlines2:
PICTURE OFF,hdlpics&(f)
next f
CALL PENNORMAL
RETURN

columnlines2:
FOR ll=0 TO lgrid(f)
CALL MOVETO (grid(f,ll,1)/psc,grid(f,ll,2)/psc):CALL LINETO(grid(f,ll,4)/psc,grid(f,ll,5)/psc)
NEXT ll

RETURN
Rtn8:

MENU 8,oitem8,1
ductindex=itemnum-1
oitem8=itemnum
MENU 8,oitem8,2
RETURN

Rtn9:
ON itemnum GOTO RtnDP:,RtnD0:,RtnD1:,RtnD2:,RtnD3:,RtnD4:,RtnD5:,RtnD6:,RtnD7:,RtnD8:,RtnD9:,RtnDA:,RtnDB:,RtnAllign:,Rtnminus:,Rtnplus:,Instring:,RtnBeamTB:
RtnDP:
locate 1,5
PRINT "(1) character height and width";lheight;lwth
PRINT "(2) x,y dist to gridline parameter in inches else 36";param1
PRINT "(3) fraction maximum";fractmax
PRINT "(4) Sleeving option=1";sleeving
PRINT "(5) Center of Duct Option  Center=1, Edge=0";wdth0
PRINT "(6) BB";bbe2$
PRINT "(7) Number of Standard Joists";nstjoists
PRINT "(8) Min Dimension length to gridline";mdlength:
PRINT "(9) Gap";gap

PRINT "(10) Max Std Length [sect lengths]:";dopt(0)
PRINT "(11) Min Std Length [sect lengths]:";dopt(1)
PRINT "(12) Min Odd Length [Odd]:";dopt(2)
PRINT "(13) Min Trans Length [trans]:";dopt(3)
PRINT "(14) Min Width [wxd]:";dopt(4)
PRINT "(15) Min Length [TE/BE]:";dopt(5)
PRINT "(16) Min Length TO Grid";dopt(6)
PRINT "(17) Gridline Dim Opition 0-1.0";Opt45
PRINT "(18) Min dist TO gridline:";dopt(8)
PRINT "(19) Min elevation [BE/TE]:";dopt(9)
PRINT "(20) first WxD only=1:";popt(0)
PRINT "(21) first TE/BE only=1:";popt(1)
PRINT "(22) Last dist to gridline only=1:";popt(2)
PRINT "(23) Set Bottom Elevations Lower by";lowerel
INPUT "choice";choice
IF choice=1 THEN INPUT "height";lheight:INPUT "width";lwth:INPUT "mmargin";mmargin:IF mmargin=0 THEN mmargin=1.66
IF choice=2 THEN INPUT "Param";param1
IF choice=3 THEN INPUT "fract max";fractmax
IF choice=4 THEN INPUT "Sleeving option=1";sleeving
IF choice=5 THEN INPUT "Center of Duct Option";wdth0
IF choice=6 THEN INPUT "BB";bbe2$
IF choice=7 THEN INPUT "Number of Standard Joists";nstjoists
IF choice=8 THEN INPUT "Min Dimension length to gridline";mdlength:IF mdlength=0 THEN mdlength=12
IF choice=9 THEN INPUT"gap:";gap
IF choice=10 THEN INPUT "(10) Max Std Length [sect lengths]:";dopt(0)
IF choice=11 THEN INPUT "(11) Min Std Length [sect lengths]:";dopt(1)
IF choice=12 THEN INPUT "(12) Min Odd Length [Odd]:";dopt(2)
IF choice=13 THEN INPUT "(13) Min Trans Length [trans]:";dopt(3)
IF choice=14 THEN INPUT "(14) Min Width [wxd]:";dopt(4)
IF choice=15 THEN INPUT "(15) Min Length [TE/BE]:";dopt(5)
IF choice=16 THEN INPUT "(16) Min Length To Grid";dopt(6)
IF choice=17 THEN INPUT "(17) Gridline Dim Opition 0-1.0";Opt45
IF choice=18 THEN INPUT "(18) Min dist to gridline:";dopt(8)
IF choice=19 THEN INPUT "(19) Min elevation [BE/TE]:";dopt(9)
IF choice=20 THEN INPUT "(20) first WxD only=1:";popt(0)
IF choice=21 THEN INPUT "(21) first TE/BE only=1:";popt(1)
IF choice=22 THEN INPUT "(22) first dist to gridline only=1:";popt(2)
IF choice=23 THEN INPUT "Set Bottom Elevations Lower by";lowerel

IF choice=0 THEN RETURN
GOTO RtnDP:
RETURN
RtnD0:
GOSUB plotdimpts::if ndpts<2 then return
ddcode=1
dcode=2:GOSUB DimParameters::xxx=length-gap
IF l(lne,7)=0 THEN xxx=56*one
xxx2=xxx:GOSUB subfractions::llst$=subfract$
lvl=1

FOR dcode=2 TO ndpts
IF length>0 THEN print "dcode";dcode;ndpts:GOSUB fillnewline::GOSUB Resetpts::GOSUB leftxy::l(nl,10)=length:l(nl,11)=0:l(nl,6)=0:l(nl,18)=0:l(nl,17)=lne
IF multidim=0 THEN GOSUB stpproc:

NEXT dcode
ddcode=0
RETURN

RtnD1:
if l(lne,1)>199 then goto dimpipe:

IF multidim=1 AND l(lne,1)=13 THEN RETURN
ddcode=1
GOSUB plotdimpts:
GOSUB wxd:
GOSUB fillnewline:
IF l(lne,2)<>0  and l(lne,1)<99 THEN l(nl,0)=0:l(nl,1)=110:l(nl,2)=0:l(nl,3)=0:l(nl,6)=0:l(nl,7)=20:l(nl,8)=8:l(nl,13)=18:l(nl,20)=l(lne,20)+3:l(nl,21)=l(lne,21)-4:lst$(nl)=llst$: GOSUB stpproc::return
IF l(lne,1)=128 THEN gosub dimdiff::return
GOSUB Dim17:
lvl=lvl1:dcode=dcode1

IF multidim=1 AND dcode=0 THEN nl=nl-1:RETURN
RtnD1a:
GOSUB DimParameters::l(nl,6)=length
GOSUB Resetpts:
IF l(lne,1)>59 THEN l(nl,6)=l(nl,6)-l(lne,7)
GOSUB rightxy:
IF l(lne,1)=15 THEN l(nl,20)=l(lne,20)+(cs1*l(lne,6)/4):l(nl,21)=l(lne,21)+sn1*(l(lne,6)/4):l(nl,20)=l(nl,20)+(cs2*l(lne,4)*.8):l(nl,21)=l(nl,21)+(sn2*l(lne,4)*.8)
l(nl,10)=l(lne,4):l(nl,11)=l(lne,5):l(nl,6)=0:l(nl,18)=1:l(nl,17)=lne:l(nl,7)=20
IF dcode=0 OR l(lne,2)<>0 THEN l(nl,20)=l(lne,20)+10:l(nl,21)=l(lne,21)+10:l(nl,5)=lwth
IF multidim=0 THEN GOSUB stpproc:
IF ndpts>5 AND multidim=1 THEN dcode=ndpts-1:GOSUB fillnewline::ndpts=4:GOTO RtnD1a:
ddcode=0
RETURN
dimdiff:
l(nl,0)=0:l(nl,1)=110:l(nl,2)=0:l(nl,3)=0:l(nl,6)=0:l(nl,7)=20:l(nl,8)=8:l(nl,13)=18:l(nl,20)=l(lne,20)+3:l(nl,21)=l(lne,21)-4
l(nl,16)=l(lne,7):l(nl,17)=lne:l(nl,18)=128
llst2$=lt$(lne)
gosub Makecaps:
llst2$=llst$
llst$=""
IF (l(lne,13)>0 AND l(lne,14)>0) THEN llst$=llst$+STR$(l(lne,13))+"x"+STR$(l(lne,14))+""
IF (l(lne,13)>0 AND l(lne,14)=0) THEN llst$=llst$+STR$(l(lne,13))+";"
IF l(lne,15)>0 THEN llst$=llst$+"\"+STR$(l(lne,15))
GOSUB takeoutspaces:
lst$(lne)=llst2$+"\"+llst$
lst$(nl)=lst$(lne)
IF multidim=0 THEN GOSUB stpproc:


return
dimpipe:
ddcode=1
aaa=l(lne,4)
xxx=aaa:xxx2=aaa:GOSUB subfractions::llst$=subfract$:ddcode=0
gosub fillnewline:
l(nl,20)=(l(lne,20)+l(l(lne,0),20))/2
l(nl,21)=(l(lne,21)+l(l(lne,0),21))/2
l(nl,3)=0:l(nl,8)=8:l(nl,13)=12:l(nl,6)=0:l(nl,7)=20
IF multidim=0 THEN GOSUB stpproc:

return
wxd:
aaa=l(lne,4)
xxx=aaa:xxx2=aaa:GOSUB subfractions::llst$=subfract$
IF l(lne,4)=l(lne,5) AND l(lne,1)>19 THEN llst$=llst$+";":RETURN
n4$=llst$+"x"
aaa=l(lne,5)
xxx=aaa:xxx2=aaa:GOSUB subfractions::llst$=subfract$
llst$=n4$+llst$
IF l(lne,1)>19 THEN llst$=llst$+";":RETURN
RETURN
Dim17:
GOSUB getstringlength:
IF l(lne,16)>(l(nl,22)+(2*one)) THEN ccode=1 ELSE ccode=0
lvl1=0:dcode1=0:lvl7=0:dcode7=0
IF nlvls=1 AND ndpts=1 AND ccode=1 THEN lvl1=2:dcode1=1:lvl7=0:dcode7=1:RETURN
IF nlvls=1 AND ndpts>1 THEN lvl1=1:dcode1=2:lvl7=0:dcode7=2:RETURN
IF nlvls=2 AND ndpts=1 AND ccode=1 THEN lvl1=2:dcode1=1:lvl7=0:dcode7=1:RETURN
IF nlvls=2 AND ndpts=2 AND ccode=0 THEN lvl1=2:dcode1=2:lvl7=0:dcode7=2:RETURN
IF nlvls=2 AND ndpts=2 AND ccode=1 THEN lvl1=2:dcode1=1:lvl7=2:dcode7=2:RETURN
IF nlvls=2 AND ndpts>2 THEN lvl1=2:dcode1=2:lvl7=2:dcode7=3:RETURN
IF nlvls=3 AND ndpts=1 AND ccode=1 THEN lvl1=2:dcode1=1:lvl7=0:dcode7=1:RETURN
IF nlvls=3 AND ndpts=2 THEN lvl1=1:dcode1=2:lvl7=3:dcode7=2:RETURN
IF nlvls=3 AND ndpts>2 THEN lvl1=2:dcode1=2:lvl7=3:dcode7=3:RETURN
IF nlvls>3 AND ndpts=1 AND ccode=1 THEN lvl1=2:dcode1=1:lvl7=4:dcode7=1:RETURN
IF nlvls>3 AND ndpts=2 THEN lvl1=2:dcode1=2:lvl7=4:dcode7=2:RETURN
IF nlvls>3 AND ndpts>2 THEN lvl1=2:dcode1=2:lvl7=3:dcode7=3:RETURN
RETURN

RtnD2:
IF l(lne,16)=0 THEN RETURN
GOSUB plotdimpts:
lvl=1:ddcode=1
dcode=1
GOSUB DimParameters::xxx=length-gap:xxx2=xxx:GOSUB subfractions::llst$=subfract$
IF length>0 THEN GOSUB fillnewline::GOSUB Resetpts:
GOSUB getstringlength:
IF l(nl,22)>l(nl,6)-(2*one) THEN GOSUB RtnD2a:: ELSE GOSUB leftxy:
l(nl,10)=length:l(nl,11)=0:l(nl,6)=0:l(nl,18)=2:l(nl,17)=lne:l(nl,7)=20

IF multidim=0 THEN GOSUB stpproc:
RETURN
RtnD2a:
l(nl,7)=20
l(nl,20)=l(nl,20)-(cs2*hi):l(nl,21)=l(nl,21)-(sn2*hi)
IF (l(lne,3)=90 OR l(lne,3)=270) THEN GOTO RtnD2b:
hi=(l(lne,4)/2)
l(nl,20)=l(nl,20)-(cs2*hi):l(nl,21)=l(nl,21)-(sn2*hi)
IF reversit=0 THEN l(nl,20)=l(nl,20)+(cs1*one):l(nl,21)=l(nl,21)+(sn1*one):l(nl,8)=-lheight-2.5:l(nl,13)=3.5:l(nl,6)=0:l(nl,7)=20
IF reversit=1 THEN l(nl,20)=l(nl,20)+(cs1*(length-1)*one):l(nl,21)=l(nl,21)+(sn1*(length-1)*one):l(nl,8)=-lheight-2.5:l(nl,13)=-l(nl,22)-3:l(nl,6)=0:l(nl,7)=20
RETURN
RtnD2b:
l(nl,3)=0:l(nl,6)=0
IF l(lne,3)=90 THEN l(nl,20)=l(nl,20)+(l(lne,4)/2):l(nl,21)=l(nl,21)-1:l(nl,8)=4:l(nl,13)=9
IF l(lne,3)=270 THEN l(nl,20)=l(nl,20)+(l(lne,4)/2):l(nl,21)=l(nl,21)-(length-1):l(nl,8)=-6:l(nl,13)=9
RETURN

RtnD3:
'REM: transition length
if l(lne,1)>199 and lst$(lne)<>"" then goto dimpipe2:
GOSUB plotdimpts:
lvl=0:ddcode=1:dcode=0
GOSUB DimParameters::xxx=length-gap:xxx2=xxx:GOSUB subfractions::llst$=subfract$
GOSUB codebreak:
if ccode=3 then lvl=1
IF ccode=2 THEN GOTO inradius:
IF ccode=4 THEN GOTO inelbow:
IF ccode<1 OR ccode>3 THEN RETURN
IF length>0 THEN GOSUB fillnewline::GOSUB Resetpts::ELSE RETURN
IF ccode=1 THEN IF l(lne,4)<l(l(lne,0),4) THEN GOSUB leftxy:: ELSE  GOSUB rightxy:
IF ccode=3 THEN GOSUB centerxy:
ddcode=0

l(nl,10)=length:l(nl,11)=0:l(nl,6)=0:l(nl,17)=lne:l(nl,7)=20:l(nl,18)=3
IF ccode=1 THEN GOSUB trandiscript:
IF multidim=0 THEN GOSUB stpproc:
RETURN
trandiscript:
tr$=""
IF l(l(lne,0),22)+l(l(lne,0),5)/2=l(lne,22)+l(lne,5)/2 THEN tr$="F/T"
IF l(l(lne,0),22)-l(l(lne,0),5)/2=l(lne,22)-l(lne,5)/2 THEN tr$="F/B"
IF l(l(lne,0),22)=l(lne,22) THEN tr$="O/C"
IF l(lne,5)=l(l(lne,0),5) THEN tr$=""
if mcode=13 then return
IF tr$="" THEN RETURN
lst$(nl)=lst$(nl)+"\"+tr$:IF (l(lne,3)>90 AND l(lne,3)<=270) THEN h=(lheight*.75)+(l(lne,14)/2) ELSE h=(lheight*.75)-(l(lne,14)/2)
l(nl,20)=l(nl,20)+(cs2*h):l(nl,21)=l(nl,21)+(sn2*h)
IF multidim=0 THEN GOSUB stpproc:
RETURN
dimpipe2:
gosub fillnewline:
lst$(nl)=lst$(lne)
l(nl,20)=l(lne,20)+l(lne,4)/2
l(nl,21)=l(lne,21)+l(lne,4)/2
l(nl,3)=0:l(nl,8)=8:l(nl,13)=12:l(nl,6)=0:l(nl,7)=20
IF multidim=0 THEN GOSUB stpproc:

return
inradius:
GOSUB sncsn:
ttan=TAN(gpi#*((l(lne,3)-l(l(lne,0),3))/2))
arctan=ATN(ttan)*114.591559#
xxx=l(lne,4):IF l(lne,8)>0 THEN xxx=l(lne,8)
radd=l(lne,4)/2+xxx
sgna=SGN(arctan)
cx=l(lne,20)+cs1*l(lne,17):cy=l(lne,21)+sn1*l(lne,17)
cx=cx+COS(gpi#*(l(lne,3)+(90*sgna)))*radd
cy=cy-SIN(gpi#*(l(lne,3)+(90*sgna)))*radd
angle=l(l(lne,0),3)-(90*sgna)+(arctan/2)
GOSUB fillnewline:
xxx2=xxx:GOSUB subfractions::lst$(nl)=subfract$+"R"
ddcode=0
l(nl,3)=angle
l(nl,7)=23
l(nl,10)=radd
l(nl,11)=0
l(nl,6)=(radd-l(lne,4)/2)/2:l(nl,18)=3:l(nl,17)=lne
l(nl,20)=cx+COS(gpi#*angle)*l(nl,6):l(nl,21)=cy-SIN(gpi#*angle)*l(nl,6)
l(nl,8)=-l(nl,4)/2:l(nl,13)=l(nl,6)+(2*one)
IF (l(nl,3)>90 AND l(nl,3)<=270) THEN GOSUB reversearrow:
IF multidim=0 THEN GOSUB stpproc:
RETURN
inelbow:
GOSUB inelbow2:
IF l(lne,11)=0 THEN RETURN
lvl=1
xxx=l(lne,11):xxx2=xxx:GOSUB subfractions::llst$="+"+subfract$
IF length>0 THEN GOSUB fillnewline::GOSUB Resetpts::GOSUB rightxy:
l(nl,10)=length:l(nl,11)=0:l(nl,6)=0:l(nl,18)=3:l(nl,17)=lne:l(nl,7)=20

IF multidim=0 THEN GOSUB stpproc:
RETURN
inelbow2:
angle=l(lne,3)-l(l(lne,0),3):IF ABS(angle)>180 THEN angle=angle-(360*SGN(angle))
diff=(angle/45)-INT(angle/45):IF diff=0 THEN RETURN

xxx=180-ABS(angle)

xxx=int(xxx*100)/100

llst$=STR$(xxx)+"¡"
nl=nl+1:l(nl,0)=0:l(nl,1)=110:l(nl,2)=0:l(nl,3)=0:l(nl,4)=3.5:l(nl,5)=2.5:l(nl,6)=0:l(nl,7)=27:l(nl,18)=3:l(nl,8)=8:l(nl,13)=18:l(nl,20)=l(lne,20)+3:l(nl,21)=l(lne,21)-3:lst$(nl)=llst$
sl%(nl)=sl%(0)
IF multidim=0 THEN GOSUB stpproc:

RETURN

reversearrow:
GOSUB getstringlength:
l(nl,20)=l(nl,20)+COS(gpi#*l(nl,3))*l(nl,6):l(nl,21)=l(nl,21)-SIN(gpi#*l(nl,3))*l(nl,6)
l(nl,3)=l(nl,3)-180:IF l(nl,3)<0 THEN l(nl,3)=l(nl,3)+360
l(nl,13)=-l(nl,22)-(2*one)
l(nl,7)=24
RETURN
codebreak:
ccode=0
GOSUB Getcode::mcode=code
IF mcode=1  THEN ccode=1
IF mcode=13  THEN ccode=1
IF mcode=4  THEN ccode=4
IF mcode=5 THEN ccode=2
IF mcode=6  OR mcode=7 OR mcode=8 THEN ccode=3

RETURN
RtnD4:
col2=l(lne,2)
ouangle=uangle:
wth=l(lne,4)/2
posx4=l(lne,20):posy4=l(lne,21):uangle=l(lne,3)

GOSUB Rtn504a:
IF distb1<wth+6 THEN SWAP distb1,distb2:SWAP angleb1,angleb2
uangle=ouangle
nl=nl+1
sl%(nl)=sl%(0)
reversed=0
IF wdth0=1 THEN wth=0
l(nl,0)=0
l(nl,1)=110
l(nl,3)=angleb1:l(nl,6)=distb1
l(nl,16)=distb1
l(nl,20)=l(lne,20)
l(nl,21)=l(lne,21)
IF wdth0=0 THEN l(nl,20)=l(nl,20)+COS(gpi#*l(nl,3))*wth:l(nl,21)=l(nl,21)-SIN(gpi#*l(nl,3))*wth
IF col2=0 THEN l(nl,20)=l(nl,20)+COS(gpi#*l(lne,3))*(l(lne,6)-2):l(nl,21)=l(nl,21)-SIN(gpi#*l(lne,3))*(l(lne,6)-2)

l(nl,4)=lheight
l(nl,5)=lwth
l(nl,6)=l(nl,6)-wth
l(nl,10)=l(nl,6):l(nl,11)=0
l(nl,17)=0
l(nl,12)=0
l(nl,18)=4
l(nl,7)=20
l(nl,14)=0:l(nl,15)=0
l(nl,3)=INT(l(nl,3)+.01)
IF (l(nl,3)>90 AND l(nl,3)<=270) THEN GOSUB reversedirection2::reversed=1:l(nl,12)=reversed
IF fractmax=0 THEN IF l(lne,6)<(12*one) THEN ddcode=1
IF fractmax>0 AND l(lne,6)<=fractmax THEN ddcode=1
xxx=l(nl,6):GOSUB subfractions::lst$(nl)=subfract$:GOSUB getstringlength:
IF  (l(nl,22)+4)>l(nl,6) THEN ddcode=1:xxx=l(nl,6):GOSUB subfractions::lst$(nl)=subfract$:GOSUB getstringlength:
IF Opt45>0 THEN IF l(nl,22)>0 AND (l(nl,22)/l(nl,6))<Opt45 THEN GOSUB RtnD4a:

GOSUB centerinlength:
IF multidim=0 THEN GOSUB stpproc:
RETURN
RtnD4a:
IF reversed=0 THEN l(nl,6)=l(nl,22)+8:l(nl,7)=25:l(nl,13)=4
IF reversed=1 THEN angle=l(nl,3):GOSUB sncsn2::dist=l(nl,6)-l(nl,22)-8:l(nl,7)=26:GOSUB movith::l(nl,6)=l(nl,22)+8:l(nl,13)=1
RETURN

movith:
l(nl,20)=l(nl,20)+cs1*dist:l(nl,21)=l(nl,21)+sn1*dist
RETURN
movitv:
l(nl,20)=l(nl,20)+cs2*dist:l(nl,21)=l(nl,21)+sn2*dist
RETURN

RtnD5:
RETURN


RETURN
RtnD6:
IF l(lne,1)<110 AND  l(lne,1)>111 THEN RETURN
IF fractmax=0 THEN IF l(lne,6)<(12*one) THEN ddcode=1
IF fractmax>0 AND l(lne,6)<=fractmax THEN ddcode=1

GOSUB sncsn:
lst$(lne)=""
xxx=l(lne,6):xxx2=xxx
snl=nl
nl=lne
GOSUB subfractions::lst$(nl)=subfract$
GOSUB centerinlength:
GOSUB stpproc:
l(nl,18)=6:l(nl,17)=0
nl=snl
ddcode=0
RETURN
RtnD7:
if l(lne,1)>199 then goto RtnD7200:

IF l(lne,2)<>0 THEN RETURN
GOSUB plotdimpts::ddcode=0
elev=l(lne,22)+lowerel
IF itemnum=9 THEN aaa=elev-(l(lne,5)/2):xxx=aaa:xxx2=aaa:xx2=aaa:GOSUB subfractions::llst$=subfract$:begg$=llst$
IF itemnum=9 THEN aaa=elev+(l(lne,5)/2):xx1=aaa
IF itemnum=10 THEN aaa=elev:xx1=aaa
xxx=aaa:xxx2=aaa:GOSUB subfractions::llst$=subfract$
IF itemnum=9 THEN llst$="T[+"+llst$+"]\B[+"+begg$+"]"
IF itemnum=10 THEN llst$="C/L EL."+llst$
GOSUB fillnewline:
GOSUB getstringlength:
GOSUB Dim17:
lvl=lvl7:dcode=dcode7
GOSUB DimParameters::l(nl,6)=length
IF multidim=1 AND dcode=0 THEN nl=nl-1:RETURN
GOSUB Resetpts::IF lvl>0 THEN GOSUB rightxy:: ELSE GOSUB RtnD7a:
l(nl,10)=xx1:l(nl,11)=xx2:l(nl,6)=0:l(nl,18)=7:l(nl,17)=lne:l(nl,7)=20
IF multidim=0 THEN GOSUB stpproc:
RETURN
RtnD7a:

l(nl,7)=20
l(nl,20)=l(nl,20)-(cs2*hi):l(nl,21)=l(nl,21)-(sn2*hi)
IF (l(lne,3)=90 OR l(lne,3)=270) THEN GOTO RtnD7b:
hi=(l(lne,4)/2)
l(nl,20)=l(nl,20)+(cs2*hi):l(nl,21)=l(nl,21)+(sn2*hi)
IF reversit=0 THEN l(nl,20)=l(nl,20)+(cs1*one):l(nl,21)=l(nl,21)+(sn1*one):l(nl,8)=3.5+lheight:l(nl,13)=4:l(nl,6)=0:l(nl,7)=20
IF reversit=1 THEN l(nl,20)=l(nl,20)+(cs1*(length-1)*one):l(nl,21)=l(nl,21)+(sn1*(length-1)*one):l(nl,8)=lheight+3.5:l(nl,13)=-l(nl,22)-4:l(nl,6)=0:l(nl,7)=20
RETURN
RtnD7b:
l(nl,3)=0:l(nl,6)=0
IF l(lne,3)=90 THEN l(nl,20)=l(nl,20)+(l(lne,4)/2):l(nl,21)=l(nl,21)-(length/3):l(nl,8)=4:l(nl,13)=9
IF l(lne,3)=270 THEN l(nl,20)=l(nl,20)+(l(lne,4)/2):l(nl,21)=l(nl,21)-(length/3):l(nl,8)=-6:l(nl,13)=9
RETURN

RtnD7200:
GOSUB fillnewline:


aaa=l(lne,22)-(l(lne,5)/2):xxx=aaa:xxx2=aaa:xx2=aaa:GOSUB subfractions::llst$=subfract$:begg$=llst$
aaa=l(lne,22)+(l(lne,5)/2):xxx=aaa:xxx2=aaa:GOSUB subfractions::llst$=subfract$
lst$(nl)="T[+"+llst$+"]\INV[+"+begg$+"]"

l(nl,20)=l(lne,20)+3
l(nl,21)=l(lne,21)+3
l(nl,7)=20
l(nl,6)=0
l(nl,17)=lne
l(nl,18)=200
IF multidim=0 THEN GOSUB stpproc:
return
RtnD8:
locate 5,5:print "itemnum=";itemnum
goto RtnD7:
return
RtnD9:
dcode=0:ddcode=1
gosub Getcode:
IF code<>13 THEN RETURN
IF l(lne,4)<(2*one) THEN RETURN


GOSUB nlplusone::GOSUB clearline:
lst$(nl)="":l(nl,0)=0:l(nl,1)=110:l(nl,17)=lne:l(nl,4)=lheight:l(nl,6)=l(lne,17):l(nl,5)=lwth:l(nl,3)=l(lne,3)
GOSUB sncsn:
l(nl,20)=l(lne,20):l(nl,21)=l(lne,21)
IF l(lne,4)>=l(l(lne,0),4) THEN wth=l(lne,4)/2 ELSE wth=l(l(lne,0),4)/2
l(nl,7)=3
IF (l(lne,3)>90 AND l(lne,3)<=270) THEN l(nl,7)=24:GOSUB reversedirection:
hi=-wth-lheight-(5*one)
l(nl,20)=l(nl,20)+(cs2*hi):l(nl,21)=l(nl,21)+(sn2*hi)
be1=l(lne,22)-(l(lne,5)/2)
be2=l(l(lne,0),22)-(l(l(lne,0),5)/2)
risefall=be1-be2:IF risefall=0 THEN nl=nl-1:goto RtnD9b:
xxx=ABS(risefall):xxx2=ABS(risefall):GOSUB subfractions::llst$=subfract$
IF risefall>0 and l(l(lne,0),5)=l(lne,5) THEN lst$(nl)="R-"+llst$
IF risefall<0 and l(l(lne,0),5)=l(lne,5) THEN lst$(nl)="D-"+llst$

IF risefall>0  and l(l(lne,0),5)<>l(lne,5) THEN lst$(nl)="BR-"+llst$
IF risefall<0  and l(l(lne,0),5)<>l(lne,5) THEN lst$(nl)="BD-"+llst$
GOSUB centerxy:
l(nl,6)=l(nl,22):l(nl,8)=(1.2*one):l(nl,18)=8:l(nl,17)=lne
IF multidim=0 THEN GOSUB stpproc:
RtnD9b:
IF code<>13 or l(lne,14)=0 THEN RETURN
dcode=0:ddcode=1
GOSUB nlplusone::GOSUB clearline:
lst$(nl)="":l(nl,0)=0:l(nl,1)=110:l(nl,17)=lne:l(nl,4)=lheight:l(nl,5)=lwth:l(nl,3)=l(lne,3)
GOSUB sncsn:
l(nl,20)=l(lne,20)+cs1*l(lne,17):l(nl,21)=l(lne,21)+sn1*l(lne,17)
l(nl,20)=l(nl,20)+cs2*(l(lne,4)/2):l(nl,21)=l(nl,21)+sn2*(l(lne,4)/2)
IF (l(lne,3)>90 AND l(lne,3)<=270) THEN l(nl,7)=20:GOSUB reversedirection:
xxx=l(lne,14):xxx2=l(lne,14):GOSUB subfractions::llst$=subfract$
IF l(lne,14)>0 THEN lst$(nl)="Offset\C/L "+llst$
IF l(lne,14)<0 THEN lst$(nl)="Offset\C/L "+llst$
GOSUB getstringlength:
l(nl,8)=l(nl,4)*(3*one):l(nl,13)=-l(nl,22)-(4*one)
l(nl,6)=0:l(nl,18)=9:l(nl,17)=lne:l(nl,7)=20
IF multidim=0 THEN GOSUB stpproc:
RETURN



RtnDA:
locate 1,5
PRINT "0=no, >0=yes"
INPUT "Sections";t(0)
INPUT "Width x Depth";t(1)
INPUT "Odd";t(2)
INPUT "Trans";t(3)
INPUT "Nearest Vertical";t(4)
INPUT "Nearest Horizontal";t(5)
INPUT "B/T Elevations";t(6)
INPUT "Rise/Fall";t(7)
INPUT "Offset";t(8)

INPUT "Start=0";strt:IF strt>0 THEN RETURN
multidim=1
olne=lne
FOR lne=1 TO nl
if l(lne,1)<99 then gosub Getcode:
IF sl%(lne)<>sl%(0) THEN GOTO nxtlne999:
IF l(lne,1)=120 THEN GOTO nxtlne999:
IF l(lne,1)>100 and l(lne,1)<200 OR l(lne,2)<>0 THEN GOTO nxtlne999:
GOSUB Dtest:
IF t(0)>0 AND dt(0)>0 THEN GOSUB RtnD0:
IF t(1)>0 AND dt(1)>0 THEN GOSUB RtnD1:
IF t(2)>0 AND dt(2)>0 THEN GOSUB RtnD2:
IF t(3)>0 AND dt(3)>0 THEN GOSUB RtnD3:
IF t(4)>0 AND dt(4)>0 THEN GOSUB RtnD4:
IF t(5)>0 AND dt(5)>0 THEN GOSUB RtnD5:
IF t(6)>0 AND dt(6)>0 THEN GOSUB RtnD7:
IF t(7)>0 AND dt(7)>0 THEN GOSUB RtnD8:
IF t(8)>0 AND dt(8)>0 THEN IF code=13 THEN GOSUB  RtnD9:

nxtlne999:NEXT lne
lne=olne
multidim=0
RETURN
Dtest:
FOR t=0 TO 8:dt(t)=1:NEXT t
return
IF l(lne,3)=l(l(lne,0),3) AND l(lne,0)>0 THEN sameangle=1 ELSE sameangle=0
IF l(lne,4)=l(l(lne,0),4) AND l(lne,5)=l(l(lne,0),5) THEN samewxd=1 ELSE samewxd=0
IF l(lne,22)-l(lne,5)=l(l(lne,0),22)-l(l(lne,0),5) AND l(lne,22)+l(lne,5)=l(l(lne,0),22)+l(l(lne,0),5) THEN sameelev=1 ELSE sameelev=0
IF l(lne,7)<6 THEN interval=stdsect(l(lne,7)) ELSE interval=l(lne,7)
IF dopt(0)>0 AND interval>dopt(0) THEN dt(0)=0
IF dopt(1)>0 AND interval<dopt(1) THEN dt(0)=0
IF dopt(2)>0 AND l(lne,16)<dopt(2) THEN dt(2)=0
IF dopt(3)>0 AND l(lne,17)<dopt(3) THEN dt(3)=0
IF dopt(4)>0 AND l(lne,4)<dopt(4) THEN dt(1)=0
IF dopt(5)>0 AND l(lne,6)<dopt(5) THEN dt(6)=0:dt(7)=0
IF dopt(6)>0 AND l(lne,6)<dopt(6) THEN dt(4)=0:dt(5)=0
IF dopt(9)>0 AND l(lne,22)<dopt(9) THEN dt(6)=0:dt(7)=0
IF popt(0)>0 AND sameangle=1 AND samewxd=1 THEN dt(1)=0
IF popt(1)>0 AND sameangle=1 AND sameelev=1 THEN dt(6)=0:dt(7)=0
IF popt(2)>0 AND sameangle=1 THEN dt(4)=0:dt(5)=0
RETURN
RtnDB:
locate 1,5
input "Beams T &B=1 ";answer:if answer=1 then goto RtnBeamTB:
IF sl%(0)=0 THEN GOTO RtnDC:
olne=lne
nl2=nl
FOR lne=1 TO nl2
IF sl%(lne)<>sl%(0) THEN GOTO rrout8:
IF (l(lne,4)=(3*one) AND nstjoists>0) THEN IF njoists<nstjoists THEN njoists=njoists+1:GOTO rrout8: ELSE njoists=0
GOSUB RtnDC:
locate 5,1:print "     "
locate 5,1:print lne
rrout8:NEXT lne
lne=olne

RETURN
RtnDC:

IF l(lne,1)=123 THEN be$="B.O.B."
IF l(lne,1)=124 THEN be$="B.O.J."
IF lst$(lne)<>"" THEN be$="B.O.S."
IF l(lne,1)>100 THEN be$="B.O.S."
IF bbe2$<>"" THEN be$=bbe2$
'IF l(lne,1)>100 THEN GOTO RtnDD:
FOR t=1 TO 5
IF t=2 AND l(lne,22)=0 THEN return
IF t=3 AND l(lne,15)=0 THEN return
GOSUB sncsn:
GOSUB nlplusone:
GOSUB clearline:
l(nl,20)=l(lne,20):l(nl,21)=l(lne,21):l(nl,6)=l(lne,6):l(nl,3)=l(lne,3)

IF t=5 THEN IF l(lne,15)>0 THEN distarrow=(l(lne,6)/2)-(25*one):l(nl,3)=l(nl,3)-180 ELSE distarrow=(l(lne,6)/2)+(25*one)
IF t=5 THEN l(nl,20)=l(nl,20)+(cs1*distarrow):l(nl,21)=l(nl,21)+(sn1*distarrow):l(nl,1)=113:l(nl,6)=l(lne,6)/6:l(nl,5)=(12*one):l(nl,4)=(2*one):RETURN
lst$(nl)="":l(nl,0)=0:l(nl,1)=110:l(nl,17)=lne:l(nl,4)=lheight:l(nl,5)=lwth:l(nl,3)=l(lne,3)
IF (l(lne,3)>90 AND l(lne,3)<=270) THEN l(nl,20)=l(nl,20)+(cs1*l(nl,6)):l(nl,21)=l(nl,21)+(sn1*l(nl,6)):l(nl,3)=l(nl,3)+180:IF l(nl,3)>360 THEN l(nl,3)=l(nl,3)-360
IF (l(lne,3)>90 AND l(lne,3)<=270) THEN cs1=COS(gpi#*l(nl,3)):sn1=-SIN(gpi#*l(nl,3)):cs2=COS(gpi#*(l(nl,3)+90)):sn2=-SIN(gpi#*(l(nl,3)+90))
IF t=3 THEN dx2=l(lne,6):dy2=l(lne,15):GOSUB findangles10::wth=ABS(TAN(gpi#*angle)*l(lne,5)):wth2=SQR(ABS(wth^2+l(lne,5)^2)):aaa=l(lne,22)+(l(lne,5)/2)+l(lne,15)-wth2 ELSE aaa=l(lne,22)-(l(lne,5)/2)
xxx=aaa:xxx2=aaa:GOSUB assemblestring:
lst$(nl)=be$+lst$(nl):GOSUB getstringlength:
IF t=4 THEN lst$(nl)="SLOPE DWN"
IF t=1 THEN IF lst$(lne)="" THEN ddcode=1:aaa=l(lne,4):xxx=aaa:xxx2=aaa:GOSUB assemblestring::n4$=lst$(nl):aaa=l(lne,5):xxx=aaa:xxx2=aaa:GOSUB assemblestring::n4$=n4$+"x":n4$=n4$+lst$(nl):lst$(nl)=n4$:ddcode=0 ELSE lst$(nl)=lst$(lne)
IF l(lne,15)=0 OR t=1 OR t=4 THEN GOSUB centerxy:: ELSE GOSUB putatends:
IF t=1 THEN height=(l(lne,4)/2)+(2*one) ELSE height=-(l(lne,4)/2)-l(nl,4)-(2*one)
IF l(lne,9)=1 THEN IF t=1 THEN lst$(nl)="LO "+lst$(nl):height=height+l(nl,4)+(2*one) ELSE height=height-l(nl,4)-(2*one)
IF t=4 THEN IF l(nl,4)>l(lne,4)*.7 THEN l(nl,4)=l(lne,4)*.7:height=-(l(nl,4)/2) ELSE height=-(l(nl,4)/2)
l(nl,20)=l(nl,20)+(cs2*height):l(nl,21)=l(nl,21)+(sn2*height)
l(nl,6)=0:l(nl,17)=lne:l(nl,18)=10+t
IF (l(lne,3)>90 AND l(lne,3)<=270) AND t=3 THEN SWAP l(nl,20),l(nl-1,20):SWAP l(nl,21),l(nl-1,21)

NEXT t
RETURN
RtnBeamTB:

olne=lne
'if sl%(0)=0 then gosub RtnBeamTB2::RETURN
for lne=1 to nl
if sl%(lne)=sl%(0) and l(lne,1)=123 then gosub RtnBeamTB2:

next lne
return
RtnBeamTB2:
gosub sncsn:
nl=nl+1
l(nl,20)=l(lne,20)+cs1*l(lne,6)/2:l(nl,21)=l(lne,21)+sn1*l(lne,6)/2
lst$(nl)="":l(nl,0)=0:l(nl,1)=110:l(nl,17)=lne:l(nl,4)=lheight:l(nl,5)=lwth:l(nl,3)=l(lne,3):l(nl,7)=20:l(nl,6)=0
ddcode=1
aaa=l(lne,4)
xxx=aaa:xxx2=aaa:GOSUB subfractions:
llst$=subfract$:n4$=llst$+"x"
aaa=l(lne,5)
xxx=aaa:xxx2=aaa:GOSUB subfractions::llst$=subfract$
if l(lne,19)=102 then n4$=subfract$+" SLAB\"else n4$=n4$+subfract$+"\"+lst$(lne)+"\"

ddcode=0
aaa=l(lne,22)+l(lne,5)/2
xxx=aaa:xxx2=aaa:GOSUB subfractions::llst$=subfract$
n4$=n4$+"T.E. "+subfract$+"\"
aaa=l(lne,22)-l(lne,5)/2
xxx=aaa:xxx2=aaa:GOSUB subfractions::llst$=subfract$
lst$(nl)=n4$+"B.E. "+subfract$+"\"
return


putatends:
IF t=2 THEN l(nl,20)=l(nl,20)+(cs1*(6*one)):l(nl,21)=l(nl,21)+(sn1*(6*one))
IF t=3 THEN l(nl,20)=l(nl,20)+(cs1*(l(lne,6)-l(nl,22)-(6*one))):l(nl,21)=l(nl,21)+(sn1*(l(lne,6)-l(nl,22)-(6*one)))
RETURN
RtnDD:
IF l(lne,22)=0 THEN RETURN
GOSUB sncsn:
GOSUB nlplusone::GOSUB clearline:
l(nl,20)=l(lne,20):l(nl,21)=l(lne,21):l(nl,3)=l(lne,3)
lst$(nl)="":l(nl,0)=0:l(nl,1)=110:l(nl,17)=lne:l(nl,4)=lheight:l(nl,5)=lwth:l(nl,3)=l(lne,3)
aaa=l(lne,22)
xxx=aaa:xxx2=aaa:GOSUB assemblestring:
lst$(nl)=be$+lst$(nl)
GOSUB getstringlength:
wth=(l(lne,4)/2)-nst-(2*one)
wth2=(l(lne,5)/2)-lheight*(1.5*one)
l(nl,20)=l(nl,20)+(cs1*wth)
l(nl,21)=l(nl,21)+(sn1*wth)
l(nl,20)=l(nl,20)+(cs2*wth2)
l(nl,21)=l(nl,21)+(sn2*wth2)
l(nl,6)=0:l(nl,18)=16
RETURN
RtnAllign:
GOSUB inkey:
IF nnn<>0 THEN switch=1:xxx=nnn:GOSUB subfractions::lst$(lne)=lst$(lne)+subfract$:GOSUB updateupdate:

RETURN
Rtnminus:
IF l(lne,1)=110 THEN l(lne,8)=0:l(lne,13)=0:GOSUB updateupdate:
RETURN
Rtnplus:
nl=nl+1:l(nl,0)=0:l(nl,1)=110:l(nl,2)=0:l(nl,3)=0:l(nl,4)=3.5:l(nl,5)=2.5:l(nl,6)=0:l(nl,7)=27:l(nl,8)=8:l(nl,13)=18:l(nl,20)=l(lne,20)+3:l(nl,21)=l(lne,21)-3:lst$(nl)=lst$(lne)
sl%(nl)=sl%(0)
lne=nl
GOSUB updateupdate:

RETURN
Instring:
GOSUB inkey:
xxx=nnn:xxx2=nnn:GOSUB assemblestring::GOSUB updateupdate::GOTO strtput:
RETURN
clearstring:
lst$(lne)="":GOSUB updateupdate::GOTO strtput:
RETURN

Ce:
onl=nl
FOR nl=1 TO onl
IF l(nl,22)=0 THEN l(nl,20)=0:l(nl,21)=0
lst$(nl)="":l(nl,0)=0:l(nl,1)=110:l(nl,17)=lne:l(nl,4)=lheight:l(nl,5)=lwth
aaa=l(nl,14)
GOSUB stringnumber:
n30$=n3$
IF l(lne,15)>0 THEN n30$=n30$+CHR$(64+l(lne,15))
xxx=l(nl,22):xxx2=l(nl,22):GOSUB assemblestring:
IF l(nl,14)>0 THEN lst$(nl)=" "+n30$+"/"+lst$(nl) ELSE lst$(nl)="C.E.="+lst$(nl)
NEXT nl
nl=onl
RETURN
centerinlength:
GOSUB getstringlength:
l(nl,13)=((l(nl,6))-l(nl,22))/2
RETURN

centerxy:
GOSUB getstringlength:
v1=(l(nl,6)-l(nl,22))/2
l(nl,20)=l(nl,20)+(cs1*v1):l(nl,21)=l(nl,21)+(sn1*v1)
l(nl,13)=0
RETURN

leftxy:
IF reversit=1 THEN reversit=0:GOTO rightxy:
GOSUB getstringlength:
l(nl,20)=l(nl,20)+cs1*one:l(nl,21)=l(nl,21)+sn1*one
l(nl,13)=0
RETURN

rightxy:
IF reversit=1 THEN reversit=0:GOTO leftxy:
GOSUB getstringlength:
v1=l(nl,6)-(2*one)-l(nl,22)
l(nl,20)=l(nl,20)+(cs1*v1):l(nl,21)=l(nl,21)+(sn1*v1)
l(nl,13)=0
RETURN


clearline:
FOR ff1=0 TO 22:l(nl,ff1)=0:NEXT ff1:lst$(nl)="":lt$(nl)=""
if hdl&(nl)<>0 then kill picture hdl&(nl):hdl&(nl)=0
RETURN
assemblestring:
GOSUB subfractions:
lst$(nl)=subfract$
RETURN

getstringlength:
ns=LEN(lst$(nl)):nst=0
FOR ll=1 TO ns
m$=MID$(lst$(nl),ll,1)
c=ASC(m$):cc=0
IF m$="\" THEN nst=nst-.5:l(nl,22)=nst*l(nl,5):RETURN
IF ll<ns AND c=39 THEN mm$=MID$(lst$(nl),ll+1,1):cc=ASC(mm$)
IF cc=39 THEN ll=ll+1:c=33
IF c<45 THEN nst=nst-.5
IF c=39 THEN nst=nst-.5
IF c=59 THEN nst=nst-.5
nst=nst+1.5
NEXT ll
nst=nst-.5
l(nl,22)=nst*l(nl,5)
IF l(nl,22)<0 THEN l(nl,22)=0
RETURN
getstringlength2:
ns=LEN(lst$(lne)):nst=0
FOR ll=1 TO ns
m$=MID$(lst$(lne),ll,1)
c=ASC(m$):cc=0
IF m$="\" THEN nst=nst-.5:l(lne,22)=nst*l(lne,5):RETURN
IF ll<ns AND c=39 THEN mm$=MID$(lst$(lne),ll+1,1):cc=ASC(mm$)
IF cc=39 THEN ll=ll+1:c=33
IF c<45 THEN nst=nst-.5
IF c=39 THEN nst=nst-.5
IF c=59 THEN nst=nst-.5
nst=nst+1.5
NEXT ll
nst=nst-.5
l(lne,22)=nst*l(lne,5)
IF l(lne,22)<0 THEN l(lne,22)=0
RETURN
getstringlength3:
ns=LEN(llst$):nst=0
FOR ll=1 TO ns
m$=MID$(llst$,ll,1)
c=ASC(m$):cc=0
IF m$="\" THEN nst=nst-.5:RETURN
IF ll<ns AND c=39 THEN mm$=MID$(llst$,ll+1,1):cc=ASC(mm$)
IF cc=39 THEN ll=ll+1:c=33
IF c<45 THEN nst=nst-.5
IF c=39 THEN nst=nst-.5
IF c=59 THEN nst=nst-.5
nst=nst+1.5
NEXT ll
nst=nst-.5
RETURN

stpproc:
olne2=lne
lne=nl
GOSUB updateupdate:
GOSUB onlne::GOSUB toreturn:
lne=olne2
RETURN
stringnumber:
FOR n=1 TO 10
nnn=aaa/(10^n)
IF nnn<1 THEN nn=n:GOTO nxtn50:
NEXT n
nxtn50:
n3$=""
FOR n=1 TO nn
n2=INT(nnn*10+.0001)
n2$=CHR$(48+n2)
nnn=nnn*10-n2
n3$=n3$+n2$
NEXT n
RETURN
plotdimpts:
IF l(lne,1)=110 THEN RETURN
mmargin=1.66+((abs(l(lne,9))-1)/2)
IF l(lne,7)>5 THEN sectlength=l(lne,7) ELSE sectlength=s(2,l(lne,7))

IF l(lne,1)>59 THEN sectlength=l(lne,16)
length=l(lne,6)-l(lne,17)-l(lne,16)+.05
IF sectlength>0 THEN ndpts=int(length/sectlength)+1

IF l(lne,1)>59 THEN ndpts=1

IF l(lne,4)<4 THEN lvl(0)=0:lvl(1)=l(lne,4)/2+2:lvl(2)=-(l(lne,4)/2)-lheight-2:RETURN
lvl(0)=fix((l(lne,4)-mmargin)/(lheight+mmargin))

IF lvl(0)=0 THEN lvl(0)=1
IF lvl(0)>4 THEN lvl(0)=4
margin=(l(lne,4)-(lheight*lvl(0)))/(lvl(0)+1)
lvl(lvl(0)+1)=(l(lne,4)/2)+2:lvl(lvl(0)+2)=-(l(lne,4)/2)-lheight-2:lvl(lvl(0)+3)=lvl(lvl(0)+2)-lheight-2
IF lvl(0)>0 THEN FOR lvl=1 TO lvl(0):lvl(lvl)=-(l(lne,4)/2)+margin+((lvl-1)*(margin+lheight)):NEXT lvl:nlvls=lvl(0):lvl(0)=lvl(0)+2
lastline=lne
RETURN
DimParameters:
GOSUB sncsn:
IF dcode=0 THEN length=l(lne,17)
IF dcode=1 THEN length=l(lne,16)
IF dcode>1 THEN length=sectlength
RETURN
Resetpts:
reversit=0
GOSUB sncsn:
dist=0:dist2=0
IF dcode=0 THEN dist=0
IF dcode=1 THEN dist=l(lne,17)
IF dcode=2 THEN dist=l(lne,17)+l(lne,16)
IF dcode>2 THEN dist=l(lne,17)+l(lne,16)+((dcode-2)*sectlength)

l(nl,20)=l(lne,20)+(cs1*dist):l(nl,21)=l(lne,21)+(sn1*dist)
IF (l(lne,3)>90 AND l(lne,3)<=270) THEN GOSUB reversedirection:
IF lvl=0 THEN hi=-lheight/2 ELSE hi=lvl(lvl)
l(nl,20)=l(nl,20)+(cs2*hi):l(nl,21)=l(nl,21)+(sn2*hi)
RETURN


reversedirection:
reversit=1
l(nl,20)=l(nl,20)+(cs1*l(nl,6)):l(nl,21)=l(nl,21)+(sn1*l(nl,6))
l(nl,3)=l(lne,3)+180:IF l(nl,3)>=360 THEN l(nl,3)=l(nl,3)-360
cs1=COS(gpi#*l(nl,3)):sn1=-SIN(gpi#*l(nl,3)):cs2=COS(gpi#*(l(nl,3)+90)):sn2=-SIN(gpi#*(l(nl,3)+90))
RETURN
reversedirection2:
l(nl,20)=l(nl,20)+(COS(gpi#*l(nl,3))*l(nl,6)):l(nl,21)=l(nl,21)+(-SIN(gpi#*l(nl,3))*l(nl,6))
l(nl,3)=l(nl,3)+180:IF l(nl,3)>=360 THEN l(nl,3)=l(nl,3)-360
RETURN

fillnewline:
GOSUB nlplusone:
GOSUB clearline:
GOSUB sncsn:
sl%(nl)=sl%(0)
lst$(nl)=llst$:l(nl,0)=0:l(nl,1)=110:l(nl,17)=lne:l(nl,4)=lheight
l(nl,5)=lwth:l(nl,3)=l(lne,3):l(nl,6)=length

RETURN



return
Rtn10:
ON itemnum GOTO Rtn1001:,Rtn1002:,Rtn1003:,Rtn1004:,Rtn1005:,Plotfiles:,Plotgrids:,PltLnTy:,Custpens:,HrsSum:
Rtn1001:
locate 1,5:
INPUT "Paper length";paperlength
INPUT "Paper width";paperwidth
INPUT "Left Margin";leftmargin
INPUT "right Margin";rightmargin
INPUT "top Margin";topmargin
INPUT "bottom Margin";bottommargin
Rtn1001a:

papersc=12/(ssc*1.5)
drawinglength=paperlength-leftmargin-rightmargin
drawingwidth=paperwidth-topmargin-bottommargin
pspx1=(paperlength-leftmargin)/papersc
pspy1=(paperwidth-topmargin)/papersc
pspx2=(drawinglength)/papersc
pspy2=(drawingwidth)/papersc
win(0,0)=0
win(0,1)=0
win(0,2)=drawinglength*1016
win(0,3)=drawingwidth*1016
win(0,4)=0
win(0,5)=0
win(0,6)=pspx2
win(0,7)=pspy2

RETURN
Rtn1002:
paperlength=48:paperwidth=36:leftmargin=1.25:rightmargin=1.25:topmargin=.625:bottommargin=.625:GOTO Rtn1001a:
MENU 10,oitem10,1:MENU 10,itemnum,2:oitem10=itemnum
RETURN
Rtn1003:
paperlength=42:paperwidth=30:leftmargin=1.25:rightmargin=1.25:topmargin=.625:bottommargin=.625:GOTO Rtn1001a:
MENU 10,oitem10,1:MENU 10,itemnum,2:oitem10=itemnum
RETURN
Rtn1004:
paperlength=11:paperwidth=17:leftmargin=1.25:rightmargin=1.25:topmargin=.625:bottommargin=.625:GOTO Rtn1001a:
MENU 10,oitem10,1:MENU 10,itemnum,2:oitem10=itemnum
RETURN
Rtn1005:
paperlength=8.5:paperwidth=11:leftmargin=1.25:rightmargin=1.25:topmargin=.625:bottommargin=.625:GOTO Rtn1001a:
MENU 10,oitem10,1:MENU 10,itemnum,2:oitem10=itemnum
RETURN
Plotfiles:

locate 1,5
INPUT "dash line scale";ltscale:IF ltscale<1 THEN ltscale=1
pagon=0
input "All Piping Black=2";plotout
if plotout<>2 then plotout=1
ogFilename$=gFilename$:oVolRefNum%=VolRefNum%
gFilename$ = FILES$ (_fOpen, "TEXT", , VolRefNum%)
if gFilename$="" then gFilename$ = FILES$ (_fsave, "TEXT", , VolRefNum%)
if gFilename$="" then gFilename$=ogFilename$:VolRefNum%=oVolRefNum%:return

pfilename$=gFileName$+".dxf"
oPEN "O",1, pFilename$,,VolRefNum%
locate 0,10
GOSUB HEADTABLE:
PRINT #1, 0
PRINT #1, "SECTION"
PRINT #1,  2
PRINT #1, "ENTITIES"
savelne=lne
l(nl+1,20)=0:l(nl+1,21)=0
'gosub selectpens:
gosub newclip:
layername$="0"
flp=0
for lne=1 to nl
if l(lne,21)>flp then flp=l(lne,21)
next lne
flp=flp*1.25
for lne=1 to nl
if l(lne,1)=9999 then gosub newlayer:
c$=inkey$:if c$="q" then goto nxtpltfiles:
fpt=1
pltcde=2:pltvle=.5
gpen=sl%(lne):thick=defpen(gpen,4)
IF (l(lne,20)>0 AND l(lne,21)>0 AND l(lne,19)>=0) THEN GOSUB draw:
next lne
nxtpltfiles:

PRINT #1, 0
PRINT #1, "ENDSEC"
PRINT #1, 0
PRINT #1,  "EOF"
CLOSE #1

plotout=0

PRINT "***THIS PLOT IS FINISHED***"
RETURN
newclip:
for lne=1 to nl
if l(lne,1)=9999 then l(lne,19)=0
next lne
locate 1,1
input "skip clipwindows=0";a:if a=0 then return
for lne=1 to nl
if l(lne,1)=9999 then print lne;" ";lst$(lne);:input l(lne,19)
next lne

for lne=1 to nl
if l(lne,1)=9999 then print l(lne,19)
next lne

return

newlayer:
if lst$(lne)="" then return
layername$=lst$(lne)
print lne;layername$;l(lne,19)
if l(lne,19)>9 then l(lne,19)=0
clpwin=l(lne,19):l(lne,19)=0

return
selectpens:
FOR ll=1 TO nl
sl%(ll)=defpen(7,2)
if l(ll,1)=101 or l(ll,1)=107 or l(ll,1)=112 or l(ll,1)=113 or l(ll,1)=116 then sl%(ll)=defpen(1,2)
if l(ll,1)=102 or l(ll,1)=103 or l(ll,1)=104 or l(ll,1)=120 or l(ll,1)=128 then sl%(ll)=defpen(2,2)
if l(ll,1)=128 then sl%(ll)=defpen(4,2)
if l(ll,1)=105 or l(ll,1)=114 or l(ll,1)=115 then sl%(ll)=defpen(5,2)
if l(ll,1)=106 or l(ll,1)=109 or l(ll,1)=121 or l(ll,1)=122 or l(ll,1)=123 or l(ll,1)=124 then sl%(ll)=defpen(6,2)
if l(ll,19)>0 then gosub returnpen::sl%(ll)=defpen(gpen,3)

NEXT ll
return
HEADTABLE:
PRINT #1, 0
PRINT #1, "SECTION"
PRINT #1,  2
PRINT #1, "HEADER"
PRINT #1, 9
PRINT #1, "$UCSNAME"
PRINT #1, 2
PRINT #1, "UPPERLEFT"
PRINT #1, 9
PRINT #1, "$UCSORG"
PRINT #1, 10
PRINT #1, 0#
PRINT #1, 20
PRINT #1, 0#
PRINT #1, 30
PRINT #1, 0#
PRINT #1, 9
PRINT #1, "$UCSXDIR"
PRINT #1, 10
PRINT #1, 1#
PRINT #1, 20
PRINT #1, 0#
PRINT #1, 30
PRINT #1, 0#
PRINT #1, 9
PRINT #1, "$LTSCALE"
PRINT #1, 40
PRINT #1, ltscale
PRINT #1, 9
PRINT #1, "$UCSYDIR"
PRINT #1, 10
PRINT #1, 0#
PRINT #1, 20
PRINT #1, -1#
PRINT #1, 30
PRINT #1, .0000000000000003#
PRINT #1, 0
PRINT #1, "ENDSEC"

PRINT #1, 0
PRINT #1, "SECTION"
PRINT #1,  2
PRINT #1, "TABLES"
PRINT #1, 0
PRINT #1, "TABLE"
PRINT #1, 2
PRINT #1, "LTYPE"
PRINT #1, 70
PRINT #1, 3
PRINT #1, 0
PRINT #1, "LTYPE"
PRINT #1, 2
PRINT #1, "CONTINUOUS"
PRINT #1, 70
PRINT #1, 64
PRINT #1, 3
PRINT #1, "SOLID LINE"
PRINT #1, 72
PRINT #1, 65
PRINT #1, 73
PRINT #1, 0
PRINT #1, 40
PRINT #1, 0#
PRINT #1, 0
PRINT #1, "LTYPE"
PRINT #1, 2
PRINT #1, "CENTER"
PRINT #1, 70
PRINT #1, 64
PRINT #1, 3
PRINT #1, "____ _ ____ _ ____ _ ____ _ ____ _ ____ _ ____"
PRINT #1, 72
PRINT #1, 65
PRINT #1, 73
PRINT #1, 4
PRINT #1, 40
PRINT #1, 20#
PRINT #1, 49
PRINT #1, 1.25
PRINT #1, 49
PRINT #1, -.25
PRINT #1, 49
PRINT #1, .25
PRINT #1, 49
PRINT #1, -.25
PRINT #1, 0
PRINT #1, "LTYPE"
PRINT #1, 2
PRINT #1, "DASHED"
PRINT #1, 70
PRINT #1, 64
PRINT #1, 3
PRINT #1, " _ _ _"
PRINT #1, 72
PRINT #1, 65
PRINT #1, 73
PRINT #1, 2
PRINT #1, 40
PRINT #1, 2
PRINT #1, 49
PRINT #1, 1
PRINT #1, 49
PRINT #1, -1

PRINT #1, 0
PRINT #1, "ENDTAB"

PRINT #1, 0
PRINT #1, "ENDSEC"

RETURN



gplotnames:
for i=1 to 50
filename$(i) = FILES$ (_fOpen, "TEXT", , VolRefNum%)
filenum(i)=VolRefNum%


if filenum(i)=0 then tfiles=i-1:return

next i
RETURN

Plotgrids:
locate 1,5:
INPUT "window>0 enter 0 to erase";win
IF win=0 THEN FOR i=1 TO 9:FOR ii=0 TO 7:win(i,ii)=0:NEXT ii:NEXT i:RETURN
Cursor 2
color win
gosub groupem:
call moveto(xpt1#,ypt1#):call lineto(xpt2#,ypt2#):call lineto(xpt3#,ypt3#):call lineto(xpt4#,ypt4#):call lineto(xpt1#,ypt1#)
win(win,0)=xpt1#*papersc*1016
win(win,2)=xpt3#*papersc*1016
win(win,1)=ypt1#*papersc*1016
win(win,3)=ypt3#*papersc*1016
win(win,4)=xpt1#
win(win,6)=xpt3#
win(win,5)=ypt1#
win(win,7)=ypt3#
PRINT win(1,0);win(1,1);win(1,2);win(1,3)
gpen=7:gosub returnpen2:
return
Selpens:
return
PltLnTy:
locate 1,5:
INPUT "Pattern number -6 to +6";pltcde
INPUT "Pattern Length (optional=0)";pltvle

RETURN


Custpens:
locate 5,1
input col
if col=0 or col>19 then return
print "screen color =";defpen(col,0);" line width =";defpen(col,1);" autocad color=";defpen(col,2)

input "screen color";defpen(col,0)
input "pen width";defpen(col,1)
input "autocad color";defpen(col,2)
print "screen color =";defpen(col,0);" line width =";defpen(col,1);" autocad color=";defpen(col,2)

return
HrsSum:
locate 5,1:input "list";llst$
input "report";answer

if answer=2 then goto HrsSum2:
if answer=3 then goto HrsSum3:

nl2=nl
nl=nl+1:gosub clearline::l(nl,4)=l(lne,4):l(nl,5)=l(lne,5):l(nl,7)=l(lne,7):l(nl,10)=l(lne,7):lst$(nl)=llst$
for ll=lne+1 to nl2
if l(nl,4)=l(ll,4) and l(nl,5)=l(ll,5) and lst$(nl)=lst$(ll) then l(nl,11)=l(ll,7) else l(nl,12)=l(nl,11)-l(nl,10):nl=nl+1:gosub clearline::l(nl,4)=l(ll,4):l(nl,5)=l(ll,5):l(nl,10)=l(ll,7):lst$(nl)=llst$
next ll
bl=nl2+1
return
HrsSum2:
for ll=bl to nl:sl%(ll)=1:next ll
nl2=nl
for ll=bl to nl2
if sl%(ll)=1 then nl=nl+1:gosub clearline::lst$(nl)=lst$(ll):l(nl,12)=0:gosub HrsSum2b:

next ll
bl=nl2+1
return
HrsSum2b:
for ll2=bl to nl2
if sl%(ll2)=1 then if lst$(nl)=lst$(ll2) then if l(ll2,12)>0 then l(nl,12)=l(nl,12)+l(ll2,12):sl%(ll2)=0
next ll2

return
HrsSum3:

ogFilename$=gFilename$:oVolRefNum%=VolRefNum%
gFilename$ = FILES$ (_fOpen, "TEXT", , VolRefNum%)
if gFilename$=""  then gFilename$ = FILES$ (_fsave, "TEXT", , VolRefNum%)
if gFilename$=""  then gFilename$=ogFilename$:VolRefNum%=oVolRefNum%:return
OPEN "O",1, gFileName$,,VolRefNum%

FOR rr=bl TO nl
if l(rr,12)>0 then print #1, lst$(rr);" ";l(rr,4);"/";l(rr,5);" "l(rr,12)
NEXT rr
CLOSE #1
beep
beep
gFilename$=ogFilename$:VolRefNum%=oVolRefNum%
return

return
'~'
sncsn3:
cs3=COS(gpi#*angle3):sn3=-SIN(gpi#*angle3)::cs4=sn3:sn4=-cs3
RETURN

sncsn2:
cs1=COS(gpi#*angle):sn1=-SIN(gpi#*angle):cs2=sn1:sn2=-cs1
RETURN
sncsn:
cs1=COS(gpi#*l(lne,3)):sn1=-SIN(gpi#*l(lne,3)):cs2=sn1:sn2=-cs1
cs01=COS(gpi#*l(l(lne,0),3)):sn01=-SIN(gpi#*l(l(lne,0),3)):cs02=sn01:sn02=-cs01

RETURN
draw:

if l(lne,1)=9991 then gosub substitutepen:
IF l(lne,1)>9990 THEN l(lne,20)=0:l(lne,21)=0:RETURN
link=l(lne,0)
ofpx=fpx:ofpy=fpy
GOSUB penpattern0:
IF l(lne,1)>199 THEN GOTO Piping:
IF l(lne,1)>99 THEN GOTO Arch:
IF l(lne,3)=360 THEN l(lne,3)=0
if l(lne,2)>10 then l(lne,2)=(l(lne,2)-10)*-1
dash=1:sndlne=0:sl=0:pass=0
difangle=0:swapit=0
GOSUB sncsn:
IF link>0 THEN difangle=l(lne,3)-l(link,3):IF ABS(difangle)>180 THEN difangle=difangle+(SGN(difangle*-1)*360)
GOSUB GetWidth:
GOSUB Getcode:
GOSUB plottype:
IF dct>0 AND l(lne,5)=0 THEN l(lne,5)=l(lne,4)

if l(lne,2)<>0 or (link>0 and l(link,2)<>0) then goto updown:
IF link>0 THEN GOSUB mainline1:
soundline:
IF abs(l(lne,9))>10 or abs(l(lne,9))=1 THEN dash=-1
ON code+1 GOSUB R0:,R1:,R2:,R3:,R4:,R5:,R6:,R6:,R6:,R9:,R9:,R9:,R9:,R13:,R14:,R15:,R16:,R17:,R18:,R19:
if pass=0 then if abs(l(lne,9))>1 then gosub dosoundline::IF sndlne<>0 THEN goto soundline:


IF dimtrack=1 THEN CIRCLE l(lne,20)/sc,l(lne,21)/sc,one*4
fpx=ofpx:fpy=ofpy
gpen=7:gosub returnpen2:
RETURN
substitutepen:
defpen(l(lne,2),0)=l(lne,3)
defpen(l(lne,2),1)=l(lne,4)
defpen(l(lne,2),2)=l(lne,5)

return
dosoundline:
IF abs(l(lne,9))>10 THEN sndlne=(abs(l(lne,9))-10)*sgn(l(lne,9)) else sndlne=l(lne,9)
sndlne=-sndlne/2
pass=1:w(0)=w(0)+sndlne:w(1)=w(1)+sndlne:d(0)=d(0)+sndlne:d(1)=d(1)+sndlne:dash=-1
if code<>17 then plottype(3)=0:plottype(1)=0
return


GetWidth:
wth=l(lne,4):w(1)=wth/2
dpth=l(lne,5):d(1)=dpth/2
length=l(lne,6)
IF dct=3 THEN length=length-l(lne,7)
IF link=0 THEN RETURN
wth0=l(link,4):w(0)=wth0/2
dpth0=l(link,5):d(0)=dpth0/2
length0=l(link,6)
offset1=w(0)-w(1)
offset2=d(0)-d(1)
RETURN

Getcode:
code=INT(l(lne,1)):subcode=INT((l(lne,1)-code)*10.001)
dct=INT(code/20):code=code-(dct*20)
code2=INT(l(l(lne,0),1))
dct2=INT(code2/20):code2=code2-(dct2*20)
IF l(lne,7)=0 AND (dct=1 OR dct=2) THEN l(lne,7)=2
endonly=0:if (code>0 and code<6) or code=13 then endonly=1

RETURN

plottype:
gpen=8:gosub returnpen:
if dct>0 and plotout=0 then gpen=2:gosub returnpen:
lh(0)=0:i=0

mf=-1
cpen=1
FOR t=1 TO 9:plottype(t)=1:NEXT t
IF lt$(lne)="" THEN RETURN

ns=LEN(lt$(lne))
FOR ll=1 TO ns
m$=MID$(lt$(lne),ll,1)
mnum=VAL(m$)
IF m$="d" THEN mf=0
IF m$="b" THEN mm$="":goto linehatch:
IF mnum>=0 AND mnum<=9 THEN plottype(mnum)=mf*cpen
NEXT ll
RETURN
linehatch:
ll=ll+1:if ll>ns then return
m$=MID$(lt$(lne),ll,1):if m$>="0" and m$<="9" then mm$=mm$+m$
if m$=" " or ll=ns then i=i+1:lh(i)=VAl(mm$):mm$="":lh(0)=lh(0)+1

goto linehatch:
return
linepatt:
IF dash=-1 THEN goto penpattern1:
IF plottype(i)=0 THEN pennpatt=0
IF plottype(i)=1 THEN GOSUB penpattern0:
IF plottype(i)=-1 THEN GOSUB penpattern1:
RETURN

Checklength:
IF l(lne,6)<l(lne,17) THEN l(lne,6)=l(lne,17):length=l(lne,6):IF dct=3 THEN l(lne,6)=l(lne,6)+l(lne,7)

RETURN


mainline1:
l(lne,20)=l(link,20)+(cs01*(l(link,6))):l(lne,21)=l(link,21)+(sn01*(l(link,6)))
l(lne,22)=l(link,22)+l(lne,15)
IF endonly=1 THEN RETURN
'IF abs(difangle)=180 THEN l(lne,20)=l(link,20):l(lne,21)=l(link,21):l(lne,13)=0
IF l(lne,13)<>0 THEN l(lne,20)=l(link,20)+(cs01*(l(lne,13))):l(lne,21)=l(link,21)+(sn01*(l(lne,13)))
IF abs(difangle)>.01 AND abs(difangle)<179.9 THEN l(lne,20)=l(lne,20)+(cs02*(wth0/2)*SGN(difangle)):l(lne,21)=l(lne,21)+(sn02*(wth0/2)*SGN(difangle)):l(lne,14)=0
IF l(lne,14)<>0 THEN l(lne,20)=l(lne,20)+cs02*l(lne,14):l(lne,21)=l(lne,21)+sn02*l(lne,14)


RETURN



findradd:
IF l(lne,8)>0 THEN radd1=l(lne,8):radd2=radd1
IF l(lne,8)=0 THEN IF (code=2 OR code=4) THEN radd1=6*one:radd2=radd1:IF l(lne,11)>0 THEN radd2=l(lne,11)
IF l(lne,8)=0 AND (code=3 OR code=5) THEN IF l(lne,2)<>0 OR l(link,2)<>0 THEN radd1=l(lne,5):radd2=radd1 ELSE radd1=l(lne,4):radd2=radd1


RETURN

endsection:
IF l(lne,6)<0 THEN l(lne,6)=0

hx=l(lne,20)+(cs1*l(lne,6)):hy=l(lne,21)+(sn1*l(lne,6))
IF l(lne,6)>l(lne,17) THEN dist=l(lne,6)-l(lne,17) ELSE dist=0
IF l(lne,7)<6 THEN interval=s(2,l(lne,7)) ELSE interval=l(lne,7)
nend=0
if lh(0)>0 then gosub hashcrosstie:
fpt=1:npt=2
WHILE dist>=interval
nend=nend+1
hx=hx-(cs1*interval):hy=hy-(sn1*interval)
GOSUB crosstie:
dist=dist-interval
WEND
l(lne,16)=dist
l(lne,18)=nend
IF l(lne,16)<0 THEN l(lne,16)=0:RETURN
IF l(lne,17)>0 THEN hx=hx-(cs1*l(lne,16)):hy=hy-(sn1*l(lne,16)):GOSUB crosstie:
RETURN

crosstie:
if lh(0)>0 then gosub hashcrosstie:
xpt(fpt)=hx+(cs2*w(1)):ypt(fpt)=hy+(sn2*w(1))
xpt(npt)=hx-(cs2*w(1)):ypt(npt)=hy-(sn2*w(1))
GOSUB plotff2:

RETURN
hashcrosstie:
gosub penpattern1:
dist2=nend*interval
for i=1 to lh(0) step 2
if dist2>lh(i) and dist2<lh(i+1) then goto penpattern0:
next i
return
numsection:
IF sndlne>0 THEN RETURN
dist=l(lne,6)-l(lne,17):IF dist<0 THEN l(lne,16)=0:l(lne,6)=l(lne,17):l(lne,18)=0:RETURN
IF l(lne,7)<6 THEN interval=s(2,l(lne,7)) ELSE interval=l(lne,7)
nend=0
WHILE dist>=interval
nend=nend+1
dist=dist-interval
WEND
l(lne,18)=nend
l(lne,16)=dist
RETURN


R0:
IF l(lne,6)<=0 THEN RETURN
IF pass>0 THEN GOTO R0s:
en=0
l(lne,8)=0:l(lne,17)=0:tlength=0
l(lne,17)=tlength:GOSUB Checklength:
hx(1)=l(lne,20):hy(1)=l(lne,21):hx(2)=hx(1)+(cs1*l(lne,6)):hy(2)=hy(1)+(sn1*l(lne,6))
R0s:
xpt(1)=hx(1)+(cs2*w(1)):ypt(1)=hy(1)+(sn2*w(1))
xpt(3)=hx(1)-(cs2*w(1)):ypt(3)=hy(1)-(sn2*w(1))
xpt(2)=hx(2)+cs2*w(1):ypt(2)=hy(2)+sn2*w(1)
xpt(4)=hx(2)-cs2*w(1):ypt(4)=hy(2)-sn2*w(1)
i=2:GOSUB linepatt:: fpt=1:npt=2:GOSUB plothash:
i=4:GOSUB linepatt:: fpt=3:npt=4:GOSUB plothash:
if sndlne<>0 then return
IF link>0 THEN IF dct2>0 AND dct>0 THEN fpt=1:npt=4:GOSUB R14a:
i=3:GOSUB linepatt:: fpt=1:npt=3:GOSUB plotff2:
i=1:GOSUB linepatt:: fpt=2:npt=4:GOSUB plotff2:
if link=0 THEN i=3:GOSUB linepatt:: fpt=1:npt=3:GOSUB plotff2:
i=5:GOSUB linepatt:: GOSUB endsection:
return
R1:

IF pass>0 THEN GOTO R1s:
hx(0)=l(lne,20):hy(0)=l(lne,21):l(lne,20)=l(lne,20)+cs2*l(lne,14):l(lne,21)=l(lne,21)+sn2*l(lne,14)

if code=1 then GOSUB tlength: else l(lne,17)=tlength
l(lne,17)=tlength:GOSUB Checklength:
hx(1)=l(lne,20):hy(1)=l(lne,21):hx(2)=hx(1)+(cs1*tlength):hy(2)=hy(1)+(sn1*tlength):hx(3)=hx(1)+(cs1*l(lne,6)):hy(3)=hy(1)+(sn1*l(lne,6))

R1s:
xpt(1)=hx(1)+(cs2*w(1)):ypt(1)=hy(1)+(sn2*w(1))
xpt(4)=hx(1)-(cs2*w(1)):ypt(4)=hy(1)-(sn2*w(1))
xpt(2)=hx(2)+cs2*w(1):ypt(2)=hy(2)+sn2*w(1)
xpt(5)=hx(2)-cs2*w(1):ypt(5)=hy(2)-sn2*w(1)
xpt(3)=hx(3)+cs2*w(1):ypt(3)=hy(3)+sn2*w(1)
xpt(6)=hx(3)-cs2*w(1):ypt(6)=hy(3)-sn2*w(1)
xpt(1)=hx(0)+(cs2*w(0)):ypt(1)=hy(0)+(sn2*w(0))
xpt(4)=hx(0)-(cs2*w(0)):ypt(4)=hy(0)-(sn2*w(0))
i=2:GOSUB linepatt:: fpt=1:npt=3:GOSUB plothash:
i=4:GOSUB linepatt:: fpt=4:npt=6:GOSUB plothash:
if sndlne<>0 then return
i=1:GOSUB linepatt:: fpt=3:npt=6:GOSUB plotff2:
if link=0 THEN i=3:GOSUB linepatt:: fpt=1:npt=4:GOSUB plotff2:
IF dct<>dct2 THEN npt=7:GOSUB roundtosquare:
i=5:GOSUB linepatt:: GOSUB endsection:


RETURN
roundtosquare:
onpt=npt

IF dct>dct2 THEN xpt(npt+1)=xpt(1):ypt(npt+1)=ypt(1):xpt(npt+3)=xpt(4):ypt(npt+3)=ypt(4):xpt(npt+2)=(xpt(2)+xpt(5))/2:ypt(npt+2)=(ypt(2)+ypt(5))/2
IF dct2>dct THEN xpt(npt+1)=xpt(2):ypt(npt+1)=ypt(2):xpt(npt+3)=xpt(5):ypt(npt+3)=ypt(5):xpt(npt+2)=(xpt(1)+xpt(4))/2:ypt(npt+2)=(ypt(1)+ypt(4))/2
fpt=npt+1:npt=npt+3:gosub plotff:
RETURN
tlength:
IF l(lne,8)>0 THEN tlength=l(lne,8):RETURN
IF ABS(offset2)>ABS(offset1) THEN offset=ABS(offset2):off1=15 ELSE offset=ABS(offset1):off1=14
IF offset>0 AND offset<=(10*one) THEN tlength=(18*one)
IF offset>(10*one) AND offset<=(14*one) THEN tlength=(24*one)
IF offset>(14*one) AND offset<=(21*one) THEN tlength=(36*one)
IF offset>(21*one) THEN tlength=(56*one)
IF offset>(21*one) AND offset<=(28*one) AND l(lne,off1)=0 THEN tlength=(24*one)
IF offset>(28*one) AND offset<=(42*one)  AND l(lne,off1)=0 THEN tlength=(36*one)
IF offset>(42*one)  AND l(lne,off1)=0 THEN tlength=(56*one)
return
plothash:
if lh(0)=0 or sndlne<>0 then goto plotff:
ofpt=fpt:onpt=npt
if npt-fpt>1 then npt=npt-1:gosub plotff2:
gosub penpattern1:
npt=onpt
fpt=npt-1:gosub plotff2:
gosub penpattern0:

for llh=1 to lh(0)
xpt(10+llh)=xpt(onpt)-cs1*lh(llh):ypt(10+llh)=ypt(onpt)-sn1*lh(llh)
if lh(llh)>l(lne,6) then xpt(10+llh)=xpt(onpt-1):ypt(10+llh)=ypt(onpt-1)
next llh
for llh=1 to lh(0) step 2
fpt=llh+10:npt=llh+10+1:gosub plotff:
next llh

return


R2:
IF pass>0 THEN GOTO R2s:
w(0)=w(0)/2

wth0=wth0/2
angle=l(lne,3)-l(link,3):IF ABS(angle)>180 THEN angle=angle+(SGN(angle*-1)*360)
sgna=SGN(angle)
l(lne,20)=l(lne,20)+(cs02*sgna*wth0/2)
l(lne,21)=l(lne,21)+(sn02*sgna*wth0/2)
R2s:
GOSUB R4:
RETURN

R3:
if l(lne,11)=0 then l(lne,11)=45
goto R5:
RETURN

R4:
IF ABS(difangle)=0 OR ABS(difangle)>=180 THEN GOTO R0:
en=4
IF pass>0 THEN GOTO R4s:
hx(1)=l(lne,20):hy(1)=l(lne,21)
GOSUB findradd:
angle=difangle
sgna=SGN(angle):angle2=angle
IF angle<>0 THEN GOSUB elength:
elength1=ttan1*wth3:elength2=ttan2*wth4
elength1=radd1+elength1
l(lne,17)=elength2+radd2:GOSUB Checklength:
l(lne,20)=l(lne,20)+(cs01*elength1):l(lne,21)=l(lne,21)+(sn01*elength1)
hx(2)=l(lne,20):hy(2)=l(lne,21)
hx(3)=l(lne,20)+(cs1*length)
hy(3)=l(lne,21)+(sn1*length)
ttan1=ttan1*sgna
R4s:
xpt(1)=hx(1)+(cs02*w(0))
ypt(1)=hy(1)+(sn02*w(0))
xpt(4)=hx(1)-(cs02*w(0))
ypt(4)=hy(1)-(sn02*w(0))
xpt(2)=hx(2)+(cs02*w(0))
ypt(2)=hy(2)+(sn02*w(0))
xpt(5)=hx(2)-(cs02*w(0))
ypt(5)=hy(2)-(sn02*w(0))

xpt(2)=xpt(2)-(cs01*ttan1*w(0))
ypt(2)=ypt(2)-(sn01*ttan1*w(0))
xpt(5)=xpt(5)+(cs01*ttan1*w(0))
ypt(5)=ypt(5)+(sn01*ttan1*w(0))
xpt(3)=hx(3)+(cs2*w(1))
ypt(3)=hy(3)+(sn2*w(1))
xpt(6)=hx(3)-(cs2*w(1))
ypt(6)=hy(3)-(sn2*w(1))
if swapit=1 then return
if sndlne<>0 and w(1)<>w(0) then gosub elength3:
IF code=2 then if sgna>0 THEN xpt(7)=xpt(5):ypt(7)=ypt(5):xpt(4)=xpt(5):ypt(4)=ypt(5) ELSE xpt(1)=xpt(2):ypt(1)=ypt(2)
i=2:GOSUB linepatt:: fpt=1:npt=3:GOSUB plothash:
i=4:GOSUB linepatt:: fpt=4:npt=6:GOSUB plothash:
if sndlne<>0 then return

i=1:GOSUB linepatt:: fpt=3:npt=6:GOSUB plotff2:

if l(lne,1)=4  AND ABS(difangle)>89.9 and abs(difangle)<90.1 and plottype(6)<>0 THEN npt=7:GOSUB turningveins:
i=5:GOSUB linepatt:: GOSUB endsection:

RETURN

elength3:
xpt1#=xpt(1):ypt1#=ypt(1):xpt4#=xpt(3):ypt4#=ypt(3)
xpt2#=xpt1#+cs01*10:ypt2#=ypt1#+sn01*10
xpt3#=xpt4#-cs1*10:ypt3#=ypt4#-sn1*10:
GOSUB elength2::xpt(2)=x#:ypt(2)=y#
xpt1#=xpt(4):ypt1#=ypt(4):xpt4#=xpt(6):ypt4#=ypt(6)
xpt2#=xpt1#+cs01*10:ypt2#=ypt1#+sn01*10
xpt3#=xpt4#-cs1*10:ypt3#=ypt4#-sn1*10:
GOSUB elength2::xpt(5)=x#:ypt(5)=y#
RETURN
elength:
IF link=0 THEN RETURN
angle0=ABS(angle)
wth3=wth0/2:wth4=wth/2
IF wth4=wth3 THEN ttan1=ABS(TAN(gpi#*(angle0/2))):ttan2=ttan1:return
xpt=100:ypt=100
xpt1#=xpt#:ypt1#=ypt#+wth3:xpt2#=xpt1#+10:ypt2#=ypt1#
xpt4#=xpt#-COS(gpi#*(angle0+90))*wth4
ypt4#=ypt#+SIN(gpi#*(angle0+90))*wth4
xpt3#=xpt4#-COS(gpi#*angle0)*(10*one)
ypt3#=ypt4#+SIN(gpi#*angle0)*(10*one)
gosub elength2:
ttan1#=(SQR(ABS(((xpt1#-xpt3#)^2)+((ypt1#-ypt3#)^2)))/wth3)
ttan2#=(SQR(ABS(((xpt4#-xpt3#)^2)+((ypt4#-ypt3#)^2)))/wth4)

RETURN

turningveins:
onpt=npt
ntv=INT(l(lne,4)/(4*one))+1
fpt=onpt+1:npt=onpt+3
FOR t=1 TO ntv-1
xpt=xpt(2)+(xpt(5)-xpt(2))*(t*(1/ntv))
ypt=ypt(2)+(ypt(5)-ypt(2))*(t*(1/ntv))

xpt(onpt+2)=xpt:ypt(onpt+2)=ypt
xpt(onpt+1)=xpt-cs01*(3*one)
ypt(onpt+1)=ypt-sn01*(3*one)
xpt(onpt+3)=xpt+cs1*(3*one)
ypt(onpt+3)=ypt+sn1*(3*one)

gosub plotff:
NEXT t
RETURN
R5:
IF ABS(difangle)=0 OR ABS(difangle)>=180 THEN GOTO R0:
IF pass>0 THEN GOTO R5s:
en=4
angle=difangle
sgna=SGN(angle):angle2=angle
radd=l(lne,8):IF radd=0 THEN radd=l(lne,4)
radd0=radd+wth0/2
radd1=radd+wth/2
cx1=l(lne,20)+(cs02*sgna*radd0):cy1=l(lne,21)+(sn02*sgna*radd0)

cx2=cx1-(cs02*sgna*radd):cy2=cy1-(sn02*sgna*radd)
cx2=cx2+(cs01*radd):cy2=cy2+(sn01*radd)

IF sgna>0 THEN sa1=l(link,3)+270 ELSE sa1=l(link,3)+90
ea1=sa1+angle
angle3=sa1:gosub sncsn3:
hx(1)=cx1+cs3*radd0:hy(1)=cy1+sn3*radd0
angle3=ea1:gosub sncsn3:
hx(3)=cx1+cs3*radd1:hy(3)=cy1+sn3*radd1

xpt1#=hx(1):ypt1#=hy(1):xpt2#=xpt1#+(cs01*10):ypt2#=ypt1#+(sn01*10)
xpt4#=hx(3):ypt4#=hy(3):xpt3#=xpt4#+(cs1*10):ypt3#=ypt4#+(sn1*10)
GOSUB elength2::dx2=hx(1)-xpt3#:dy2=hy(1)-ypt3#:elength(0)=SQR(dx2^2+dy2^2)
dx2=hx(3)-xpt3#:dy2=hy(3)-ypt3#:elength(1)=SQR(dx2^2+dy2^2)
hx(2)=xpt3#:hy(2)=ypt3#:l(lne,17)=elength(1):IF l(lne,6)<l(lne,17) THEN l(lne,6)=l(lne,17)
hx(4)=hx(2)+(cs1*l(lne,6)):hy(4)=hy(2)+(sn1*l(lne,6))
l(lne,20)=hx(2):l(lne,21)=hy(2)
plottype(3)=0
if sgna<0 then swap plottype(2),plottype(4)
R5s:
angle0=0
npt=0:fpt=1
stp=(angle2/9)
cx=cx1:cy=cy1:ea=ea1:sa=sa1:radius=radd0-w(0)
if lst$(lne)="sqr" then GOSUB R5b: else GOSUB R5a:
i=2:GOSUB linepatt::gosub plotff:
fpt=npt+1
if code=3 then angle0=l(lne,11)*sgna
IF w(0)<>w(1) THEN GOSUB R5d: ELSE cx=cx1:cy=cy1:ea=ea1:sa=sa1:radius=radd0+w(0):if lst$(lne)="sqr" then GOSUB R5c: else GOSUB R5a:
i=4:GOSUB linepatt::gosub plotff:
xpt(1)=hx(3)+(cs2*w(1)):ypt(1)=hy(3)+(sn2*w(1))
xpt(3)=hx(3)-(cs2*w(1)):ypt(3)=hy(3)-(sn2*w(1))
xpt(2)=hx(4)+cs2*w(1):ypt(2)=hy(4)+sn2*w(1)
xpt(4)=hx(4)-cs2*w(1):ypt(4)=hy(4)-sn2*w(1)
i=2:gosub linepatt::fpt=1:npt=2:gosub plothash:
i=4:gosub linepatt::fpt=3:npt=4:gosub plothash:
if sndlne<>0 then return
i=1:GOSUB linepatt::fpt=2:npt=4:gosub plotff2:
i=5:GOSUB linepatt:: GOSUB endsection:
RETURN
R5a:
FOR aa=sa+angle0 TO ea STEP stp
npt=npt+1
xpt(npt)=cx+COS(gpi#*aa)*radius
ypt(npt)=cy-SIN(gpi#*aa)*radius
NEXT aa
npt=npt+1
xpt(npt)=cx+COS(gpi#*ea)*radius
ypt(npt)=cy-SIN(gpi#*ea)*radius

RETURN
R5b:

xpt1=cx+COS(gpi#*sa)*radius
ypt1=cy-SIN(gpi#*sa)*radius
xpt2=xpt1-COS(gpi#*l(l(lne,0),3))*radius
ypt2=ypt1+SIN(gpi#*l(l(lne,0),3))*radius


xpt4=cx+COS(gpi#*ea)*radius
ypt4=cy-SIN(gpi#*ea)*radius
xpt3=xpt4-COS(gpi#*l(lne,3))*radius
ypt3=ypt4+SIN(gpi#*l(lne,3))*radius
gosub elength2:
npt=npt+1
xpt(npt)=xpt4
ypt(npt)=ypt4
npt=npt+1
xpt(npt)=xpt3
ypt(npt)=ypt3
npt=npt+1
xpt(npt)=xpt1
ypt(npt)=ypt1


RETURN
R5c:
s2=radius-radd

npt=npt+1
n=npt
FOR aa=sa+angle0 TO ea STEP stp
npt=npt+1
xpt(npt)=cx2+COS(gpi#*aa)*s2
ypt(npt)=cy2-SIN(gpi#*aa)*s2
NEXT aa
npt=npt+1
xpt(npt)=xpt(npt-1)+COS(gpi#*l(lne,3))*radd
ypt(npt)=ypt(npt-1)-sin(gpi#*l(lne,3))*radd
xpt(n)=xpt(n+1)-COS(gpi#*l(l(lne,0),3))*radd
ypt(n)=ypt(n+1)+sin(gpi#*l(l(lne,0),3))*radd

RETURN

R5d:
radd3=radd0+w(0):radd4=radd1+w(1)
if radd3>radd4 then radd5=radd3 else radd5=radd4
xpt1=cx+COS(gpi#*sa)*radd3:ypt1=cy-sin(gpi#*sa)*radd3
xpt2=cx+COS(gpi#*ea)*radd4:ypt2=cy-sin(gpi#*ea)*radd4
dx2=xpt2-xpt1:dy2=ypt2-ypt1:GOSUB findangles10:
cx=(xpt1+xpt2)/2:cy=(ypt1+ypt2)/2
cx=cx+COS(gpi#*(angle+(sgna*90)))*radd5
cy=cy-SIN(gpi#*(angle+(sgna*90)))*radd5
dx2=xpt1-cx:dy2=ypt1-cy:GOSUB findangles10::sa=angle
dx2=xpt2-cx:dy2=ypt2-cy:GOSUB findangles10::ea=angle
angle=ea-sa:IF ABS(angle)>180 THEN angle=angle+(SGN(angle*-1)*360)
ea=sa+angle:stp=angle/9
radius=dpxy
GOSUB R5a:
RETURN


R6:
IF l(link,6)=0 AND link>0 THEN GOTO R6a:

IF pass>0 THEN GOTO R6s:
tlength=6*one
IF l(lne,8)>0 THEN tlength=l(lne,8)
l(lne,17)=tlength:GOSUB Checklength:
IF l(lne,11)=0 THEN tlength2=tlength ELSE tlength2=l(lne,11)
IF l(lne,11)<0 THEN tlength2=0
IF code=8 THEN change=3
IF code=6 THEN IF difangle>0 THEN change=1 ELSE change=2
IF code=7 THEN IF difangle>0 THEN change=2 ELSE change=1
hx(1)=l(lne,20):hy(1)=l(lne,21):hx(2)=hx(1)+(cs1*tlength):hy(2)=hy(1)+(sn1*tlength):hx(3)=hx(1)+(cs1*l(lne,6)):hy(3)=hy(1)+(sn1*l(lne,6))

R6s:

xpt(1)=hx(1)+(cs2*w(1)):ypt(1)=hy(1)+(sn2*w(1))
xpt(4)=hx(1)-(cs2*w(1)):ypt(4)=hy(1)-(sn2*w(1))
xpt(2)=hx(2)+cs2*w(1):ypt(2)=hy(2)+sn2*w(1)
xpt(5)=hx(2)-cs2*w(1):ypt(5)=hy(2)-sn2*w(1)
xpt(3)=hx(3)+cs2*w(1):ypt(3)=hy(3)+sn2*w(1)
xpt(6)=hx(3)-cs2*w(1):ypt(6)=hy(3)-sn2*w(1)

IF change=1 OR change=3 THEN xpt(1)=xpt(1)+cs2*tlength2:ypt(1)=ypt(1)+sn2*tlength2:xpt(7)=xpt(1):ypt(7)=ypt(1)
IF change=2 OR change=3 THEN xpt(4)=xpt(4)-cs2*tlength2:ypt(4)=ypt(4)-sn2*tlength2
i=2:GOSUB linepatt:: fpt=1:npt=3:GOSUB plothash:
i=4:GOSUB linepatt:: fpt=4:npt=6:GOSUB plothash:
if sndlne<>0 then return
i=1:GOSUB linepatt:: fpt=3:npt=6:GOSUB plotff2:
if link=0 then i=3:GOSUB linepatt:: fpt=1:npt=4:GOSUB plotff2:
'IF l(lne,1)=4  AND ABS(difangle)=90 and plottype(6)<>0 THEN GOSUB turningveins:
IF dct2>0 AND dct>0 THEN fpt=1:npt=4:GOSUB R14a:

IF sndlne=0 THEN GOSUB endsection:

RETURN
R6a:
tlength=6*one
IF l(lne,8)>0 THEN tlength=l(lne,8)
l(lne,17)=tlength:GOSUB Checklength:

IF pass=0 THEN hx(1)=l(lne,20):hy(1)=l(lne,21):hx(2)=hx(1)+(cs1*tlength):hy(2)=hy(1)+(sn1*tlength):hx(3)=hx(1)+(cs1*l(lne,6)):hy(3)=hy(1)+(sn1*l(lne,6))
xpt(1)=hx(1)+(cs2*w(1)):ypt(1)=hy(1)+(sn2*w(1))
xpt(4)=hx(1)-(cs2*w(1)):ypt(4)=hy(1)-(sn2*w(1))
xpt(2)=hx(2)+cs2*w(1):ypt(2)=hy(2)+sn2*w(1)
xpt(5)=hx(2)-cs2*w(1):ypt(5)=hy(2)-sn2*w(1)
xpt(3)=hx(3)+cs2*w(1):ypt(3)=hy(3)+sn2*w(1)
xpt(6)=hx(3)-cs2*w(1):ypt(6)=hy(3)-sn2*w(1)

xpt(1)=l(link,20)+cs02*w(0):ypt(1)=l(link,21)+sn02*w(0)
xpt(4)=l(link,20)-cs02*w(0):ypt(4)=l(link,21)-sn02*w(0)
IF soundlne=0 THEN IF dct<>dct2 THEN GOSUB roundtosquare:

RETURN




R9:
IF pass>0 THEN GOTO R9s:
wth3=l(lne,4)/2
tlength=8*one
IF l(lne,8)<>0 THEN tlength=ABS(l(lne,8)*2)

l(lne,17)=tlength:GOSUB Checklength:
hx(4)=l(lne,20)+cs1*tlength/2
hy(4)=l(lne,21)+sn1*tlength/2


R9s:
gosub sncsn:
IF l(lne,6)>0 THEN gosub R9sa:

IF sndlne=0 THEN GOSUB Calculatestaff::i0=0
RETURN
R9sa:

IF pass=0 THEN hx(1)=l(lne,20):hy(1)=l(lne,21):hx(2)=hx(1)+(cs1*tlength):hy(2)=hy(1)+(sn1*tlength):hx(3)=hx(1)+(cs1*l(lne,6)):hy(3)=hy(1)+(sn1*l(lne,6))
xpt(1)=hx(1)+(cs2*w(1)):ypt(1)=hy(1)+(sn2*w(1))
xpt(4)=hx(1)-(cs2*w(1)):ypt(4)=hy(1)-(sn2*w(1))
xpt(2)=hx(2)+cs2*w(1):ypt(2)=hy(2)+sn2*w(1)
xpt(5)=hx(2)-cs2*w(1):ypt(5)=hy(2)-sn2*w(1)
xpt(3)=hx(3)+cs2*w(1):ypt(3)=hy(3)+sn2*w(1)
xpt(6)=hx(3)-cs2*w(1):ypt(6)=hy(3)-sn2*w(1)
IF sndlne<>0 THEN xpt(1)=xpt(2):ypt(1)=ypt(2):xpt(4)=xpt(5):ypt(4)=ypt(5)
i=2:GOSUB linepatt:: fpt=1:npt=3:GOSUB plothash:
i=4:GOSUB linepatt:: fpt=4:npt=6:GOSUB plothash:
if sndlne<>0 then return

i=1:GOSUB linepatt:: fpt=3:npt=6:GOSUB plotff2:
IF dct2>0 AND dct>0 THEN fpt=1:npt=4:GOSUB R14a:

if link=0 THEN i=3:GOSUB linepatt:: fpt=1:npt=4:GOSUB plotff2:
i=5:GOSUB endsection:
return
Calculatestaff:
i=6:gosub linepatt:
onpt=npt
IF l(lne,11)<>0 THEN angle=l(lne,3)+(l(lne,11)*90):GOSUB sncsn2:
s1=(wth3/3)
xpt(npt+1)=hx(4)-cs2*wth3
ypt(npt+1)=hy(4)-sn2*wth3
xpt(npt+2)=xpt(npt+1)+cs2*s1
ypt(npt+2)=ypt(npt+1)+sn2*s1
xpt(npt+3)=xpt(npt+2)+cs2*s1
ypt(npt+3)=ypt(npt+2)+sn2*s1
xpt(npt+4)=xpt(npt+3)+cs2*s1*2
ypt(npt+4)=ypt(npt+3)+sn2*s1*2
xpt(npt+5)=xpt(npt+4)+cs2*s1
ypt(npt+5)=ypt(npt+4)+sn2*s1
xpt(npt+6)=xpt(npt+5)+cs2*s1
ypt(npt+6)=ypt(npt+5)+sn2*s1


xpt(npt+6)=xpt(npt+6)+(cs2*(4*one))
ypt(npt+6)=ypt(npt+6)+(sn2*(4*one))
xpt(npt+1)=xpt(npt+1)-(cs2*(4*one))
ypt(npt+1)=ypt(npt+1)-(sn2*(4*one))
hx(5)=xpt(npt+1):hy(5)=ypt(npt+1)
hx(6)=xpt(npt+6):hy(6)=ypt(npt+6)
fpt=onpt+1:npt=onpt+2:gosub plotff:
fpt=onpt+3:npt=onpt+4:gosub plotff:
fpt=onpt+5:npt=onpt+6:gosub plotff:


IF code=9 THEN GOSUB firedamper:

IF code=10 THEN GOSUB motordamper:
IF (code=11 OR code=12) THEN GOSUB voldamper:
IF lst$(lne)<>"" THEN llst$=lst$(lne)
wth=3.5*one:dpth=(2.5*one)
ns=LEN(llst$):IF ns>1 THEN s4=dpth*2+.5 ELSE s4=dpth

angle=0:GOSUB sncsn2:
cx=cx-cs1*s4/2
cy=cy-sn1*s4/2
xpt=cx-cs2*wth/2
ypt=cy-sn2*wth/2
GOSUB text:

RETURN
firedamper:
npt=onpt
hx=hx(6)+(cs2*(10*one))
hy=hy(6)+(sn2*(10*one))
xpt(npt+1)=hx+cs1*(5*one)
ypt(npt+1)=hy+sn1*(5*one)
xpt(npt+2)=hx-cs1*(5*one)
ypt(npt+2)=hy-sn1*(5*one)
xpt(npt+3)=hx(6)
ypt(npt+3)=hy(6)
xpt(npt+4)=xpt(npt+1)
ypt(npt+4)=ypt(npt+1)

fpt=onpt+1:npt=onpt+4:gosub plotff:

npt=npt+3
cx=hx(6)+cs2*(7*one)
cy=hy(6)+sn2*(7*one)
llst$="F"
RETURN
motordamper:
sa=0:ea=360:stp=5

hx(6)=hx(6)+(cs2*(5*one))
hy(6)=hy(6)+(sn2*(5*one))
cx=hx(6)
cy=hy(6)
i0=6:w(6)=5*one
npt=onpt
GOSUB fcircle:

llst$="M"
RETURN
voldamper:
npt=onpt
xpt(npt+1)=hx(6):ypt(npt+1)=hy(6)
xpt(npt+2)=xpt(npt+1)+cs1*(6*one)
ypt(npt+2)=ypt(npt+1)+sn1*(6*one)
xpt(npt+3)=xpt(npt+2)-cs2*(2*one)
ypt(npt+3)=ypt(npt+2)-sn2*(2*one)
xpt(npt+4)=xpt(npt+3)-cs1*(3*one)
ypt(npt+4)=ypt(npt+3)-sn1*(3*one)
xpt(npt+5)=xpt(npt+4)+cs2*one
ypt(npt+5)=ypt(npt+4)+sn2*one
xpt(npt+6)=xpt(npt+5)-cs1*(3*one)
ypt(npt+6)=ypt(npt+5)-sn1*(3*one)

fpt=onpt+1:npt=onpt+6:gosub plotff:
cx=hx(6)+cs1*(3*one)
cy=hy(6)+sn1*(3*one)
cx=cx+cs2*(5*one)
cy=cy+sn2*(5*one)


IF code=12 THEN llst$=" ":RETURN
npt=onpt
xpt(npt+1)=hx(5):ypt(npt+1)=hy(5)
xpt(npt+2)=xpt(npt+1)-cs1*(6*one)
ypt(npt+2)=ypt(npt+1)-sn1*(6*one)
xpt(npt+3)=xpt(npt+2)+cs2*(2*one)
ypt(npt+3)=ypt(npt+2)+sn2*(2*one)
xpt(npt+4)=xpt(npt+3)+cs1*(3*one)
ypt(npt+4)=ypt(npt+3)+sn1*(3*one)
xpt(npt+5)=xpt(npt+4)-cs2*one
ypt(npt+5)=ypt(npt+4)-sn2*one
xpt(npt+6)=xpt(npt+5)+cs1*(3*one)
ypt(npt+6)=ypt(npt+5)+sn1*(3*one)
fpt=onpt+1:npt=onpt+6:gosub plotff:
llst$="vd"
RETURN
R13:
gosub tlength13:
'if l(lne,10)=1 then l(lne,8)=l(lne,6):l(lne,10)=0
IF l(lne,8)>0 THEN tlength=l(lne,8)
GOSUB R1:
RETURN
tlength13:
IF l(lne,8)>0 THEN tlength=l(lne,8):RETURN
offset1=abs(offset1)+abs(l(lne,14)):offset2=abs(offset2)+abs(l(lne,15))
IF offset1>offset2 THEN offset=offset1 ELSE offset=offset2
tlength=int(.866025403#*(offset/.5))+1
'IF (tlength/2)-INT(tlength/2)>0 THEN tlength=tlength+1
'IF tlength<12 THEN tlength=12


RETURN


R14:
IF pass>0 THEN GOTO R14s:
IF difangle=0 OR difangle=180 THEN RETURN
angle=difangle
angle=90-difangle
ttan#=TAN(gpi#*difangle)
ttan2#=(TAN(gpi#*(angle)))
elength#=((ttan2#)*w(1))

tlength=6*one:IF l(lne,8)>0 THEN tlength=l(lne,8)
l(lne,17)=abs(elength)+tlength:GOSUB Checklength:
length2=l(link,6)
R14s:
IF pass=0 THEN hx(1)=l(lne,20):hy(1)=l(lne,21):hx(2)=hx(1)+(cs1*l(lne,6)):hy(2)=hy(1)+(sn1*l(lne,6))
xpt(1)=hx(1)+(cs2*w(1)):ypt(1)=hy(1)+(sn2*w(1))
xpt(4)=hx(1)-(cs2*w(1)):ypt(4)=hy(1)-(sn2*w(1))
xpt(2)=hx(2)+cs2*w(1):ypt(2)=hy(2)+sn2*w(1)
xpt(3)=hx(2)-cs2*w(1):ypt(3)=hy(2)-sn2*w(1)

npt=5


xpt(1)=xpt(1)-cs1*elength
ypt(1)=ypt(1)-sn1*elength
xpt(4)=xpt(4)+cs1*elength
ypt(4)=ypt(4)+sn1*elength
xpt(5)=xpt(1):ypt(5)=ypt(1)
IF sndlne=0 THEN IF dct2>0 AND dct>0 THEN fpt=1:npt=4:GOSUB R14a:

i=2:GOSUB linepatt:: fpt=1:npt=2:GOSUB plothash:
i=4:GOSUB linepatt:: fpt=3:npt=4:GOSUB plothash:
if sndlne<>0 then return

i=1:GOSUB linepatt:: fpt=2:npt=3:GOSUB plotff2:
if link=0 THEN i=3:GOSUB linepatt:: fpt=1:npt=3:GOSUB plotff2:
i=5:GOSUB linepatt:: GOSUB endsection:

RETURN

R14a:
if abs(sin(.017453292*difangle))<.1 then return

GOSUB penpattern2::GOSUB plotff2::GOSUB penpattern0:
cx=(xpt(fpt)+xpt(npt))/2
cy=(ypt(fpt)+ypt(npt))/2
dx=ABS(xpt(npt)-xpt(fpt)):dy=ABS(ypt(npt)-ypt(fpt))
s1=SQR(ABS(dx^2+dy^2)):s1=s1/2
s2=s1
s3=SQR(ABS(s1^2+s2^2))
i0=0:
cx=cx+(cs02*s2*SGN(difangle))
cy=cy+(sn02*s2*SGN(difangle))
IF difangle>0 THEN angle=l(link,3)+270 ELSE angle=l(link,3)+90
IF angle>360 THEN angle=angle-360
stp=5
sa=angle-45:ea=sa+90
radius=s3
GOSUB farc:
RETURN

R15:
gpen=3
gosub returnpen:
if abs(l(lne,6))>200 then l(lne,6)=200
goto R16a:
RETURN


R16:
gpen=3
gosub returnpen:
IF l(lne,9)>1 THEN l(lne,9)=0

IF l(lne,6)=0 OR l(lne,6)>6 THEN l(lne,6)=6
IF l(lne,2)<>0 THEN RETURN
R16a:
length=l(lne,6)
IF length>0 THEN nt=2
IF length>2 THEN nt=4
IF length>4 THEN nt=6
if length>6 then nt=int(length/2)*2
stp=length/nt
wth3=w(1)-1
t2=nt
FOR t=0 TO nt
t2=t2+1
IF wth3=w(1) THEN wth3=w(1)-1 ELSE wth3=w(1)
hx=l(lne,20)+cs1*stp*t
hy=l(lne,21)+sn1*stp*t
xpt(t)=hx+cs2*wth3
ypt(t)=hy+sn2*wth3
xpt(t2)=hx-cs2*wth3
ypt(t2)=hy-sn2*wth3
fpt=t2:npt=t:GOSUB plotff2:
NEXT t
fpt=0:npt=nt:GOSUB plotff:
fpt=nt+1:npt=t2:GOSUB plotff:

en=0
RETURN
R17:
l(lne,8)=0:l(lne,17)=0:tlength=0
IF l(lne,6)<=0 THEN RETURN
l(lne,17)=tlength:GOSUB Checklength:
if pass>0 then hx(1)=hx(1)-cs1*sndlne:hy(1)=hy(1)-sn1*sndlne: hx(2)=hx(2)+cs1*sndlne:hy(2)=hy(2)+sn1*sndlne
IF pass=0 THEN hx(1)=l(lne,20):hy(1)=l(lne,21):hx(2)=hx(1)+(cs1*l(lne,6)):hy(2)=hy(1)+(sn1*l(lne,6))
xpt(1)=hx(1)+(cs2*w(1)):ypt(1)=hy(1)+(sn2*w(1))
xpt(4)=hx(1)-(cs2*w(1)):ypt(4)=hy(1)-(sn2*w(1))
xpt(2)=hx(2)+cs2*w(1):ypt(2)=hy(2)+sn2*w(1)
xpt(3)=hx(2)-cs2*w(1):ypt(3)=hy(2)-sn2*w(1)
i=2:GOSUB linepatt:: fpt=1:npt=2:GOSUB plotff:
i=4:GOSUB linepatt:: fpt=3:npt=4:GOSUB plotff:
i=1:GOSUB linepatt:: fpt=2:npt=3:GOSUB plotff2:
i=3:GOSUB linepatt:: fpt=1:npt=4:GOSUB plotff2:
return
R18:
en=0
l(lne,17)=l(lne,8):tlength=l(lne,8)
if l(lne,6)<l(lne,8) then l(lne,6)=l(lne,8)

IF l(lne,6)>0 THEN gosub R9sa:
return
IF pass=0 THEN hx(1)=l(lne,20):hy(1)=l(lne,21):hx(2)=hx(1)+(cs1*l(lne,6)):hy(2)=hy(1)+(sn1*l(lne,6))

GOSUB Checklength:
R18s:
xpt(1)=hx(1)+(cs2*w(1)):ypt(1)=hy(1)+(sn2*w(1))
xpt(3)=hx(1)-(cs2*w(1)):ypt(3)=hy(1)-(sn2*w(1))
xpt(2)=hx(2)+cs2*w(1):ypt(2)=hy(2)+sn2*w(1)
xpt(4)=hx(2)-cs2*w(1):ypt(4)=hy(2)-sn2*w(1)
i=2:GOSUB linepatt:: fpt=1:npt=2:GOSUB plothash:
i=4:GOSUB linepatt:: fpt=3:npt=4:GOSUB plothash:
if sndlne<>0 then return
IF link>0 THEN IF dct2>0 AND dct>0 THEN fpt=1:npt=4:GOSUB R14a:
i=3:GOSUB linepatt:: fpt=1:npt=3:GOSUB plotff2:
i=1:GOSUB linepatt:: fpt=2:npt=4:GOSUB plotff2:
if link=0 THEN i=3:GOSUB linepatt:: fpt=1:npt=3:GOSUB plotff2:
i=5:GOSUB linepatt:: GOSUB endsection:

return
R19:
en=0
l(lne,8)=0:l(lne,17)=0:tlength=0
IF l(lne,6)<=0 THEN RETURN
l(lne,17)=tlength:GOSUB Checklength:
IF pass=0 THEN hx(1)=l(lne,20):hy(1)=l(lne,21):hx(2)=hx(1)+(cs1*l(lne,6)):hy(2)=hy(1)+(sn1*l(lne,6))
xpt(1)=hx(1)+(cs2*w(1)):ypt(1)=hy(1)+(sn2*w(1))
xpt(4)=hx(1)-(cs2*w(1)):ypt(4)=hy(1)-(sn2*w(1))
xpt(2)=hx(2)+cs2*w(1):ypt(2)=hy(2)+sn2*w(1)
xpt(3)=hx(2)-cs2*w(1):ypt(3)=hy(2)-sn2*w(1)
xpt(5)=xpt(1):ypt(5)=ypt(1)
npt=5

IF sndlne=0 and link>0 THEN IF dct2>0 AND dct>0 THEN fpt=1:npt=4:GOSUB R14a:

i=2:GOSUB linepatt:: fpt=1:npt=2:GOSUB plotff:
i=4:GOSUB linepatt:: fpt=3:npt=4:GOSUB plotff:
IF sndlne=0 THEN i=1:GOSUB linepatt:: fpt=2:npt=3:GOSUB plotff2:
if link=0 then IF sndlne=0 THEN i=3:GOSUB linepatt:: fpt=1:npt=4:GOSUB plotff2:

return



updown:
if link>0 then gosub mainline:
hx(0)=l(lne,20):hy(0)=l(lne,21):npt=0
soundline2:
IF abs(l(lne,9))>10 or abs(l(lne,9))=1 THEN dash=-1

on code+1 gosub U0:,U1:,U4:,U4:,U4:,U4:,U6:,U6:,U6:,U9:,U9:,U9:,U9:,U13:,U14:,U15:,U16:,U17:,U18:,U19:
if pass=0 then if abs(l(lne,9))>1 then gosub dosoundline2::IF sndlne<>0 THEN goto soundline2:
pass=0
gpen=7:gosub returnpen2:
RETURN
dosoundline2:
IF abs(l(lne,9))>10 THEN sndlne=(abs(l(lne,9))-10)*sgn(l(lne,9)) else sndlne=l(lne,9)
sndlne=-sndlne/2
pass=1:w(0)=w(0)+sndlne:w(1)=w(1)+sndlne:d(0)=d(0)+sndlne:d(1)=d(1)+sndlne:dash=-1
return

U0:
l(lne,8)=0:l(lne,17)=0
if l(lne,2)=0 then goto R0:
if dct>0 then if w(1)<d(1) then radius=w(1) else radius=d(1)
i0=1:hx(i0)=l(lne,20):hy(i0)=l(lne,21):frame=dct:en=4:gosub frame:
IF sndlne=0 THEN GOSUB supret:
IF sndlne=0 THEN GOSUB numsection:
return
U1:
if l(lne,2)=0 then goto R0:
if pass>0 then goto U1s:
if code=1 then gosub tlength:
l(lne,17)=tlength:gosub checklength:
hx(0)=l(link,20):hy(0)=l(link,21)
hx(1)=l(lne,20):hy(1)=l(lne,21)
nn=0
U1s:
if dct>0 then if w(1)<d(1) then radius=w(1) else radius=d(1)

i0=1:frame=dct:en=4:gosub frame:
IF sndlne=0 THEN GOSUB supret:
if sndlne=0 then i=5:gosub linepatt::gosub roundtosquare2:
IF sndlne=0 THEN GOSUB numsection:

return
roundtosquare2:
if dct=0 and dct2=0 then goto roundtosquare3:
if dct>0 and dct2=0 then goto roundtosquare4:
return
roundtosquare3:
onpt=npt
i0=0:gosub f0b::npt=npt+5
i0=1:gosub f0b:
for t=1 to 4
fpt=onpt+t:npt=onpt+t+5:gosub plotff2:
next t
npt=onpt
return
roundtosquare4:
onpt=npt
i0=0:gosub f0b::npt=npt+5
i0=1:gosub f0d:
fpt=onpt+1:npt=onpt+6:gosub plotff2::fpt=onpt+2:gosub plotff2:
npt=onpt+7:gosub plotff2::fpt=onpt+3:gosub plotff2:
npt=onpt+8:gosub plotff2::fpt=onpt+4:gosub plotff2:
npt=onpt+9:gosub plotff2::fpt=onpt+1:gosub plotff2:
npt=onpt
return
U2:
goto U4:
return
U3:
goto U4:
return
U4:
if l(lne,2)=0 then goto U4a:
if pass>0 then goto U4s:
gosub findradd:
elength(1)=radd1+(dpth/2)
hx(2)=hx(0):hy(2)=hy(0)
hx(1)=hx(2)+cs1*radd1
hy(1)=hy(2)+sn1*radd1
hx(0)=hx(2)+cs1*elength(1)
hy(0)=hy(2)+sn1*elength(1)
if dct>0 then hx(1)=hx(0):hy(1)=hy(0)
l(lne,20)=hx(0):l(lne,21)=hy(0)
l(lne,17)=(dpth/2)+radd2
gosub checklength:
nn=0

U4s:
if dct>0 then if w(1)<d(1) then radius=w(1) else radius=d(1)

xpt(1)=hx(2)+cs2*w(0):ypt(1)=hy(2)+sn2*w(0)
xpt(4)=hx(2)-cs2*w(0):ypt(4)=hy(2)-sn2*w(0)
xpt(2)=hx(1)+cs2*w(0):ypt(2)=hy(1)+sn2*w(0)
xpt(3)=hx(1)-cs2*w(0):ypt(3)=hy(1)-sn2*w(0)
i=5:gosub linepatt::fpt=1:npt=2:gosub plotff2:
i=6:gosub linepatt::fpt=3:npt=4:gosub plotff2:

i0=0:w(0)=w(0):d(0)=d(1):frame=dct:gosub frame:

IF sndlne=0 THEN GOSUB supret:
IF sndlne=0 THEN GOSUB numsection:
return
U4a:
if pass>0 then goto U4sa:
gosub findradd::gosub checklength:
if difangle=0 then dpth4=dpth0/2 else dpth4=wth0/2
l(lne,17)=radd2+(dpth4)
if dct=0 then hx(1)=hx(0)+cs1*(dpth4):hy(1)=hy(0)+sn1*(dpth4) else hx(1)=hx(0):hy(1)=hy(0)
hx(2)=hx(0)+cs1*l(lne,6):hy(2)=hy(0)+sn1*l(lne,6)
U4sa:
xpt(1)=hx(1)+(cs2*w(1)):ypt(1)=hy(1)+(sn2*w(1))
xpt(3)=hx(1)-(cs2*w(1)):ypt(3)=hy(1)-(sn2*w(1))
xpt(2)=hx(2)+cs2*w(1):ypt(2)=hy(2)+sn2*w(1)
xpt(4)=hx(2)-cs2*w(1):ypt(4)=hy(2)-sn2*w(1)

i=2:GOSUB linepatt:: fpt=1:npt=2:GOSUB plothash:
i=4:GOSUB linepatt:: fpt=3:npt=4:GOSUB plothash:
if sndlne<>0 then return
i=1:GOSUB linepatt:: fpt=2:npt=4:GOSUB plotff2:
i=5:GOSUB linepatt:: GOSUB endsection:
return
U5:
goto U4:
return

U6:
if l(lne,2)=0 then goto U6a:
if pass>0 THEN GOTO U6s:
tlength=6*one
IF l(lne,8)>0 THEN tlength=l(lne,8)
l(lne,17)=tlength:GOSUB Checklength:

w(0)=w(1):d(0)=d(1):hx(1)=hx(0):hy(1)=hy(0)

d(0)=d(0)+tlength/2:if code=8 then d(0)=d(0)+tlength/2
if code=6 then hx(0)=hx(1)-cs1*(tlength/2):hy(0)=hy(1)-sn1*(tlength/2)
if code=7 then hx(0)=hx(1)+cs1*(tlength/2):hy(0)=hy(1)+sn1*(tlength/2)
if code=8 then hx(0)=hx(1):hy(0)=hy(1)
U6s:
if dct>0 then if w(1)<d(1) then radius=w(1) else radius=d(1)
i0=0:frame=dct:gosub frame:
i0=1:frame=dct:gosub frame:

IF sndlne=0 THEN GOSUB supret:
IF sndlne=0 THEN GOSUB numsection:
return
U6a:
if pass>0 THEN GOTO U6as:
tlength=6*one
IF l(lne,8)>0 THEN tlength=l(lne,8)
l(lne,17)=tlength:GOSUB Checklength:
U6as:
IF pass=0 THEN hx(1)=l(lne,20):hy(1)=l(lne,21):hx(2)=hx(1)+(cs1*l(lne,6)):hy(2)=hy(1)+(sn1*l(lne,6))
xpt(1)=hx(1)+(cs2*w(1)):ypt(1)=hy(1)+(sn2*w(1))
xpt(3)=hx(1)-(cs2*w(1)):ypt(3)=hy(1)-(sn2*w(1))
xpt(2)=hx(2)+cs2*w(1):ypt(2)=hy(2)+sn2*w(1)
xpt(4)=hx(2)-cs2*w(1):ypt(4)=hy(2)-sn2*w(1)

npt=5


i=2:GOSUB linepatt:: fpt=1:npt=2:GOSUB plothash:
i=4:GOSUB linepatt:: fpt=3:npt=4:GOSUB plothash:
if sndlne<>0 then return
i=1:GOSUB linepatt:: fpt=2:npt=4:GOSUB plotff2:
i=5:GOSUB linepatt:: GOSUB endsection:

return


U9:
if l(lne,2)=0 then goto R9:

IF pass>0 THEN GOTO U9s:
wth3=l(lne,4)/2
tlength=8*one
IF l(lne,8)<>0 THEN tlength=ABS(l(lne,8))

l(lne,17)=tlength:GOSUB Checklength:
hx(4)=l(lne,20)
hy(4)=l(lne,21)


U9s:

i0=1:hx(i0)=l(lne,20):hy(i0)=l(lne,21):frame=dct:en=4:gosub frame:
IF sndlne=0 THEN GOSUB supret:
IF sndlne=0 THEN GOSUB Calculatestaff::if l(lne,9)>1 then angle=l(lne,3):gosub sncsn2:
IF sndlne=0 THEN GOSUB numsection:
return
U13:
gosub tlength13:
goto U1:
return
U14:
goto U0:
return
U15:
gpen=3
goto U0:
return
U16:
gpen=3
goto U0:
return
U17:
goto U0:
return
U18:
goto U0:
return
U19:
goto U0:
return




mainline:

IF l(lne,2)=0 THEN goto mainline2:
IF l(lne,2)<>0 THEN IF l(link,2)=0  THEN gosub mainline3: ELSE gosub mainline4:

RETURN


mainline2:
l(lne,20)=l(link,20):l(lne,21)=l(link,21)
IF l(lne,14)<>0 THEN l(lne,20)=l(lne,20)+cs02*l(lne,14):l(lne,21)=l(lne,21)+sn02*l(lne,14)
IF l(lne,15)<>0 THEN l(lne,20)=l(lne,20)-cs01*l(lne,15):l(lne,21)=l(lne,21)-sn01*l(lne,15)
GOSUB Getcode:
IF code=0 OR (code>5 AND code<13) THEN RETURN
l(lne,20)=l(link,20):l(lne,21)=l(link,21)
radd=0
IF code=5 THEN radd=l(lne,5):IF l(lne,8)>0 THEN radd=l(lne,8)
IF code=4  OR code=2 OR code=3 THEN GOSUB findradd::radd=radd1
IF radd>0 THEN radd=radd+l(lne,5)/2
lgth=l(lne,22)-l(link,22)
IF lgth<0 THEN sgna=-1 ELSE sgna=1
l(link,2)=ABS(l(link,2))*sgna:lgth=ABS(lgth)
l(link,6)=lgth-radd
l(lne,13)=0
RETURN
mainline3:
l(lne,20)=l(link,20)+(cs01*(l(link,6))):l(lne,21)=l(link,21)+(sn01*(l(link,6))):l(lne,22)=l(link,22)
if endonly=1 THEN RETURN
l(lne,22)=l(link,22)+(l(link,5)/2*SGN(l(lne,2)))
IF l(lne,13)<>0 THEN l(lne,20)=l(link,20)+(cs01*(l(lne,13))):l(lne,21)=l(link,21)+(sn01*(l(lne,13)))
IF l(lne,14)<>0 THEN l(lne,20)=l(lne,20)+cs02*l(lne,14):l(lne,21)=l(lne,21)+sn02*l(lne,14)
RETURN
mainline4:
l(lne,20)=l(link,20):l(lne,21)=l(link,21):l(lne,22)=l(link,22)+((l(link,6))*SGN(l(link,2)))
IF l(lne,14)<>0 THEN l(lne,20)=l(lne,20)+cs2*l(lne,14):l(lne,21)=l(lne,21)+sn2*l(lne,14)
IF l(lne,15)<>0 THEN l(lne,20)=l(lne,20)-cs1*l(lne,15)*sgn(l(lne,2)):l(lne,21)=l(lne,21)-sn1*l(lne,15)*sgn(l(lne,2))
RETURN
frame:

aaa=l(lne,3)
ON frame+1 goto f0:,f1:,f1:,f2:,f2:,f3:
return
                                 
f0: 
npt=0                                                      
GOSUB f0b:
for i=1 to 4:xpt(300+i)=xpt(i):ypt(300+i)=ypt(i):next i

i=1:gosub linepatt::fpt=1:npt=2:gosub plotff2: 
i=2:gosub linepatt::fpt=2:npt=3:gosub plotff2:    
i=3:gosub linepatt::fpt=3:npt=4:gosub plotff2:    
i=4:gosub linepatt::fpt=1:npt=4:gosub plotff2:                           

RETURN
f0b:
hx=hx(i0)+cs1*d(i0):hy=hy(i0)+sn1*d(i0)
xpt(npt+1)=hx-cs2*w(i0)::ypt(npt+1)=hy-sn2*w(i0)
xpt(npt+2)=hx+cs2*w(i0)::ypt(npt+2)=hy+sn2*w(i0)
hx=hx(i0)-cs1*d(i0):hy=hy(i0)-sn1*d(i0)
xpt(npt+3)=hx+cs2*w(i0)::ypt(npt+3)=hy+sn2*w(i0)
xpt(npt+4)=hx-cs2*w(i0)::ypt(npt+4)=hy-sn2*w(i0)
xpt(npt+5)=xpt(npt+1):ypt(npt+5)=ypt(npt+1)

RETURN
f0c:
hx=hx(i0)+cs01*d(i0):hy=hy(i0)+sn01*d(i0)
xpt(npt+1)=hx-cs02*w(i0)::ypt(npt+1)=hy-sn02*w(i0)
xpt(npt+2)=hx+cs02*w(i0)::ypt(npt+2)=hy+sn02*w(i0)
hx=hx(i0)-cs01*d(i0):hy=hy(i0)-sn01*d(i0)
xpt(npt+3)=hx+cs02*w(i0)::ypt(npt+3)=hy+sn02*w(i0)
xpt(npt+4)=hx-cs02*w(i0)::ypt(npt+4)=hy-sn02*w(i0)
xpt(npt+5)=xpt(1):ypt(npt+5)=ypt(npt+1)

RETURN
f0d:
xpt(npt+1)=hx(i0)+cs1*d(i0):ypt(npt+1)=hy(i0)+sn1*d(i0)
xpt(npt+2)=hx(i0)+cs2*w(i0):ypt(npt+2)=hy(i0)+sn2*w(i0)
xpt(npt+3)=hx(i0)-cs1*d(i0):ypt(npt+3)=hy(i0)-sn1*d(i0)
xpt(npt+4)=hx(i0)-cs2*w(i0):ypt(npt+4)=hy(i0)-sn2*w(i0)
xpt(npt+5)=xpt(npt+1):ypt(npt+5)=ypt(npt+1)
RETURN
f1:

if w(i0)=d(i0) then goto f1a:

onpt=npt
q=0
npt=1
wth0#=w(i0)-radius
dpth0=d(i0)-radius
hx=hx(i0)+cs1*dpth0
hy=hy(i0)+sn1*dpth0
hx=hx+cs2*wth0#
hy=hy+sn2*wth0#
gosub f4:
q=1
npt=13

hx=hx-cs1*dpth0*2
hy=hy-sn1*dpth0*2
gosub f4:
q=2
npt=25
hx=hx-cs2*wth0#*2
hy=hy-sn2*wth0#*2
gosub f4:
q=3
npt=37
hx=hx+cs1*dpth0*2
hy=hy+sn1*dpth0*2
gosub f4:

xpt(48)=(xpt(2)+xpt(47))/2:ypt(48)=(ypt(2)+ypt(47))/2:xpt(1)=xpt(48):ypt(1)=ypt(48)
xpt(12)=(xpt(11)+xpt(14))/2:ypt(12)=(ypt(11)+ypt(14))/2:xpt(13)=xpt(12):ypt(13)=ypt(12)

xpt(24)=(xpt(23)+xpt(26))/2
ypt(24)=(ypt(23)+ypt(26))/2
xpt(25)=xpt(24):ypt(25)=ypt(24)

xpt(36)=(xpt(35)+xpt(38))/2
ypt(36)=(ypt(35)+ypt(38))/2
xpt(37)=xpt(36):ypt(37)=ypt(36)
i=1:gosub linepatt::fpt=1:npt=12:gosub plotff:
i=2:gosub linepatt::fpt=13:npt=24:gosub plotff:
i=3:gosub linepatt::fpt=25:npt=36:gosub plotff:
i=4:gosub linepatt::fpt=37:npt=48:gosub plotff:


return
f1a:
npt=0
radius=w(i0)
hx=hx(i0):hy=hy(i0)
for q=0 to 3
gosub f4:
next q
i=1:gosub linepatt::fpt=1:npt=10:gosub plotff:
i=2:gosub linepatt::fpt=11:npt=20:gosub plotff:
i=3:gosub linepatt::fpt=21:npt=30:gosub plotff:
i=4:gosub linepatt::fpt=31:npt=40:gosub plotff:


return
f2:
npt=0
FOR q=0 TO 3

FOR aa=0 TO 90 STEP 10
a=((q)*90)+aa
dpth4=COS(gpi#*a)*d(i0)
wth4=SIN(gpi#*a)*w(i0)
npt=npt+1
xpt(npt)=hx(i0)+COS(gpi#*aaa)*dpth4
ypt(npt)=hy(i0)-SIN(gpi#*aaa)*dpth4
xpt(npt)=xpt(npt)+COS(gpi#*(aaa+90))*wth4
ypt(npt)=ypt(npt)-SIN(gpi#*(aaa+90))*wth4
NEXT aa

xpt(301+q)=xpt(npt-4):ypt(301+q)=ypt(npt-4)
next q
i=1:gosub linepatt::fpt=1:npt=10:gosub plotff:
i=2:gosub linepatt::fpt=11:npt=20:gosub plotff:
i=3:gosub linepatt::fpt=21:npt=30:gosub plotff:
i=4:gosub linepatt::fpt=31:npt=40:gosub plotff:

RETURN


f3:
hx=hx(i0):hy=hy(i0):radius=w(i0)
FOR q=0 TO 3
GOSUB f4:
NEXT q
xpt(301)=xpt(305):ypt(301)=ypt(305)
RETURN

f4:

FOR aa=0 TO 90 STEP 10
npt=npt+1
a=((q)*90)+aa+aaa
xpt(npt)=hx+COS(gpi#*a)*radius
ypt(npt)=hy-SIN(gpi#*a)*radius
NEXT aa
xpt(301+q)=xpt(npt-5):ypt(301+q)=ypt(npt-5)

RETURN

supret:
supret=ABS(l(lne,2)):if supret=5 then return
cx=l(lne,20):cy=l(lne,21)

IF dct>0 THEN IF  (supret<5 OR supret>7) THEN npt=300
IF supret=3 OR supret=4 OR supret=7 OR supret=9 THEN GOSUB penpattern1:
IF supret=6 OR supret=7 THEN GOTO supret2:
IF supret<5 OR supret>7 THEN fpt=302:npt=304:GOSUB plotff2:
IF supret=2 OR supret=4 THEN fpt=301:npt=303:GOSUB plotff2:
IF supret>7 THEN xpt(305)=(xpt(302)+xpt(304))/2:ypt(305)=(ypt(302)+ypt(304))/2:fpt=301:npt=305:gosub plotff2:
GOSUB penpattern0:
RETURN
supret2:
onpt=npt
angle=l(lne,3)
depth=l(lne,5)/3
wdth=l(lne,4)/4
hx=cx+cs2*wdth
hy=cy+sn2*wdth
fpt=onpt+1:npt=onpt
q=1:GOSUB supret2a:
q=2:GOSUB supret2a:
npt=npt:GOSUB plotff:
hx=cx-cs2*wdth
hy=cy-sn2*wdth
fpt=onpt+1:npt=onpt
q=3:GOSUB supret2a:
q=4:GOSUB supret2a:
npt=npt:GOSUB plotff:
GOSUB penpattern0::npt=onpt
RETURN

supret2a:

FOR aa=0 TO 90 STEP 9
a=((q)*90)+aa
dpth4=COS(gpi#*a)*depth
wth4=SIN(gpi#*a)*wdth
npt=npt+1
xpt(npt)=hx+COS(gpi#*angle)*dpth4
ypt(npt)=hy-SIN(gpi#*angle)*dpth4
xpt(npt)=xpt(npt)+COS(gpi#*(angle+90))*wth4
ypt(npt)=ypt(npt)-SIN(gpi#*(angle+90))*wth4
NEXT aa

RETURN
'~'

Piping:

dct=l(lne,1)-200
if abs(l(lne,9))>29 and INSTR(1,lt$(lne),"defpipe")>0 and l(lne,0)=0 then ns=len(lt$(lne)):Phatch$(l(lne,9))=mid$(lt$(lne),9,ns-8)+"  ":Pcolor(l(lne,9))=val(mid$(lt$(lne),8,1))
if INSTR(1,lt$(lne),"defaultpipe")>0 then gosub DefaultPPat:
if l(lne,1)>228 then gpen=3:gosub returnpen::goto Pipingskip: 

link=l(lne,0):if link>0 and INSTR(1,lt$(lne),"newpipe")=0 then l(lne,9)=l(link,9)
n1=abs(l(lne,9)):if n1>50 then n1=0
if link>0 and l(link,1)<200 then l(lne,0)=0
gpen=Pcolor(n1)
if plotout>0 and gpen=2 then gpen=9
if plotout=2 then gpen=9

if plotout=0 and l(lne,4)=0 then gpen=1
gosub returnpen:
IF l(lne,2)>0 then gosub Piping2:
'if l(lne,4)=0 and link>0 then l(lne,4)=l(link,4)
l(lne,5)=l(lne,4)
l(lne,18)=0
wth0=l(link,4)/2:wth=l(lne,4)/2
if l(link,8)>0 then wth0=l(link,8)/2
if l(lne,8)>0 then wth=l(lne,8)/2
if wth0<1 then wth0=1
if wth<1 then wth=1
wth2=wth
w(0)=wth
sgna=sgn(l(lne,7))
if abs(l(lne,7))=4 then l(lne,7)=1/48*sgna
if abs(l(lne,7))=8 then l(lne,7)=1/96*sgna
if abs(l(lne,7))=10 then l(lne,7)=1/100*sgna
if abs(l(lne,7))=20 then l(lne,7)=1/200*sgna
if abs(l(lne,7))=30 then l(lne,7)=2/100*sgna
Pipingskip:
IF l(lne,9)>1 THEN GOSUB penpattern0: ELSE GOSUB penpattern1:
gosub sncsn:
ON dct+1 GOSUB P0:,P1:,P2:,P3:,P4:,P5:,P6:,P7:,P8:,P9:,P10:,P11:,P12:,P13:,P14:,P15:,P16:,P17:,P18:,P19:,P20:,P21:,P22:,P23:,P24:,P25:,P26:,P27:,P28:,P29:,P30:,P31:,P32:,P33:,P34:,P35:,P36:,P37:,P38:,P39:,P40:,P41:
if l(lne,1)<229 then if l(lne,10)>0 and plotout=0 then gosub drawblock:

fpx=ofpx:fpy=ofpy
RETURN
drawblock:
color 6
hx(0)=l(lne,20):hy(0)=l(lne,21)
xpt(1)=hx(0)+cs2*3:ypt(1)=hy(0)+sn2*3
xpt(2)=hx(0)-cs2*3:ypt(2)=hy(0)-sn2*3
xpt(2)=xpt(2)-cs1*3:ypt(2)=ypt(2)-sn1*3
xpt(3)=xpt(2)+cs1*6:ypt(3)=ypt(2)+sn1*6
xpt(4)=xpt(1):ypt(4)=ypt(1)
fpt=1:npt=4:gosub plotff:
return
Piping2:
if l(lne,1)=209 then lst$(lne)=" W.C."
if l(lne,2)=1 then lst$(lne)=" W.C."
if l(lne,2)=2 then lst$(lne)=" LAV"
if l(lne,2)=3 then lst$(lne)=" BATH TUB"
if l(lne,2)=4 then lst$(lne)=" SHOWER."
if l(lne,2)=5 then lst$(lne)=" PANTRY SINK"
if l(lne,2)=6 then lst$(lne)=" URINAL"
if l(lne,2)=7 then lst$(lne)=" MOP SINK"
if l(lne,2)=8 then lst$(lne)=" WATER COOLER"
if l(lne,2)=9 then lst$(lne)=" C.O."
if l(lne,2)=10 then lst$(lne)=" C.O."
if l(lne,2)=11 then lst$(lne)=" A.D."
if l(lne,2)=12 then lst$(lne)=" B.D."
if l(lne,2)=13 then lst$(lne)=" D.D."
if l(lne,2)=14 then lst$(lne)=" F.D."
if l(lne,2)=15 then lst$(lne)=" O.F.D."
if l(lne,2)=16 then lst$(lne)=" R.D."
if l(lne,2)=17 then lst$(lne)=" S.D."
if l(lne,2)=18 then lst$(lne)=" T.D."
if l(lne,2)>99 then gosub Piping3:
if l(lne,2)=99 then lst$(lne)=""
l(lne,2)=0
return
Piping3:
FOR bb=bb1 TO 32700
IF l(lne,2)=l(bb,2) THEN lst$(lne)=lst$(bb)

NEXT bb
RETURN

P0:
if INSTR(1,lt$(lne),"s")>0 then gosub sncsn::gosub Psquiggle:
if link>0 then gosub Pline:

return
P1:
hx(0)=l(link,20):hy(0)=l(link,21)
hx(1)=l(lne,20):hy(1)=l(lne,21)
xpt(1)=hx(0)+cs2*wth0
ypt(1)=hy(0)+sn2*wth0
xpt(2)=hx(0)-cs2*wth0
ypt(2)=hy(0)-sn2*wth0
xpt(4)=hx(1)+cs2*wth
ypt(4)=hy(1)+sn2*wth
xpt(3)=hx(1)-cs2*wth
ypt(3)=hy(1)-sn2*wth
xpt(5)=xpt(1):ypt(5)=ypt(1)
fpt=1:npt=5:gosub plotff:
if link>0 then gosub Pline:

return
P2:
hx(0)=l(lne,20):hy(0)=l(lne,21)
xpt(1)=hx(0)+cs2*wth
ypt(1)=hy(0)+sn2*wth
xpt(2)=hx(0)-cs2*wth
ypt(2)=hy(0)-sn2*wth
fpt=1:npt=2:gosub plotff:
if link>0 then gosub Pline:

return
P3:
l(lne,18)=wth
if link>0 then gosub Pline:

return
P4:
hx(0)=l(lne,20):hy(0)=l(lne,21)
xpt(1)=hx(0)
ypt(1)=hy(0)
xpt(2)=hx(0)+cs1*wth
ypt(2)=hy(0)+sn1*wth
fpt=1:npt=2:gosub plotff:

xpt(1)=hx(0)+cs2*wth
ypt(1)=hy(0)+sn2*wth
xpt(2)=hx(0)-cs2*wth
ypt(2)=hy(0)-sn2*wth
fpt=1:npt=2:gosub plotff:
if link>0 then gosub Pline:

return
P5:
gosub Pangle::l(lne,3)=angle
if l(lne,8)=0 then l(lne,8)=4

hx(0)=l(lne,20):hy(0)=l(lne,21)
hx(1)=l(link,20):hy(1)=l(link,21)
wth=l(lne,8)/2
xpt(2)=hx(0)+cs2*wth
ypt(2)=hy(0)+sn2*wth
xpt(1)=hx(0)-cs2*wth
ypt(1)=hy(0)-sn2*wth
xpt(4)=hx(1)+cs2*wth
ypt(4)=hy(1)+sn2*wth
xpt(3)=hx(1)-cs2*wth
ypt(3)=hy(1)-sn2*wth
fpt=1:npt=4:gosub plotff:
if link>0 then gosub Pline:

return
Pelength:
angle0=difangle
IF radd1=radd2 THEN ttan1=ABS(TAN(gpi#*(angle0/2)))*radd1:ttan2=ttan1:return
xpt=100:ypt=100
xpt1#=xpt#:ypt1#=ypt#+radd1:xpt2#=xpt1#+10:ypt2#=ypt1#
xpt4#=xpt#-COS(gpi#*(angle0+90))*radd2
ypt4#=ypt#+SIN(gpi#*(angle0+90))*radd2
xpt3#=xpt4#-COS(gpi#*angle0)*(10*one)
ypt3#=ypt4#+SIN(gpi#*angle0)*(10*one)
gosub elength2:
ttan1#=SQR(ABS(((xpt1#-xpt3#)^2)+((ypt1#-ypt3#)^2)))
ttan2#=SQR(ABS(((xpt4#-xpt3#)^2)+((ypt4#-ypt3#)^2)))
return
P6:
gosub Pangle::l(lne,3)=angle
if l(lne,8)=0 then l(lne,8)=4

hx(0)=l(lne,20):hy(0)=l(lne,21)
hx(1)=l(link,20):hy(1)=l(link,21)
wth=l(lne,8)/2
xpt(1)=hx(0)
ypt(1)=hy(0)
xpt(2)=hx(1)+cs2*wth
ypt(2)=hy(1)+sn2*wth
xpt(3)=hx(1)-cs2*wth
ypt(3)=hy(1)-sn2*wth
xpt(4)=xpt(1):ypt(4)=ypt(1)

fpt=1:npt=4:gosub plotff:
if link>0 then gosub Pline:

return

P7:
gosub Pangle::l(lne,3)=angle
if l(lne,8)=0 then l(lne,8)=4
hx(0)=l(lne,20):hy(0)=l(lne,21)
hx(1)=l(link,20):hy(1)=l(link,21)
wth=l(lne,8)/2
xpt(1)=hx(1)
ypt(1)=hy(1)
xpt(2)=hx(0)+cs2*wth
ypt(2)=hy(0)+sn2*wth
xpt(3)=hx(0)-cs2*wth
ypt(3)=hy(0)-sn2*wth
xpt(4)=xpt(1):ypt(4)=ypt(1)

fpt=1:npt=4:gosub plotff:
if link>0 then gosub Pline:

return

P8:
hx(0)=l(lne,20):hy(0)=l(lne,21)
hx(1)=hx(0)-cs1:hy(1)=hy(0)-sn1

xpt(1)=hx(1)+cs2*wth
ypt(1)=hy(1)+sn2*wth
xpt(4)=hx(1)-cs2*wth
ypt(4)=hy(1)-sn2*wth
hx(1)=hx(0)+cs1:hy(1)=hy(0)+sn1
xpt(2)=hx(1)+cs2*wth
ypt(2)=hy(1)+sn2*wth
xpt(3)=hx(1)-cs2*wth
ypt(3)=hy(1)-sn2*wth

fpt=1:npt=4:gosub plotff:
if link>0 then gosub Pline:

return
P9:
lst$(lne)="C.O."
if l(lne,8)>0 then wth=l(lne,8)/2
hx(0)=l(lne,20):hy(0)=l(lne,21)
xpt(1)=hx(0)+cs2*wth
ypt(1)=hy(0)+sn2*wth
xpt(4)=hx(0)-cs2*wth
ypt(4)=hy(0)-sn2*l(lne,4)/2
hx(0)=hx(0)+cs1*2:hy(0)=hy(0)+sn1*2
xpt(2)=hx(0)+cs2*wth*.75
ypt(2)=hy(0)+sn2*wth*.75
xpt(3)=hx(0)-cs2*wth*.75
ypt(3)=hy(0)-sn2*wth*.75

fpt=1:npt=4:gosub plotff2:
fpt=2:npt=3:gosub plotff2:
if link>0 then gosub Pline:

return

P10:
l(lne,18)=wth
if link>0 then gosub Pline:
n=1:gosub Pcircle:

return
P11:
l(lne,18)=wth
if link>0 then gosub Pline:
n=2:gosub Pcircle:


return
P12:
l(lne,18)=wth
if link>0 then gosub Pline:
n=3:gosub Pcircle:

return
P13:
l(lne,18)=wth
n=1:gosub Pcircle:
xpt(4)=hx(0)+cs2*wth:ypt(4)=hy(0)+sn2*wth
xpt(5)=xpt(4)+cs2*wth:ypt(5)=ypt(4)+sn2*wth
fpt=4:npt=5:gosub plotff:
xpt(6)=xpt(5)-cs1*wth:ypt(6)=ypt(5)-sn1*wth
xpt(7)=xpt(5)+cs1*wth:ypt(7)=ypt(5)+sn1*wth
fpt=6:npt=7:gosub plotff:
if link>0 then gosub Pline:

return
P14:
l(lne,18)=wth
n=1:gosub Pcircle:
xpt(4)=hx(0)+cs2*wth:ypt(4)=hy(0)+sn2*wth
xpt(5)=xpt(4)+cs2*wth:ypt(5)=ypt(4)+sn2*wth
fpt=4:npt=5:gosub plotff:
xpt(6)=xpt(5)+cs1*wth:ypt(6)=ypt(5)+sn1*wth
fpt=5:npt=6:gosub plotff:
if link>0 then gosub Pline:

return
P15:
l(lne,18)=wth
n=1:gosub Pcircle:
xpt(4)=hx(0)+cs2*wth:ypt(4)=hy(0)+sn2*wth
xpt(4)=xpt(4)+cs1*wth:ypt(4)=ypt(4)+sn1*wth
xpt(5)=hx(0)-cs2*wth:ypt(5)=hy(0)-sn2*wth
xpt(5)=xpt(5)-cs1*wth:ypt(5)=ypt(5)-sn1*wth
fpt=4:npt=5:gosub plotff:
if link>0 then gosub Pline:

return
P16:
l(lne,18)=wth
n=1:gosub Pcircle:
wth2=wth*.7
xpt(4)=hx(0)+cs2*wth2:ypt(4)=hy(0)+sn2*wth2
xpt(4)=xpt(4)+cs1*wth2:ypt(4)=ypt(4)+sn1*wth2
xpt(5)=hx(0)-cs2*wth2:ypt(5)=hy(0)-sn2*wth2
xpt(5)=xpt(5)-cs1*wth2:ypt(5)=ypt(5)-sn1*wth2
fpt=4:npt=5:gosub plotff:
xpt(4)=hx(0)+cs2*wth2:ypt(4)=hy(0)+sn2*wth2
xpt(4)=xpt(4)-cs1*wth2:ypt(4)=ypt(4)-sn1*wth2
xpt(5)=hx(0)-cs2*wth2:ypt(5)=hy(0)-sn2*wth2
xpt(5)=xpt(5)+cs1*wth2:ypt(5)=ypt(5)+sn1*wth2
fpt=4:npt=5:gosub plotff:
if link>0 then gosub Pline:
return
P17:
l(lne,18)=wth
n=1:gosub Pcircle:
gosub sncsn:
s1=cos(gpi#*45)*wth
xpt(5)=hx(0)+cs2*wth*2:ypt(5)=hy(0)+sn2*wth*2
xpt(8)=hx(0)+cs2*s1:ypt(8)=hy(0)+sn2*s1
xpt(8)=xpt(8)+cs1*s1:ypt(8)=ypt(8)+sn1*s1
xpt(9)=xpt(8)-cs1*s1*2:ypt(9)=ypt(8)-sn1*s1*2
fpt=5:npt=8:gosub plotff2:
fpt=5:npt=9:gosub plotff2:
xpt(6)=xpt(5)-cs1*wth:ypt(6)=ypt(5)-sn1*wth
xpt(7)=xpt(5)+cs1*wth:ypt(7)=ypt(5)+sn1*wth
fpt=6:npt=7:gosub plotff:
if link>0 then gosub Pline:

return
P18:
l(lne,18)=wth
hx(0)=l(lne,20)+cs1*wth
hy(0)=l(lne,21)+sn1*wth
xpt(1)=hx(0)+cs2*wth
ypt(1)=hy(0)+sn2*wth

hx(0)=l(lne,20)-cs1*wth
hy(0)=l(lne,21)-sn1*wth
xpt(2)=hx(0)+cs2*wth
ypt(2)=hy(0)+sn2*wth

hx(0)=l(lne,20)-cs1*wth*.5
hy(0)=l(lne,21)-sn1*wth*.5
xpt(3)=hx(0)-cs2*wth
ypt(3)=hy(0)-sn2*wth

hx(0)=l(lne,20)+cs1*wth*.5
hy(0)=l(lne,21)+sn1*wth*.5
xpt(4)=hx(0)-cs2*wth
ypt(4)=hy(0)-sn2*wth

xpt(5)=xpt(1):ypt(5)=ypt(1)
fpt=1:npt=5:gosub plotff:
hx(0)=l(lne,20):hy(0)=l(lne,21)
xpt(4)=hx(0)+cs2*wth:ypt(4)=hy(0)+sn2*wth
xpt(5)=xpt(4)+cs2*wth:ypt(5)=ypt(4)+sn2*wth
fpt=4:npt=5:gosub plotff:
xpt(6)=xpt(5)+cs1*wth:ypt(6)=ypt(5)+sn1*wth
fpt=5:npt=6:gosub plotff:


if link>0 then gosub Pline:

return
P19:
l(lne,18)=wth
lst$(lne)="C.O."
if link>0 then gosub Pline:
n=1:gosub Pcircle:
w(0)=w(0)/2
n=1:gosub Pcircle:

return
P20:
l(lne,18)=wth
w(0)=l(lne,4)/2
n=1:gosub Pcircle:

hx(1)=hx(0)-cs1*wth:hy(1)=hy(0)-sn1*wth
xpt(1)=hx(1)+cs2*wth:ypt(1)=hy(1)+sn2*wth
xpt(4)=hx(1)-cs2*wth:ypt(4)=hy(1)-sn2*wth

hx(1)=hx(0)+cs1*wth:hy(1)=hy(0)+sn1*wth
xpt(2)=hx(1)+cs2*wth:ypt(2)=hy(1)+sn2*wth
xpt(3)=hx(1)-cs2*wth:ypt(3)=hy(1)-sn2*wth
xpt(5)=xpt(1):ypt(5)=ypt(1):fpt=1:npt=5:gosub plotff:
if link>0 then gosub Pline:

return

P21:
l(lne,18)=wth
n=1:gosub Pcircle:
w(0)=l(lne,4)/2:gosub Pcircle:

dir=1:gosub P21a:
dir=-1:gosub P21a:
if link>0 then gosub Pline:

return
P21a:
angle=l(lne,3)-45:gosub sncsn2:
n1=int(wth)-1
wth2=wth
hx(1)=hx(0):hy(1)=hy(0)
for i=0 to n1
hx(1)=hx(0)+cs1*i*dir:hy(1)=hy(0)+sn1*i*dir
xpt(4)=hx(1)+cs2*wth2:ypt(4)=hy(1)+sn2*wth2
xpt(5)=hx(1)-cs2*wth2:ypt(5)=hy(1)-sn2*wth2
fpt=4:npt=5:gosub plotff:
wth2=wth2-1
next i
return
P22:
l(lne,18)=wth
if link>0 then gosub Pline:
n=1:gosub Pcircle:


return
P23:
hx(0)=l(lne,20):hy(0)=l(lne,21)
hx(1)=l(link,20):hy(1)=l(link,21)
wth=l(lne,4)/2
xpt(1)=hx(0)+cs2*wth
ypt(1)=hy(0)+sn2*wth
xpt(2)=hx(0)-cs2*wth
ypt(2)=hy(0)-sn2*wth
xpt(4)=hx(1)+cs2*wth
ypt(4)=hy(1)+sn2*wth
xpt(3)=hx(1)-cs2*wth
ypt(3)=hy(1)-sn2*wth

xpt(5)=xpt(1):ypt(5)=ypt(1)

fpt=1:npt=5:gosub plotff:
if link>0 then gosub Pline:
return
P24:
l(lne,18)=wth
if link>0 then gosub Pline:
n=1:gosub Pcircle:


return
P25:

gosub Pangle::l(lne,3)=angle
if l(lne,8)=0 then l(lne,8)=4
hx(0)=l(lne,20):hy(0)=l(lne,21)
hx(1)=l(link,20):hy(1)=l(link,21)
wth=l(lne,8)/2
xpt(1)=hx(1)-cs2*wth
ypt(1)=hy(1)-sn2*wth
xpt(2)=hx(1)+cs2*wth
ypt(2)=hy(1)+sn2*wth
xpt(3)=hx(0)-cs2*wth
ypt(3)=hy(0)-sn2*wth
xpt(4)=hx(0)+cs2*wth
ypt(4)=hy(0)+sn2*wth
fpt=1:npt=4:gosub plotff:
if link>0 then gosub Pline:
return
P26:
return

P27:
return
P28:
return
P29:

n=1:gosub Pcircle:
w(0)=l(lne,4)/2:gosub Pcircle:
if l(lne,7)=1 then return
if l(lne,7)=2 then gosub P20:
dir=1:gosub P21a:
dir=-1:gosub P21a:

return
P29a:
angle=l(lne,3)-45:gosub sncsn2:
n1=int(wth)-1
wth2=wth
hx(1)=hx(0):hy(1)=hy(0)
for i=0 to n1
hx(1)=hx(0)+cs1*i*dir:hy(1)=hy(0)+sn1*i*dir
xpt(4)=hx(1)+cs2*wth2:ypt(4)=hy(1)+sn2*wth2
xpt(5)=hx(1)-cs2*wth2:ypt(5)=hy(1)-sn2*wth2
fpt=4:npt=5:gosub plotff:
wth2=wth2-1
next i
return
P30:
gosub sncsn:
if l(lne,4)=0 then l(lne,4)=15:l(lne,5)=27
i0=0
w(i0)=l(lne,4)/2:d(i0)=l(lne,5)/2
hx(0)=l(lne,20)+cs1*d(0):hy(0)=l(lne,21)+sn1*d(0)
angle=l(lne,3)
sa=220:ea=500
npt=1:gosub fellipse:
fpt=2:gosub plotff2:
w(0)=w(0)-2:d(0)=d(0)-2
sa=245:ea=475
npt=1:gosub fellipse:
fpt=2:gosub plotff2:
d(0)=.75:w(0)=.75
dx=6:sa=0:ea=360:
dy=-3:gosub Padjust::gosub fcircle:
dy=0:gosub Padjust::gosub fcircle:
dy=3:gosub Padjust::gosub fcircle:

return
P31:
gosub sncsn:
if l(lne,4)=0 then l(lne,4)=15:l(lne,5)=30.125
i0=0
sa=0:ea=360:angle=l(lne,3)
hx(0)=l(lne,20)+cs1*10:hy(0)=l(lne,21)+sn1*10
w(i0)=2:d(i0)=2
'gosub fcircle:
w(i0)=l(lne,4)/2:d(i0)=l(lne,5)/2
hx(0)=l(lne,20)+cs1*d(i0):hy(0)=l(lne,21)+sn1*d(i0)
w(0)=w(i0):d(0)=d(i0)
angle=l(lne,3)
sa=0:ea=360:angle=l(lne,3)

npt=1:gosub fellipse:
w(0)=w(0)-2:d(0)=d(0)-2
sa=240:ea=480

npt=1:gosub fellipse:
fpt=2:gosub plotff2:


return
P32:
gosub sncsn:
if l(lne,4)=0 then l(lne,4)=15:l(lne,5)=30.125
i0=0
sa=0:ea=360:angle=l(lne,3)
w(i0)=l(lne,4)/2:d(i0)=l(lne,5)/2
hx(i0)=l(lne,20)+cs1*d(i0):hy(i0)=l(lne,21)+sn1*d(i0)
sa=270:ea=450
xpt(1)=hx(i0)+cs2*w(i0):ypt(1)=hy(i0)+sn2*w(i0)
xpt(2)=l(lne,20)+cs2*w(i0):ypt(2)=l(lne,21)+sn2*w(i0)
xpt(3)=l(lne,20)-cs2*w(i0):ypt(3)=l(lne,21)-sn2*w(i0)
xpt(4)=hx(i0)-cs2*w(i0):ypt(4)=hy(i0)-sn2*w(i0)
fpt=1:npt=4:gosub plotff:
npt=1:gosub fellipse:
w(i0)=w(i0)-2:d(i0)=d(i0)-2
sa=240:ea=480

npt=1:gosub fellipse:
fpt=2::gosub plotff2:

return
P33:
if l(lne,7)=1 then goto P33b:
gosub sncsn:
hx(0)=l(lne,20)+cs1*4:hy(0)=l(lne,21)+sn1*4:w(0)=8:d(0)=4:radd=1.5:angle=l(lne,3):radd=2:gosub froundrect:
i0=0
sa=220:ea=500
hx(0)=l(lne,20)+cs1*16:hy(0)=l(lne,21)+sn1*16
w(0)=7:d(0)=10
angle=l(lne,3)
stp=0:npt=1:gosub fellipse:
w(0)=w(0)-2:d(0)=d(0)-2:
sa=0:ea=360

npt=1:gosub fellipse:
return
P33b:
angle=l(lne,3)
gosub sncsn:
i0=0:hx(0)=l(lne,20)+cs1*8.25:hy(0)=l(lne,21)+sn1*8.25:w(0)=10.5:d(0)=21.5:i0=0:sa=270:ea=450::stp=0:npt=1:gosub fellipse:

i0=0:hx(0)=l(lne,20)+cs1*14.066:hy(0)=l(lne,21)+sn1*14.066:w(0)=7.5:d(0)=14.5:i0=0:sa=252:ea=469::stp=0:npt=1:gosub fellipse:

i0=0:hx(0)=l(lne,20)+cs1*14.066:hy(0)=l(lne,21)+sn1*14.066:w(0)=8:d(0)=15:i0=0:sa=252:ea=469::stp=0:npt=1:gosub fellipse:
i0=0:hx(0)=l(lne,20)+cs1*14.638:hy(0)=l(lne,21)+sn1*14.638:w(0)=8.6875:d(0)=15:i0=0:sa=270:ea=450::stp=0:npt=1:gosub fellipse:
i0=0:hx(0)=l(lne,20)+cs1*10.25:hy(0)=l(lne,21)+sn1*10.25:hx(0)=hx(0)+cs2*6.25:hy(0)=hy(0)+sn2*6.25:w(0)=1:d(0)=0:i0=0:sa=angle+90:ea=angle+180::stp=0:npt=1:gosub fcircle:
i0=0:hx(0)=l(lne,20)+cs1*10.25:hy(0)=l(lne,21)+sn1*10.25:hx(0)=hx(0)+cs2*6.25:hy(0)=hy(0)+sn2*6.25:w(0)=1.5:d(0)=0:i0=0:sa=angle+90:ea=angle+180::stp=0:npt=1:gosub fcircle:
i0=0:hx(0)=l(lne,20)+cs1*10.25:hy(0)=l(lne,21)+sn1*10.25:hx(0)=hx(0)-cs2*6.25:hy(0)=hy(0)-sn2*6.25:w(0)=1:d(0)=0:i0=0:sa=angle+180:ea=angle+270::stp=0:npt=1:gosub fcircle:
i0=0:hx(0)=l(lne,20)+cs1*10.25:hy(0)=l(lne,21)+sn1*10.25:hx(0)=hx(0)-cs2*6.25:hy(0)=hy(0)-sn2*6.25:w(0)=1.5:d(0)=0:i0=0:sa=angle+180:ea=angle+270::stp=0:npt=1:gosub fcircle:
hx(0)=l(lne,20):hy(0)=l(lne,21)
xpt(1)=hx(0)+cs1*0:ypt(1)=hy(0)+sn1*0::xpt(1)=xpt(1)+cs2*9.25:ypt(1)=ypt(1)+sn2*9.25
xpt(2)=hx(0)+cs1*6.75:ypt(2)=hy(0)+sn1*6.75:xpt(2)=xpt(2)+cs2*9.25:ypt(2)=ypt(2)+sn2*9.25
xpt(3)=hx(0)+cs1*8.5:ypt(3)=hy(0)+sn1*8.5:xpt(3)=xpt(3)+cs2*7.5:ypt(3)=ypt(3)+sn2*7.5
xpt(4)=xpt(1):ypt(4)=ypt(1)
fpt=1:npt=3:gosub plotff:
xpt(1)=hx(0)+cs1*0:ypt(1)=hy(0)+sn1*0::xpt(1)=xpt(1)-cs2*9.25:ypt(1)=ypt(1)-sn2*9.25
xpt(2)=hx(0)+cs1*6.75:ypt(2)=hy(0)+sn1*6.75:xpt(2)=xpt(2)-cs2*9.25:ypt(2)=ypt(2)-sn2*9.25
xpt(3)=hx(0)+cs1*8.5:ypt(3)=hy(0)+sn1*8.5:xpt(3)=xpt(3)-cs2*7.5:ypt(3)=ypt(3)-sn2*7.5
fpt=1:npt=3:gosub plotff:
xpt(1)=hx(0)+cs1*14.5:ypt(1)=hy(0)+sn1*14.5:xpt(1)=xpt(1)+cs2*8.75:ypt(1)=ypt(1)+sn2*8.75
xpt(2)=hx(0)+cs1*8.25:ypt(2)=hy(0)+sn1*8.25:xpt(2)=xpt(2)+cs2*8.75:ypt(2)=ypt(2)+sn2*8.75
xpt(3)=hx(0)+cs1*8.25:ypt(3)=hy(0)+sn1*8.25:xpt(3)=xpt(3)-cs2*8.75:ypt(3)=ypt(3)-sn2*8.75
xpt(4)=hx(0)+cs1*14.5:ypt(4)=hy(0)+sn1*14.5:xpt(4)=xpt(4)-cs2*8.75:ypt(4)=ypt(4)-sn2*8.75
fpt=1:npt=4:gosub plotff:

xpt(1)=hx(0):ypt(1)=hy(0)
xpt(2)=hx(0)+cs1*0:ypt(2)=hy(0)+sn1*0:xpt(2)=xpt(2)+cs2*9.25:ypt(2)=ypt(2)+sn2*9.25
xpt(3)=hx(0)+cs1*1.25:ypt(3)=hy(0)+sn1*1.25:xpt(3)=xpt(3)+cs2*10.5:ypt(3)=ypt(3)+sn2*10.5
xpt(4)=hx(0)+cs1*8.25:ypt(4)=hy(0)+sn1*8.25:xpt(4)=xpt(4)+cs2*10.5:ypt(4)=ypt(4)+sn2*10.5
fpt=1:npt=4:gosub plotff:

xpt(1)=hx(0):ypt(1)=hy(0)
xpt(2)=hx(0)+cs1*0:ypt(2)=hy(0)+sn1*0:xpt(2)=xpt(2)-cs2*9.25:ypt(2)=ypt(2)-sn2*9.25
xpt(3)=hx(0)+cs1*1.25:ypt(3)=hy(0)+sn1*1.25:xpt(3)=xpt(3)-cs2*10.5:ypt(3)=ypt(3)-sn2*10.5
xpt(4)=hx(0)+cs1*8.25:ypt(4)=hy(0)+sn1*8.25:xpt(4)=xpt(4)-cs2*10.5:ypt(4)=ypt(4)-sn2*10.5
fpt=1:npt=4:gosub plotff:
xpt(1)=hx(0)+cs1*8.75:ypt(1)=hy(0)+sn1*8.75:xpt(1)=xpt(1)+cs2*6.25:ypt(1)=ypt(1)+sn2*6.25
xpt(2)=hx(0)+cs1*8.75:ypt(2)=hy(0)+sn1*8.75:xpt(2)=xpt(2)-cs2*6.25:ypt(2)=ypt(2)-sn2*6.25
fpt=1:npt=2:gosub plotff:

xpt(1)=hx(0)+cs1*9.25:ypt(1)=hy(0)+sn1*9.25:xpt(1)=xpt(1)+cs2*6.25:ypt(1)=ypt(1)+sn2*6.25
xpt(2)=hx(0)+cs1*9.25:ypt(2)=hy(0)+sn1*9.25:xpt(2)=xpt(2)-cs2*6.25:ypt(2)=ypt(2)-sn2*6.25
fpt=1:npt=2:gosub plotff:

return
P34:
gosub sncsn:
i0=0
angle=l(lne,3)
if l(lne,4)=0 then l(lne,4)=17.5:l(lne,5)=13.25
l(lne,6)=l(lne,5)
w(i0)=l(lne,4)/2:d(i0)=l(lne,5)/2

hx(0)=l(lne,20):hy(0)=l(lne,21)
xpt(1)=hx(0)+cs2*w(i0):ypt(1)=hy(0)+sn2*w(i0)
xpt(2)=xpt(1)+cs1*6.75:ypt(2)=ypt(1)+sn1*6.75
xpt(3)=xpt(2)-cs1*2.75:ypt(3)=ypt(2)-sn1*2.75
xpt(3)=xpt(3)-cs2*2.75:ypt(3)=ypt(3)-sn2*2.75

xpt(6)=hx(0)-cs2*w(i0):ypt(6)=hy(0)-sn2*w(i0)
xpt(5)=xpt(6)+cs1*6.75:ypt(5)=ypt(6)+sn1*6.75
xpt(4)=xpt(5)-cs1*2.75:ypt(4)=ypt(5)-sn1*2.75
xpt(4)=xpt(4)+cs2*2.75:ypt(4)=ypt(4)+sn2*2.75

xpt(7)=xpt(1):ypt(7)=ypt(1)
fpt=1:npt=7:gosub plotff:

xpt(8)=xpt(2):ypt(8)=ypt(2)

xpt(9)=hx(0)+cs1*13.25:ypt(9)=hy(0)+sn1*13.25
xpt(9)=xpt(9)+cs2*2.25:ypt(9)=ypt(9)+sn2*2.25
xpt(10)=xpt(9)-cs2*4.5:ypt(10)=ypt(9)-sn2*4.5
xpt(11)=xpt(5):ypt(11)=ypt(5)
fpt=8:npt=11:gosub plotff:
xpt(8)=xpt(2)-cs1*1.5:ypt(8)=ypt(2)-sn1*1.5
xpt(8)=xpt(8)-cs2*1.5:ypt(8)=ypt(8)-sn2*1.5

xpt(9)=hx(0)+cs1*11.75:ypt(9)=hy(0)+sn1*11.75
xpt(9)=xpt(9)+cs2*.75:ypt(9)=ypt(9)+sn2*.75
xpt(10)=xpt(9)-cs2*1.5:ypt(10)=ypt(9)-sn2*1.5

xpt(11)=xpt(5)-cs1*1.5:ypt(11)=ypt(5)-sn1*1.5
xpt(11)=xpt(11)+cs2*1.5:ypt(11)=ypt(11)+sn2*1.5

fpt=8:npt=11:gosub plotff:
return



P35:
'countertop lav
i0=0
if l(lne,4)=0 then l(lne,4)=20.375:l(lne,5)=17
hx(i0)=l(lne,20):hy(i0)=l(lne,21)
w(i0)=l(lne,4)/2:d(i0)=l(lne,5)/2
angle=l(lne,3)
sa=0:ea=360:angle=l(lne,3)
stp=0:npt=1:gosub fellipse:
w(i0)=w(i0)-2:d(i0)=d(i0)-2
sa=235:ea=485
stp=0:npt=1:gosub fellipse:
gosub plotff2:
dx=-(l(lne,5)/2)+3::gosub Padjust::gosub fholes:

return


P36:
'hung lav
gosub sncsn:
if l(lne,4)=0 then l(lne,4)=20.5:l(lne,5)=18.25
sa=0:ea=360:stp=10:i0=0:angle=l(lne,3)

w(i0)=.85:d(i0)=.85:dx=8:dy=0:gosub Padjust::gosub fcircle:
w(i0)=.75:d(i0)=.75:dx=3.675::gosub Padjust::gosub fholes:
w(i0)=(l(lne,4)-4)/2:d(i0)=(l(lne,5)-8)/2:dx=l(lne,5)-d(i0)-2:dy=0:gosub Padjust::radd=2:gosub froundrect:
w(i0)=l(lne,4)/2:d(i0)=l(lne,5)/2:dx=d(i0):dy=0:gosub Padjust::radd=1:gosub froundrect:
return
Padjust:
hx(i0)=l(lne,20)+cs1*dx
hy(i0)=l(lne,21)+sn1*dx
hx(i0)=hx(i0)+cs2*dy
hy(i0)=hy(i0)+sn2*dy

return
P37:
gosub sncsn:
sa=0:ea=360:stp=10:i0=0:angle=l(lne,3)
if l(lne,4)=0 then l(lne,4)=33:l(lne,5)=22:l(lne,8)=2.5
if l(lne,7)=0 then l(lne,7)=1
w(i0)=l(lne,4)/2:d(i0)=l(lne,5)/2:l(lne,6)=l(lne,5)
dx=d(i0):dy=0:gosub Padjust::radd=1:if l(lne,9)>=0 then gosub froundrect:
depth=(l(lne,5)-(l(lne,8)+4))/2
wth=((l(lne,4)-(l(lne,7)-1)-4))/l(lne,7):wth=wth/2
s1=(l(lne,7)+1)/2
for t=1 to l(lne,7)
dx=2+l(lne,8)+depth:dy=(t-s1)*((wth*2)+1):gosub Padjust::d(0)=depth:w(0)=wth:radd=2:gosub froundrect::d(0)=.75:w(0)=.75:gosub fcircle:
next t
if l(lne,8)>0 then dx=l(lne,8):gosub fholes:
return
fholes:
sa=0:ea=360:stp=10:i0=0
d(0)=.75:w(0)=.75
dy=-4:gosub Padjust::gosub fcircle:
dy=0:gosub Padjust::gosub fcircle:
dy=4:gosub Padjust::gosub fcircle:
return
P38:
gosub Padjust:
w(i0)=l(lne,4)/2:d(i0)=l(lne,5)/2
angle=l(lne,3)
radd=l(lne,7)
gosub froundrect2:
i0=0
w(i0)=w(i0)-l(lne,8):d(i0)=d(i0)-l(lne,8)
gosub froundrect:

return
P39:
sa=0:ea=360:stp=10:i0=0:angle=l(lne,3)

gosub sncsn:
if l(lne,4)=0 then l(lne,4)=14:l(lne,5)=18:l(lne,8)=2.5
w(i0)=l(lne,4)/2:d(i0)=l(lne,5)/2:l(lne,6)=l(lne,5)
dx=d(i0):dy=0:gosub Padjust::radd=1:gosub froundrect:
d(i0)=4
dx=l(lne,6)-1-d(i0):dy=0:gosub Padjust::radd=1:gosub froundrect:
return
P40:
if l(lne,4)=0 then l(lne,4)=36:l(lne,5)=60:l(lne,8)=2:l(lne,7)=1
sa=0:ea=360:stp=10:i0=0
hx(0)=l(lne,20):hy(0)=l(lne,21)
w(i0)=l(lne,4)/2:d(i0)=l(lne,5)/2
if l(lne,9)>=0 then gosub fsquare:

w(i0)=w(i0)-l(lne,8):d(i0)=d(i0)-l(lne,8)
angle=l(lne,3)
radd=0
if l(lne,7)>0 then radd=l(lne,7)
gosub froundrect:
hx(0)=l(lne,20)+cs1*l(lne,13)
hy(0)=l(lne,21)+sn1*l(lne,13)
hx(0)=hx(0)+cs2*l(lne,14)
hy(0)=hy(0)+sn2*l(lne,14)
gosub penpattern1:
w(0)=1.5:d(0)=1.5
gosub fcircle:
if l(lne,7)<0 then gosub P40b:
return
P40b:
w(1)=(l(lne,4)/2)-l(lne,8):d(1)=(l(lne,5)/2)-l(lne,8)
hx(1)=l(lne,20):hy(1)=l(lne,21)
xpt(1)=hx(0)+cs1*.75:ypt(1)=hy(0)+sn1*.6
xpt(1)=xpt(1)+cs2*.75:ypt(1)=ypt(1)+sn2*.6
xpt(2)=hx(1)+cs1*d(1):ypt(2)=hy(1)+sn1*d(1)
xpt(2)=xpt(2)+cs2*w(1):ypt(2)=ypt(2)+sn2*w(1)
fpt=1:npt=2:gosub plotff:
xpt(1)=hx(0)+cs1*.75:ypt(1)=hy(0)+sn1*.6
xpt(1)=xpt(1)-cs2*.75:ypt(1)=ypt(1)-sn2*.6
xpt(2)=hx(1)+cs1*d(1):ypt(2)=hy(1)+sn1*d(1)
xpt(2)=xpt(2)-cs2*w(1):ypt(2)=ypt(2)-sn2*w(1)
fpt=1:npt=2:gosub plotff:
xpt(1)=hx(0)-cs1*.75:ypt(1)=hy(0)-sn1*.6
xpt(1)=xpt(1)+cs2*.75:ypt(1)=ypt(1)+sn2*.6
xpt(2)=hx(1)-cs1*d(1):ypt(2)=hy(1)-sn1*d(1)
xpt(2)=xpt(2)+cs2*w(1):ypt(2)=ypt(2)+sn2*w(1)
fpt=1:npt=2:gosub plotff:
xpt(1)=hx(0)-cs1*.75:ypt(1)=hy(0)-sn1*.6
xpt(1)=xpt(1)-cs2*.75:ypt(1)=ypt(1)-sn2*.6
xpt(2)=hx(1)-cs1*d(1):ypt(2)=hy(1)-sn1*d(1)
xpt(2)=xpt(2)-cs2*w(1):ypt(2)=ypt(2)-sn2*w(1)
fpt=1:npt=2:gosub plotff:



return
P41:
gosub sncsn:
'hung lav
sa=0:ea=360:stp=10:i0=0:angle=l(lne,3)
if l(lne,4)=0 then l(lne,4)=24:l(lne,5)=24
w(i0)=l(lne,4)/2:d(i0)=l(lne,5)/2
dx=d(i0)/2:dy=0:gosub Padjust::sa=240:ea=480:angle=l(lne,3):stp=0:npt=1:gosub fellipse2:
xpt(npt+1)=xpt(fpt):ypt(npt+1)=ypt(fpt):fpt=npt:npt=npt+1:gosub plotff:
w(i0)=(l(lne,4)/2)-2:d(i0)=(l(lne,5)/2)-2:dx=l(lne,5)/4:gosub Padjust::sa=260:ea=460:angle=l(lne,3):stp=0:npt=1:gosub fellipse2:
xpt(npt+1)=xpt(fpt):ypt(npt+1)=ypt(fpt):fpt=npt:npt=npt+1:gosub plotff:
w(i0)=.75:d(i0)=.75:dx=l(lne,5)/8::gosub Padjust::gosub fholes:
dx=6:dy=0:gosub Padjust::sa=0:ea=360:angle=l(lne,3):stp=0:npt=1:gosub fcircle:


return



froundrect:
stp=10
npt=0

i0=0:w(i0)=w(i0)-radd:d(i0)=d(i0)-radd
hx=hx(i0)+cs1*d(i0):hy=hy(i0)+sn1*d(i0)
hx(1)=hx+cs2*w(i0):hy(1)=hy+sn2*w(i0)
hx(4)=hx-cs2*w(i0):hy(4)=hy-sn2*w(i0)


hx=hx(i0)-cs1*d(i0):hy=hy(i0)-sn1*d(i0)
hx(2)=hx+cs2*w(i0):hy(2)=hy+sn2*w(i0)
hx(3)=hx-cs2*w(i0):hy(3)=hy-sn2*w(i0)

i0=1:w(i0)=radd:stp=5:sa=angle+0:ea=angle+90:gosub Parc:
i0=2:w(i0)=radd:stp=5:sa=angle+90:ea=angle+180:gosub Parc:
i0=3:w(i0)=radd:stp=5:sa=angle+180:ea=angle+270:gosub Parc:
i0=4:w(i0)=radd:stp=5:sa=angle+270:ea=angle+360:gosub Parc:
fpt=1:xpt(npt+1)=xpt(fpt):ypt(npt+1)=ypt(fpt):npt=npt+1
i0=0
gosub plotff:
stp=10:sa=0:ea=360

return
froundrect2:
stp=10
npt=0
i0=0:w(i0)=w(i0)-radd:d(i0)=d(i0)-radd
hx=hx(0)+cs1*d(i0):hy=hy(0)+sn1*d(i0)
hx(1)=hx+cs2*w(i0):hy(1)=hy+sn2*w(i0)
hx(4)=hx-cs2*w(i0):hy(4)=hy-sn2*w(i0)
w(i0)=l(lne,4)/2:d(i0)=l(lne,5)/2

hx=hx(0)-cs1*d(i0):hy=hy(0)-sn1*d(i0)
i0=1:w(i0)=radd:stp=5:sa=angle+0:ea=angle+90:gosub Parc:
i0=0
npt=npt+1:xpt(npt)=hx+cs2*w(i0):ypt(npt)=hy+sn2*w(i0)
npt=npt+1:xpt(npt)=hx-cs2*w(i0):ypt(npt)=hy-sn2*w(i0)

i0=4:w(i0)=radd:stp=5:sa=angle+270:ea=angle+360:gosub Parc:
fpt=1:xpt(npt+1)=xpt(fpt):ypt(npt+1)=ypt(fpt):npt=npt+1
gosub plotff:
stp=10
i0=0
return
Parc:
for aa=sa to ea step 10
npt=npt+1
xpt(npt)=hx(i0)+COS(gpi#*aa)*radd
ypt(npt)=hy(i0)-SIN(gpi#*aa)*radd
NEXt aa
return
Pellipse:
aaa=l(link,3)
npt=3
fpt=npt+1
FOR aa=sa TO ea STEP stp
dpth4=COS(gpi#*aa)*radd2
wth4=SIN(gpi#*aa)*radd1
npt=npt+1
xpt(npt)=hx(0)+COS(gpi#*aaa)*dpth4
ypt(npt)=hy(0)-SIN(gpi#*aaa)*dpth4
xpt(npt)=xpt(npt)+COS(gpi#*(aaa+90))*wth4
ypt(npt)=ypt(npt)-SIN(gpi#*(aaa+90))*wth4
NEXT aa
npt=npt
GOSUB plotff:
return
Pline:
if INSTR(1,lt$(lne),"x")>0 then return
dx2=l(lne,20)-l(link,20):dy2=l(lne,21)-l(link,21)
l(lne,16)=l(lne,5)+l(lne,17)
if (dx2=0 and dy2=0) then l(lne,6)=(l(lne,22)-l(link,22)):gosub Pdcircle::return
gosub findangles10::angle2=angle:dist1=dpxy:gosub sncsn2:

if l(lne,10)=0 and l(link,1)>199 then l(lne,22)=l(link,22)+(dpxy*l(lne,7)):l(lne,6)=dpxy:l(lne,22)=l(lne,22)+l(lne,15)
if l(lne,10)=1 then l(lne,7)=(l(lne,22)-l(link,22))/dpxy
if l(lne,1)=201 or l(lne,1)=205 or l(lne,1)=206 or l(lne,1)=207 or l(lne,1)=223 or l(lne,1)=225 then return

'l(lne,7)=(l(lne,22)-l(link,22))/dpxy
angle=angle2:dpxy=dist1
if l(lne,6)>24 and plotout=0 then gosub Parrow:
if abs(l(lne,7))>0 then dx2=abs(dpxy):dy2=abs(dpxy*l(lne,7)):gosub NewDepth2::l(lne,16)=ABS(ypt3#)

angle=angle2:dpxy=dist1
d(1)=l(link,18):d(2)=l(lne,18)
if l(lne,1)=212 then if abs(cos(gpi#*(l(lne,3)-angle)))>.90 then d(2)=0
if l(link,1)=212 then if abs(cos(gpi#*(l(link,3)-angle)))>.90 then d(1)=0

if l(lne,1)=211 then if abs(cos(gpi#*(l(lne,3)-angle)))>.77 then d(2)=0
if l(link,1)=211 then if cos(gpi#*(l(link,3)-angle))<-.77 then d(1)=0
if l(lne,1)=206 or l(lne,1)=207 and l(lne,6)>0 then l(link,3)=angle

xpt(1)=l(link,20)+cs1*d(1):ypt(1)=l(link,21)+sn1*d(1):xpt(2)=l(lne,20)-cs1*d(2):ypt(2)=l(lne,21)-sn1*d(2):fpt=1:npt=2
length=dpxy-d(1)-d(2)
if length>60 then goto Plinepatt:
gosub plotff:
return
Pangle:
dx2=l(lne,20)-l(link,20):dy2=l(lne,21)-l(link,21)
if abs(dx2)<.01 and abs(dy2)<.01 then return
gosub findangles10::angle2=angle:dist1=dpxy:l(lne,6)=dpxy:gosub sncsn2:
return


Plinepatt:
if l(lne,9)>1 then gosub penpattern0: else gosub penpattern1:
xpt(3)=xpt(1):ypt(3)=ypt(1)
if Phatch$(n1)="" or l(lne,13)<0 then xpt(4)=xpt(2):ypt(4)=ypt(2):gosub plotff::return
ns=LEN(Phatch$(n1))
fpt=3:npt=4

length=(length/3)-(ns*1.5)
if l(lne,13)>1 then length=l(lne,13)
xpt(4)=xpt(3)+cs1*length:ypt(4)=ypt(3)+sn1*length:gosub plotff:
IF n1>4 and Phatch$(n1)<>"" then goto Psubtext:
FOR ll2=1 TO ns
n2$=MID$(Phatch$(n1),ll2,1)
IF n2$=" " THEN xpt(3)=xpt(4)+cs1*3:ypt(3)=ypt(4)+sn1*3
IF n2$="-" THEN xpt(4)=xpt(3)+cs1*3:ypt(4)=ypt(3)+sn1*3:gosub plotff:
IF n2$="." THEN xpt(4)=xpt(3):ypt(4)=ypt(3):gosub plotff:
IF n2$="_" THEN xpt(4)=xpt(3)+cs1*6:ypt(4)=ypt(3)+sn1*6:gosub plotff:
nEXT ll2
xpt(4)=xpt(2):ypt(4)=ypt(2):gosub plotff:

return
Psubtext:

wth=3.5:dpth=2.5
llst$=Phatch$(n1)
ns=len(llst$)
xpt=xpt(4):ypt=ypt(4)
xpt(3)=xpt(4)+cs1*(ns*dpth)
ypt(3)=ypt(4)+sn1*(ns*dpth)
xpt(4)=xpt(2):ypt(4)=ypt(2):gosub plotff:
if angle>90.1 and angle<=270 then angle=angle+180:xpt=xpt(3):ypt=ypt(3):gosub sncsn2:
xpt=xpt-cs2*wth/2:ypt=ypt-sn2*wth/2

gosub subtext:

return
Parrow:
dir=1
xpt(10)=l(link,20)+(cs1*l(lne,6)*(2/3))
ypt(10)=l(link,21)+(sn1*l(lne,6)*(2/3))
gosub Parrowa:
if l(lne,22)=l(link,22) then return
dir=0
if l(lne,22)>l(link,22) then dir=1 else dir=-1
xpt(10)=xpt(10)+cs1*4:ypt(10)=ypt(10)+sn1*4:gosub Parrowa:
xpt(10)=xpt(10)+cs1*1:ypt(10)=ypt(10)+sn1*1:gosub Parrowa:
return
Parrowa:
xpt(9)=xpt(10)+cs1*dir*1:ypt(9)=ypt(10)+sn1*dir*1:xpt(9)=xpt(9)+cs2*.5:ypt(9)=ypt(9)+sn2*.5
xpt(11)=xpt(10)+cs1*dir*1:ypt(11)=ypt(10)+sn1*dir*1:xpt(11)=xpt(11)-cs2*.5:ypt(11)=ypt(11)-sn2*.5
fpt=9:npt=11:gosub plotff:
return
DefaultPPat:
Phatch$(0)="":Pcolor(0)=8
Phatch$(1)="":Pcolor(1)=8
Phatch$(2)=" - ":Pcolor(2)=4
Phatch$(3)=" - - ":Pcolor(3)=4
Phatch$(4)=" - - - ":Pcolor(4)=4
Phatch$(5)="":Pcolor(5)=2
Phatch$(6)="":Pcolor(6)=3
Phatch$(7)="":Pcolor(7)=3
Phatch$(8)="  G  ":Pcolor(8)=3
Phatch$(9)="":Pcolor(9)=3
Phatch$(10)="  HS  ":Pcolor(10)=6
Phatch$(11)="  HR  ":Pcolor(11)=6
Phatch$(12)="  CHS  ":Pcolor(12)=6
Phatch$(13)="  CHR  ":Pcolor(13)=6
Phatch$(14)="  CHWS  ":Pcolor(14)=6
Phatch$(15)="  CHWR  ":Pcolor(15)=6

Phatch$(16)="  GAS  ":Pcolor(16)=6
Phatch$(17)="  OIL  ":Pcolor(17)=6
Phatch$(18)="  ST  ":Pcolor(18)=3
Phatch$(19)="  W  ":Pcolor(19)=2
Phatch$(20)="  SAN  ":Pcolor(20)=2
Phatch$(21)="  V  ":Pcolor(21)=2

Phatch$(22)="  HWS  ":Pcolor(22)=6
Phatch$(23)="  HWR  ":Pcolor(23)=6
Phatch$(24)="  CS  ":Pcolor(24)=6
Phatch$(25)="  CR  ":Pcolor(25)=6
Phatch$(26)="  SD  ":Pcolor(26)=3
Phatch$(27)="  SSD  ":Pcolor(27)=3
Phatch$(28)="":Pcolor(28)=4
Phatch$(29)="":Pcolor(29)=4
return
Psquiggle:
w(i0)=wth
hx(i0)=l(lne,20)+cs2*wth:hy(i0)=l(lne,21)+sn2*wth
sa=l(lne,3)+270:ea=sa+135:gosub fcircle:
hx(i0)=l(lne,20)-cs2*wth:hy(i0)=l(lne,21)-sn2*wth
sa=l(lne,3)+90:ea=sa+135:gosub fcircle:

return

Pdcircle:
if plotout>0 then return
gosub penpattern1:
CIRCLE l(lne,20)/sc,l(lne,21)/sc,30
gosub penpattern0:
return
Pcircle:
i0=0:sa=0:ea=360:stp=5
hx(i0)=l(lne,20):hy(i0)=l(lne,21):
if w(i0)=0 then return
if plotout>0 then if w(i0)<3 and n1<2 then gosub penpattern0:
if n=1 then gosub fcircle:
if n=2 then sa=l(lne,3)+240:ea=sa+240:gosub fcircle:
if n=3 then sa=l(lne,3)+30:ea=l(lne,3)+150:gosub fcircle::sa=l(lne,3)+210:ea=l(lne,3)+330:gosub fcircle:
return
'~'

Arch:

dct=l(lne,1)-100
sa=0:ea=360:angle=l(lne,3):gosub sncsn2:
dir1=1:dir2=1
npt=0
i0=0:length(i0)=l(lne,6):w(0)=l(lne,4)/2:d(0)=l(lne,5)/2:hx(0)=l(lne,20):hy(0)=l(lne,21)
IF l(lne,9)=1 THEN GOSUB penpattern1: ELSE GOSUB penpattern0:
ON dct+1 GOSUB AR0:,AR1:,AR2:,AR3:,AR4:,AR5:,AR6:,AR7:,AR8:,AR9:,AR10:,AR11:,AR12:,AR13:,AR14:,AR15:,AR16:,AR17:,AR18:,AR19:,AR20:,AR21:,AR22:,AR23:,AR24:,AR25:,AR26:,AR27:,AR28:,AR29:,AR30:,AR31:,AR32:,AR33:,AR34:

fpx=ofpx:fpy=ofpy
RETURN
returnpen:
gosub returnpen3:
returnpen2:
long color defpen(gpen,0),defpen(gpen,1),defpen(gpen,2),_true

return
returnpen3:

gwidth=1
if l(lne,19)=0 then return
gpen=(l(lne,19))
gpen=abs(gpen)
returnpen3a:
if gpen>99 then gwidth=fix((gpen+.01)/100):gpen=gpen-(gwidth*100)
if gpen>30 then gpen=1
return


AR0:
gpen=8
gosub returnpen:
link=l(lne,0)
GOSUB sncsn:
rad1=l(lne,4)/2
rad2=l(lne,4)/4
cx=l(lne,20):cy=l(lne,21):radius=rad1:GOSUB plotcircle:
cx=l(lne,20):cy=l(lne,21):radius=rad2:GOSUB plotcircle:
radius=+50
xpt(1)=l(lne,20)+rad1*1.5
ypt(1)=l(lne,21)
xpt(2)=l(lne,20)-rad1*1.5
ypt(2)=l(lne,21)
fpt=1:npt=2:GOSUB plotff:
xpt(1)=l(lne,20)
ypt(1)=l(lne,21)+rad1*1.5
xpt(2)=l(lne,20)
ypt(2)=l(lne,21)-rad1*1.5
npt=2:GOSUB plotff:
IF l(lne,0)=0 THEN RETURN

dx2=l(lne,20)-l(link,20):dy2=l(lne,21)-l(link,21):gosub findangles10:
if l(lne,10)=1 then l(lne,7)=(l(lne,22)-l(link,22))/dpxy

IF ABS(l(lne,7))<>0 and l(lne,10)=0 THEN rise=dpxy*l(lne,7):l(lne,8)=rise+l(lne,15):l(lne,6)=SQR(ABS(rise^2+dpxy^2)):l(lne,22)=l(l(lne,0),22)+l(lne,8)
IF l(link,0)=0 then l(link,7)=l(lne,7)
xpt(1)=l(l(lne,0),20)
ypt(1)=l(l(lne,0),21)
xpt(2)=l(lne,20)
ypt(2)=l(lne,21)
npt=2:GOSUB plotff:

if l(lne,10)>0 then gosub drawblock:
RETURN
AR1:
if l(lne,7)>0 then goto AR1b:
gpen=fix(l(lne,2)/10)
if gpen=0 then gpen=7
gosub returnpen:
i0=0
l(lne,5)=l(lne,4):d(0)=w(0)
IF l(lne,2)=0 THEN gosub flength:
if l(lne,2)<>0 then stp=5:sa=0:ea=360:gosub fellipse:
if l(lne,2)<>0 then w(0)=l(lne,8)/2:d(0)=l(lne,8)/2:stp=5:sa=0:ea=360:gosub fellipse:
return
AR1b:
gpen=7:gosub returnpen:
GOSUB getstringlength2:
wth1=l(lne,8)/2:dpth1=l(lne,8)/2:IF dpth1=0 THEN dpth1=wth1
GOSUB sncsn:
npts=ABS(l(lne,7))
IF npts>2  THEN GOSUB polygon::GOSUB plotff:
xpt=l(lne,20):ypt=l(lne,21):wth=l(lne,4):dpth=l(lne,5)
cs1=1:sn1=0:cs2=0:sn2=-1
IF l(lne,3)<>0 THEN cs1=COS(gpi#*l(lne,3)):sn1=-SIN(gpi#*l(lne,3)):cs2=COS(gpi#*(l(lne,3)+90)):sn2=-SIN(gpi#*(l(lne,3)+90))
xpt=xpt-(cs1*(l(lne,22)/2)):ypt=ypt-(sn1*(l(lne,22)/2))
xpt=xpt-(cs2*(l(lne,4)/2)):ypt=ypt-(sn2*(l(lne,4)/2))
llst$=lst$(lne):GOSUB text:
return

AR2:
'gpen=fix(l(lne,2)/10)
gpen=7
gosub returnpen:
gosub sncsn:
IF plotout=0 THEN CIRCLE l(lne,20)/sc,l(lne,21)/sc,2

IF l(lne,2)=0 THEN gosub flength::return
i0=0:npt=0

hx(i0)=l(lne,20)-cs1*d(i0)*sgn(l(lne,15)):hy(i0)=l(lne,21)-sn1*d(i0)*sgn(l(lne,15))
hx(i0)=hx(i0)-cs2*w(i0)*sgn(l(lne,14)):hy(i0)=hy(i0)-sn2*w(i0)*sgn(l(lne,14))
gosub fsquare:

if l(lne,2)=1 then xpt(6)=xpt(3)+cs1*4:ypt(6)=ypt(3)+sn1*4:xpt(7)=xpt(3)-cs2*4:ypt(7)=ypt(3)-sn2*4:fpt=6:npt=7:GOSUB plotff2:
if l(lne,2)=2 then xpt(6)=xpt(4)+cs1*4:ypt(6)=ypt(4)+sn1*4:xpt(7)=xpt(4)+cs2*4:ypt(7)=ypt(4)+sn2*4:fpt=6:npt=7:GOSUB plotff2:
if l(lne,2)=3 then xpt(6)=xpt(1)-cs1*4:ypt(6)=ypt(1)-sn1*4:xpt(7)=xpt(1)+cs2*4:ypt(7)=ypt(1)+sn2*4:fpt=6:npt=7:GOSUB plotff2:
if l(lne,2)=4 then xpt(6)=xpt(2)-cs1*4:ypt(6)=ypt(2)-sn1*4:xpt(7)=xpt(2)-cs2*4:ypt(7)=ypt(2)-sn2*4:fpt=6:npt=7:GOSUB plotff2:

RETURN
AR3:
gpen=3:gosub returnpen:
i0=0:sa=0:ea=360:stp=5
if l(lne,2)<>0 or l(lne,3)<>0 then sa=l(lne,2):ea=l(lne,3):if ea<sa then ea=ea+360
angle=ea-sa:if angle<5 then stp=(angle/2)
gosub fcircle:
RETURN

AR4:
gpen=3:gosub returnpen:
swap w(0),d(0)
w(0)=w(0)-l(lne,8):d(0)=d(0)-l(lne,8)
gosub fsquare:
RETURN
AR5:
gpen=3:gosub returnpen:
IF l(lne,2)=0 THEN if l(lne,7)=0 then goto flength: else goto flength2:

i0=0:sa=0:ea=360:stp=5
gosub fcircle:
if l(lne,5)>0 and l(lne,5)<>l(lne,4) then swap d(0),w(0):gosub fcircle: 
RETURN
AR6:
gpen=3:gosub returnpen:
IF l(lne,2)=0 THEN if l(lne,7)=0 then goto flength: else goto flength2:
swap w(0),d(0)
w(0)=w(0)-l(lne,8):d(0)=d(0)-l(lne,8)
gosub fsquare:

RETURN

AR7:
gpen=1
gosub returnpen:
if l(lne,0)>0 and (l(link,20)=0 and l(link,21)=0) or  (l(lne,20)=0 and l(lne,21)=0) then l(lne,0)=0:return
IF l(lne,0)=0 THEN RETURN
xpt(1)=l(l(lne,0),20):ypt(1)=l(l(lne,0),21)
xpt(2)=l(lne,20):ypt(2)=l(lne,21)
fpt=1:npt=2:GOSUB plotff2:
return
AR8:
gpen=1
gosub returnpen:
angle3=l(lne,3)+45:gosub sncsn3:
dontdraw=1
IF l(lne,2)=0 THEN gosub flength::hx(0)=hx(0)+cs1*l(lne,6)/2:hy(0)=hy(0)+sn1*l(lne,6)/2:d(i0)=l(lne,6)/2
if l(lne,2)<>0 then gosub fsquare:
if l(lne,2)<>0 and l(lne,5)=0 then d(i0)=w(i0):stp=5:sa=0:ea=360:gosub fellipse:
dontdraw=0

fpt2=fpt:npt2=npt
'if l(lne,2)<>0 then w(0)=l(lne,8)/2:d(0)=l(lne,8)/2:stp=5:sa=0:ea=360:gosub fellipse:
if l(lne,7)=2 then stp2=2
if l(lne,8)=0 then stp=4 else stp=l(lne,8)

AR8i:
dir=1
for i=0 to d(i0)*3 step stp
hx=hx(i0)+cs1*i*dir
hy=hy(i0)+sn1*i*dir
gosub AR8a:
next i
dir=-1
for i=0 to d(i0)*3 step stp
hx=hx(i0)+cs1*i*dir
hy=hy(i0)+sn1*i*dir
gosub AR8a:
next i
if stp2=2 then stp2=0:angle3=l(lne,3)-45:gosub sncsn3::goto AR8i:
return
AR8a:
xpt3#=hx
ypt3#=hy
xpt4#=hx+cs3*10
ypt4#=hy+sn3*10

n=1
cnt=0
for ii=fpt2 to npt2
xpt1#=xpt(ii)
ypt1#=ypt(ii)

xpt2#=xpt(ii+1)
ypt2#=ypt(ii+1)
gosub AR8b:
if found=1 then xpt(npt2+n)=x#:ypt(npt2+n)=y#:n=n+1:cnt=cnt+1
next ii
if cnt=0 then return
fpt=npt2+1:npt=npt2+2:gosub plotff::n=0:cnt=0
return
AR8b:
found=0
del#=(xpt1#-xpt2#)*(ypt4#-ypt3#)-(ypt1#-ypt2#)*(xpt4#-xpt3#):IF del#=0 THEN RETURN
rmu#=((ypt4#-ypt3#)*(xpt4#-xpt2#)-(xpt4#-xpt3#)*(ypt4#-ypt2#))/del#
if rmu#<0 or rmu#>1 then return
x#=rmu#*xpt1#+(1-rmu#)*xpt2#
y#=rmu#*ypt1#+(1-rmu#)*ypt2#
found=1
return
AR9:
gpen=6:gosub returnpen:
if l(lne,2)=0 then l(lne,2)=1
IF l(lne,2)=1 THEN GOTO fibeam:
if l(lne,2)=2 then npt=0:stp=5:goto fellipse:
if l(lne,2)=3 then goto fsquare:

RETURN


AR10:
gpen=7
gosub returnpen:
if plotout>0 then PRINT #7,"PW",defpen(7,1);
GOSUB getstringlength2:
GOSUB sncsn:
GOSUB AR10options::GOSUB sncsn:
IF l(lne,4)=0 AND l(lne,5)=0 THEN l(lne,4)=lheight:l(lne,5)=lwth
xpt=l(lne,20):ypt=l(lne,21)
xpt=xpt+(cs1*l(lne,13)):ypt=ypt+(sn1*l(lne,13))
xpt=xpt+(cs2*l(lne,8)):ypt=ypt+(sn2*l(lne,8))
IF l(lne,2)<>0 and l(lne,7)<200 THEN cs1=COS(gpi#*l(lne,2)):sn1=-SIN(gpi#*l(lne,2)):cs2=COS(gpi#*(l(lne,2)+90)):sn2=-SIN(gpi#*(l(lne,2)+90))
wth=l(lne,4):dpth=l(lne,5)
gosub returnpen:
if plotout>0 then PRINT #7,"PW",defpen(gpen,1);
if plotout>0 and gpen=7 and l(lne,4)>=6 then PRINT #7,"PW",defpen(8,1);
llst$=lst$(lne):GOSUB text:
RETURN

AR11:
gpen=7:gosub returnpen:
GOSUB getstringlength2:
wth1=l(lne,8)/2:dpth1=l(lne,13)/2:IF dpth1=0 THEN dpth1=wth1
GOSUB sncsn:
npts=ABS(l(lne,7))
IF npts=1 THEN GOSUB AR1:
IF npts=2 THEN i0=1:npt=1:hx(i0)=l(lne,20):hy(i0)=l(lne,21):sa=0:ea=360:w(i0)=wth1:stp=5:GOSUB fcircle:
IF npts>2  THEN GOSUB polygon::GOSUB plotff:
IF l(lne,6)>0 THEN fpt=1:npt=2:xpt(1)=l(lne,20)+(cs1*wth1):ypt(1)=l(lne,21)+(sn1*wth1):xpt(2)=l(lne,20)+(cs1*l(lne,6)):ypt(2)=l(lne,21)+(sn1*l(lne,6)):GOSUB plotff:
xpt=l(lne,20):ypt=l(lne,21):wth=l(lne,4):dpth=l(lne,5)
cs1=1:sn1=0:cs2=0:sn2=-1
IF l(lne,2)<>0 THEN cs1=COS(gpi#*l(lne,2)):sn1=-SIN(gpi#*l(lne,2)):cs2=COS(gpi#*(l(lne,2)+90)):sn2=-SIN(gpi#*(l(lne,2)+90))
gosub AR31a:
RETURN
polygon:
IF npts=0 THEN RETURN
stp=360/npts
fpt=1:npt=0
FOR a=0 TO 360 STEP stp
aa=l(lne,3)+a
wth2=COS(gpi#*a)*wth1
dpth2=-SIN(gpi#*a)*dpth1
npt=npt+1
xpt(npt)=l(lne,20)+COS(gpi#*l(lne,3))*wth2
ypt(npt)=l(lne,21)-SIN(gpi#*l(lne,3))*wth2
xpt(npt)=xpt(npt)+COS(gpi#*(l(lne,3)+90))*dpth2
ypt(npt)=ypt(npt)-SIN(gpi#*(l(lne,3)+90))*dpth2

NEXT a
RETURN
AR10options:
wth=l(lne,4)
IF l(lne,7)=115 OR l(lne,7)=116 THEN GOTO AR1098:
IF l(lne,7)>100 and l(lne,7)<200 THEN GOTO AR10b0:
choice1=fix(l(lne,7)/10):IF choice1<0 THEN choice1=0
choice=l(lne,7)-(choice1*10)
if l(lne,7)>199 then goto AR10a2:
IF l(lne,6)>0 then gosub AR10a1:
IF l(lne,8)>(2.2*one) OR l(lne,8)<(-l(lne,4)-(2.2*one)) THEN IF choice1>0 THEN GOSUB AR10a2:
RETURN
AR1098:
sgna1=SGN(l(lne,8)):sgna2=SGN(l(lne,13))
IF l(lne,7)=116 THEN IF l(lne,8)<0 THEN radius=ABS(l(lne,8))-l(lne,22)+l(lne,5) ELSE radius=ABS(l(lne,8))+l(lne,5)
IF l(lne,7)=116 THEN IF l(lne,13)<0 THEN l(lne,13)=-(radius+1) ELSE l(lne,13)=radius+l(lne,4)+one

IF l(lne,7)=115 THEN radius=ABS(l(lne,8))+(l(lne,4)*.5*sgna1):IF l(lne,13)<0 THEN l(lne,13)=-(radius+l(lne,22)) ELSE l(lne,13)=radius
cx=l(lne,20)+(cs1*radius*sgna2):cy=l(lne,21)+(sn1*radius*sgna2)
IF sgna1>0 THEN IF sgna2<0 THEN sa=l(lne,3)+360-30:ea=sa+120:sa2=sa+180:ea2=sa2+60 ELSE sa=l(lne,3)+90:ea=sa+120:sa2=l(lne,3)+330:ea2=sa2+60
IF sgna1<0 THEN IF sgna2<0 THEN sa=l(lne,3)+270:ea=sa+120:sa2=l(lne,3)+150:ea2=sa2+60 ELSE sa=l(lne,3)+150:ea=sa+120:sa2=l(lne,3)+330:ea2=sa2+60
GOSUB plotarc:
length=COS(gpi#*30)*radius
cx=cx-(cs1*length*2*sgna2):cy=cy-(sn1*length*2*sgna2)
sa=sa2:ea=ea2
GOSUB plotarc:
RETURN


AR10a1:
dir=1:i0=1
GOSUB Centershaft:
IF choice=0 THEN node=2:dir=1:endopt=1:GOSUB optionline::node=1:dir=-1:endopt=1:GOSUB optionline:
IF choice=1 THEN node=2:dir=1:endopt=2:GOSUB optionline::node=1:dir=-1:endopt=2:GOSUB optionline:
IF choice=2 THEN node=2:dir=1:endopt=3:GOSUB optionline::node=1:dir=-1:endopt=3:GOSUB optionline:
IF choice=3 THEN node=2:dir=1:endopt=2:GOSUB optionline:
IF choice=4 THEN node=1:dir=-1:endopt=2:GOSUB optionline:
IF choice=5 THEN node=2:dir=1:endopt=2:GOSUB optionline::node=1:dir=-1:endopt=3:GOSUB optionline:
IF choice=6 THEN node=2:dir=1:endopt=3:GOSUB optionline::node=1:dir=-1:endopt=2:GOSUB optionline:
IF choice=7 THEN node=2:dir=-1:endopt=2:GOSUB optionline::dir=1:node=1:endopt=2:GOSUB optionline:
RETURN
optionline:
ON endopt GOSUB tickline:,arrowhead:,circlehead:
GOSUB extentionline:

RETURN
Centershaft:
IF l(lne,8)=0 THEN l(lne,8)=l(lne,4)*.2
fpt=1:npt=2
xpt(1)=l(lne,20)
ypt(1)=l(lne,21)
xpt(2)=l(lne,20)+cs1*l(lne,6)
ypt(2)=l(lne,21)+sn1*l(lne,6)
IF choice<7 THEN GOSUB plotff::RETURN
xpt(3)=xpt(1)-cs1*wth*2:ypt(3)=ypt(1)-sn1*wth*2:xpt(4)=xpt(2)+cs1*wth*2:ypt(4)=ypt(2)+sn1*wth*2
fpt=1:npt=3:GOSUB plotff2:
fpt=2:npt=4:GOSUB plotff2:
fpt=1:npt=2
RETURN
AR10a2:
choice2=0
GOSUB sncsn:
length=l(lne,6)/2
if l(lne,7)=200 then length=0
xpt(1)=l(lne,20)+cs1*length
ypt(1)=l(lne,21)+sn1*length
L1=l(lne,8)+(l(lne,4)/2)
L2=l(lne,13)-length
l3=L2+l(lne,22)
IF L2<0 AND l3<0 THEN GOSUB lcase1:
IF L2<0 AND l3>=0 THEN GOSUB lcase2:
IF L2>0 THEN GOSUB lcase3:
if l(lne,7)>199 then goto parallelnes::
'node=1:dir=-SGN(l(lne,8)):SWAP cs1,cs2:SWAP sn1,sn2
'IF choice2=1 THEN GOSUB sncsn2:
node=1:dir=1:dx2=xpt(1)-xpt(2):dy2=ypt(1)-ypt(2):gosub findangles10::GOSUB sncsn2:

ON choice1 GOSUB nohead:,arrowhead:,circlehead:,linehead:
GOSUB sncsn:
RETURN
lcase1:
l3=l3+l(lne,4)/2
xpt(2)=xpt(1)+cs2*L1:ypt(2)=ypt(1)+sn2*L1
xpt(3)=xpt(2)+cs1*l3:ypt(3)=ypt(2)+sn1*l3
IF ABS(l3)>ABS(L1) THEN xpt(2)=xpt(2)-(cs1*ABS(L1)):ypt(2)=ypt(2)-(sn1*ABS(L1)):choice2=1:angle=l(lne,3)+135:IF l(lne,8)<0 THEN angle=l(lne,3)+45
fpt=1:npt=3:GOSUB plotff:

RETURN
lcase2:
L1=L1-(l(lne,4)*SGN(L1))
xpt(2)=xpt(1)+cs2*L1:ypt(2)=ypt(1)+sn2*L1
fpt=1:npt=2:GOSUB plotff:

RETURN
lcase3:
L2=L2-l(lne,4)/2
xpt(2)=xpt(1)+cs2*L1:ypt(2)=ypt(1)+sn2*L1
xpt(3)=xpt(2)+cs1*L2:ypt(3)=ypt(2)+sn1*L2
IF ABS(L2)>ABS(L1) THEN xpt(2)=xpt(2)+(cs1*ABS(L1)):ypt(2)=ypt(2)+(sn1*ABS(L1)):choice2=1:angle=l(lne,3)+45:IF l(lne,8)<0 THEN angle=l(lne,3)+135
fpt=1:npt=3:GOSUB plotff:

RETURN
AR10a200:
return

AR10b0:

w=l(lne,4):w2=l(lne,4)/2:l=l(lne,22)+w:L2=w*2
xpt=l(lne,20):ypt=l(lne,21)
xpt=xpt+(cs1*l(lne,13)):ypt=ypt+(sn1*l(lne,13))
xpt=xpt+(cs2*l(lne,8)):ypt=ypt+(sn2*l(lne,8))
xpt(1)=xpt-cs2*w2:ypt(1)=ypt-sn2*w2
xpt(1)=xpt(1)-cs1*w2:ypt(1)=ypt(1)-sn1*w2
xpt(2)=xpt(1)+cs1*l:ypt(2)=ypt(1)+sn1*l
xpt(4)=xpt(1)+cs2*L2:ypt(4)=ypt(1)+sn2*L2
xpt(3)=xpt(2)+cs2*L2:ypt(3)=ypt(2)+sn2*L2
choice=l(lne,7)-100
IF choice=1 THEN fpt=2:npt=3:GOSUB plotff2::GOSUB swpsncsn::node=3:dir=1:GOSUB arrowhead:
IF choice=5 THEN fpt=2:npt=3:GOSUB plotff2::GOSUB swpsncsn::node=2:dir=-1:GOSUB arrowhead:

IF choice=2 THEN fpt=1:npt=4:GOSUB plotff2::GOSUB swpsncsn::node=4:dir=1:GOSUB arrowhead:
IF choice=6 THEN fpt=1:npt=4:GOSUB plotff2::GOSUB swpsncsn::node=1:dir=-1:GOSUB arrowhead:

IF choice=3 THEN fpt=3:npt=4:GOSUB plotff2::node=3:dir=1:GOSUB arrowhead:
IF choice=7 THEN fpt=3:npt=4:GOSUB plotff2::node=4:dir=-1:GOSUB arrowhead:

IF choice=4 THEN fpt=1:npt=2:GOSUB plotff2::node=2:dir=1:GOSUB arrowhead:
IF choice=8 THEN fpt=1:npt=2:GOSUB plotff2::node=1:dir=-1:GOSUB arrowhead:

RETURN
swpsncsn:
SWAP sn1,sn2:SWAP cs1,cs2
RETURN
nohead:
RETURN
linehead:
xpt(node+1)=xpt(node)+(cs1*dir*wth*2)
ypt(node+1)=ypt(node)+(sn1*dir*wth*2)
fpt=node:npt=node+1
GOSUB plotff:

RETURN
circlehead:
i0=0:hx(i0)=xpt(node):hy(i0)=ypt(node):sa=0:ea=360:stp=5
w(i0)=wth*.3:GOSUB fcircle:
w(i0)=wth*.2:GOSUB fcircle:
w(i0)=wth*.1:GOSUB fcircle:
RETURN
tickline:
fpt=3:npt=4
wth3=wth/3
xpt(3)=xpt(node)+cs1*wth3
ypt(3)=ypt(node)+sn1*wth3
xpt(3)=xpt(3)+cs2*wth3
ypt(3)=ypt(3)+sn2*wth3
xpt(4)=xpt(node)-cs1*wth3
ypt(4)=ypt(node)-sn1*wth3
xpt(4)=xpt(4)-cs2*wth3
ypt(4)=ypt(4)-sn2*wth3
GOSUB plotff:
RETURN
extentionline:
length=0
IF node=2 THEN length=l(lne,15)
IF node=1 THEN length=l(lne,14)
IF length=0 THEN RETURN
fpt=3:npt=4
xpt(3)=xpt(node)+(cs2*SGN(length)*wth*(.4*one)):ypt(3)=ypt(node)+(sn2*SGN(length)*wth*(.4*one))
xpt(4)=xpt(node)-(cs2*length):ypt(4)=ypt(node)-(sn2*length)
GOSUB plotff:
RETURN
arrowhead:
fpt=5:npt=7
wth3=wth/4
xpt(6)=xpt(node)
ypt(6)=ypt(node)
xpt(5)=xpt(node)-cs1*wth*dir
ypt(5)=ypt(node)-sn1*wth*dir
xpt(5)=xpt(5)+cs2*wth3
ypt(5)=ypt(5)+sn2*wth3
xpt(7)=xpt(node)-cs1*wth*dir
ypt(7)=ypt(node)-sn1*wth*dir
xpt(7)=xpt(7)-cs2*wth3
ypt(7)=ypt(7)-sn2*wth3
GOSUB plotff:
RETURN
parallelnes:
angle=l(lne,3)+l(lne,2):gosub sncsn2:
hx(0)=l(lne,20):hy(0)=l(lne,21)
xpt(6)=hx(0)
ypt(6)=hy(0)
xpt(8)=hx(0)-cs2*one
ypt(8)=hy(0)-sn2*one
hx(0)=l(lne,20)+cs1*l(lne,6):hy(0)=l(lne,21)+sn1*l(lne,6)
xpt(7)=hx(0)
ypt(7)=hy(0)
xpt(9)=hx(0)-cs2*one
ypt(9)=hy(0)-sn2*one
fpt=6:npt=7:GOSUB plotff:
fpt=8:npt=9:GOSUB plotff:
RETURN
AR12:
gpen=1:gosub returnpen:
sa=l(lne,2)
ea=l(lne,3)
IF sa>ea THEN ea=ea+360
IF sa=ea THEN RETURN
IF l(lne,8)=0 THEN l(lne,8)=(ea-sa)/5
cx=l(lne,20):cy=l(lne,21)
radius=0
incr=(ea-sa)/l(lne,8)
FOR t=4 TO 7
IF l(lne,t)>0 THEN radius=l(lne,t)
fpt=0:npt=0
IF l(lne,t)>0 THEN GOSUB A12a:
NEXT t
IF l(lne,10)=0 THEN RETURN
FOR t=10 TO 18
radius=radius+l(lne,t)
fpt=0:npt=0
IF l(lne,t)>0 THEN GOSUB A12a:
NEXT t
RETURN
A12a:
FOR angle=sa TO ea STEP incr
xpt(npt)=cx+(COS(gpi#*angle)*radius)
ypt(npt)=cy-(SIN(gpi#*angle)*radius)
npt=npt+1
NEXT angle
xpt(npt)=cx+(COS(gpi#*ea)*radius)
ypt(npt)=cy-(SIN(gpi#*ea)*radius)
GOSUB plotff:

return
AR13:
gpen=1
if l(lne,7)>0 then gpen=l(lne,7)
gosub returnpen:
xpt(1)=hx(0)
ypt(1)=hy(0)
xpt(2)=hx(0)+cs1*l(lne,6)
ypt(2)=hy(0)+sn1*l(lne,6)
fpt=1:npt=2:GOSUB plotff:
hx(1)=xpt(2)-cs1*l(lne,5):hy(1)=ypt(2)-sn1*l(lne,5)
xpt(1)=hx(1)+cs2*w(0):ypt(1)=hy(1)+sn2*w(0)
xpt(3)=hx(1)-cs2*w(0):ypt(3)=hy(1)-sn2*w(0)
fpt=1:npt=3:GOSUB plotff:
RETURN
AR14:
gpen=12
gosub returnpen:
IF l(lne,4)=0 THEN l(lne,4)=(24*one)
IF l(lne,4)=1 THEN l(lne,4)=(48*one)
IF l(lne,7)=0 THEN l(lne,7)=1
l(lne,6)=ABS(l(lne,6))
nlnes=l(lne,7)
IF plotout=0 THEN CIRCLE l(lne,20)/sc,l(lne,21)/sc,10
xpt(1)=l(lne,20)+cs2*((nlnes-1)/2)*l(lne,4)
ypt(1)=l(lne,21)+sn2*((nlnes-1)/2)*l(lne,4)
xpt(2)=xpt(1)+cs1*l(lne,6)
ypt(2)=ypt(1)+sn1*l(lne,6)
fpt=1:npt=2
distx=-cs2*l(lne,4)
disty=-sn2*l(lne,4)

FOR t=1 TO nlnes
GOSUB plotff2:
xpt(1)=xpt(1)+distx:ypt(1)=ypt(1)+disty
xpt(2)=xpt(2)+distx:ypt(2)=ypt(2)+disty

NEXT t
RETURN


AR15:
gpen=4
gosub returnpen:
IF l(lne,5)=0 THEN l(lne,5)=(24*one)
IF l(lne,4)=0 THEN l(lne,4)=(48*one)
nlnes=INT(l(lne,6)/l(lne,5))
wdth=l(lne,4)/2
xpt(1)=l(lne,20)+cs2*wdth:ypt(1)=l(lne,21)+sn2*wdth
xpt(2)=l(lne,20)-cs2*wdth:ypt(2)=l(lne,21)-sn2*wdth
IF plotout=0 THEN CIRCLE hx(0)/sc,hy(0)/sc,10
distx=cs1*l(lne,5)
disty=sn1*l(lne,5)
fpt=1:npt=2:GOSUB plotff:
FOR t=1 TO nlnes
xpt(1)=xpt(1)+distx:ypt(1)=ypt(1)+disty
xpt(2)=xpt(2)+distx:ypt(2)=ypt(2)+disty
GOSUB plotff:
NEXT t
RETURN
AR16:
gpen=7:if l(lne,10)>0 then gpen=l(lne,10)
gosub returnpen:
hx(0)=l(lne,20):hy(0)=l(lne,21)
if l(lne,2)=1 then hx(0)=hx(0)-cs1*1530:hy(0)=hy(0)-sn1*1530:hx(0)=hx(0)+cs2*1170:hy(0)=hy(0)+sn2*1170
if l(lne,2)=2 then hx(0)=hx(0)-cs1*2431:hy(0)=hy(0)-sn1*2431:hx(0)=hx(0)+cs2*1833:hy(0)=hy(0)+sn2*1833
if l(lne,2)=3 then l(lne,20)=l(lne,20)-cs1*(2431-1530):l(lne,21)=l(lne,21)+sn1*(2431-1530):l(lne,20)=l(lne,20)-cs2*(1833-1170):l(lne,21)=l(lne,21)+sn2*(1833-1170):l(lne,2)=1:goto AR16:
if l(lne,2)=4 then l(lne,20)=l(lne,20)+cs1*(2431-1530):l(lne,21)=l(lne,21)-sn1*(2431-1530):l(lne,20)=l(lne,20)+cs2*(1833-1170):l(lne,21)=l(lne,21)-sn2*(1833-1170):l(lne,2)=2:goto AR16:
if l(lne,4)=0 and l(lne,5)=0 then l(lne,4)=2150:l(lne,5)=1630:l(lne,7)=140:l(lne,8)=544
gosub IndentRect:
if plotout=0 then fpt=1:gosub plotff:
if l(lne,10)>0 then pwin=l(lne,10):for i=1 to npt:pagx(pwin,i)=xpt(i):pagy(pwin,i)=ypt(i):next i:npag(pwin)=npt:pagdx(pwin)=l(lne,13):pagdy(pwin)=l(lne,14)
if plotout=0 then if l(lne,13)<>0 or l(lne,14)<>0 then gosub penpattern1::for i=1 to npt:xpt(i)=xpt(i)+l(lne,13):ypt(i)=ypt(i)+l(lne,14):next i:gosub plotff:
RETURN


IndentRect:
IF l(lne,7)=0 OR l(lne,8)=0 THEN goto IndentSqr:
hx(1)=hx(0)-cs1*(w(0))
hy(1)=hy(0)-sn1*(w(0))
xpt(1)=hx(1)+cs2*(d(0))
ypt(1)=hy(1)+sn2*(d(0))
xpt(6)=hx(1)-cs2*(d(0))
ypt(6)=hy(1)-sn2*(d(0))
hx(1)=hx(0)+cs1*(w(0))
hy(1)=hy(0)+sn1*(w(0))
xpt(2)=hx(1)+cs2*(d(0))
ypt(2)=hy(1)+sn2*(d(0))
xpt(3)=hx(1)-cs2*(d(0)-l(lne,7))
ypt(3)=hy(1)-sn2*(d(0)-l(lne,7))
xpt(4)=xpt(3)-cs1*(l(lne,8))
ypt(4)=ypt(3)-sn1*(l(lne,8))
xpt(5)=xpt(4)-cs2*(l(lne,7))
ypt(5)=ypt(4)-sn2*(l(lne,7))
xpt(7)=xpt(1):ypt(7)=ypt(1)
npt=7

RETURN
IndentSqr:
hx(1)=hx(0)-cs1*(w(0))
hy(1)=hy(0)-sn1*(w(0))
xpt(1)=hx(1)+cs2*(d(0))
ypt(1)=hy(1)+sn2*(d(0))
xpt(4)=hx(1)-cs2*(d(0))
ypt(4)=hy(1)-sn2*(d(0))
hx(1)=hx(0)+cs1*(w(0))
hy(1)=hy(0)+sn1*(w(0))
xpt(2)=hx(1)+cs2*(d(0))
ypt(2)=hy(1)+sn2*(d(0))
xpt(3)=hx(1)-cs2*(d(0))
ypt(3)=hy(1)-sn2*(d(0))
xpt(5)=xpt(1):ypt(5)=ypt(1)
npt=5

RETURN
AR17:
gosub sncsn:
gpen=1:gosub returnpen:
if l(lne,6)=0 or l(lne,4)=0 or l(lne,7)=0 or l(lne,8)=0 or l(lne,2)>0 then return
diff=l(lne,7)
incr=l(lne,8)
l(lne,10)=cs1
l(lne,11)=sn1
l(lne,12)=w(0)
xpt(1)=hx(0)-cs2*w(0):ypt(1)=hy(0)-sn2*w(0)
xpt(2)=xpt(1)+cs1*diff:ypt(2)=ypt(1)+sn1*diff
xpt(2)=xpt(2)+cs2*l(lne,4):ypt(2)=ypt(2)+sn2*l(lne,4)
fpt=1:npt=2:gosub plotff:

dist=l(lne,6)-diff
AR17a:
dist=dist-incr
if dist<0 then return
xpt(1)=xpt(1)+cs1*incr:ypt(1)=ypt(1)+sn1*incr
xpt(2)=xpt(2)+cs1*incr:ypt(2)=ypt(2)+sn1*incr
gosub plotff2:
goto AR17a:

RETURN

AR18:
gpen=8:gosub returnpen:
hx(0)=l(lne,20)+cs1*12:hy(0)=l(lne,21)+sn1*12
dist=12
AR18a:
hx(1)=hx(0)+cs2*1.25:hy(1)=hy(0)+sn2*1.25
for t=1 to 8
hx(1)=hx(1)-cs2*.25:hy(1)=hy(1)-sn2*.25
xpt(1)=hx(1)-cs1*12:ypt(1)=hy(1)-sn1*12
xpt(2)=hx(1)+cs1*12:ypt(2)=hy(1)+sn1*12
fpt=1:npt=2:gosub plotff:
next t
dist=dist+48
if l(lne,6)>dist then hx(0)=hx(0)+cs1*48:hy(0)=hy(0)+sn1*48:goto AR18a:

RETURN
AR19:
goto AR10:
RETURN
AR20:
gpen=3:gosub returnpen:
IF l(lne,4)=0 THEN l(lne,4)=8
dist=SQR(ABS((l(lne,13)^2)+(l(lne,14)^2))):IF dist=0 OR dist>300 THEN RETURN
GOSUB sncsn:
wth=l(lne,4)/2
IF l(lne,7)=1 OR l(lne,7)=3 THEN i0=1:npt=4:hx(i0)=l(lne,20):hy(i0)=l(lne,21):sa=0:ea=360:w(i0)=wth:stp=5:GOSUB fcircle:
hx=l(lne,20):hy=l(lne,21)
xpt(1)=hx+cs2*wth:ypt(1)=hy+sn2*wth
xpt(4)=hx-cs2*wth:ypt(4)=hy-sn2*wth
IF (l(lne,11)=1 OR l(lne,11)=3) THEN hx(1)=l(lne,20):hy(1)=l(lne,21) ELSE hx(1)=l(lne,20)+cs1*wth:hy(1)=l(lne,21)+sn1*wth
xpt(2)=hx(1)+cs2*wth:ypt(2)=hy(1)+sn2*wth
xpt(3)=hx(1)-cs2*wth:ypt(3)=hy(1)-sn2*wth
fpt=1:npt=4:GOSUB plotff:

hx(4)=l(lne,20)+l(lne,13):hy(4)=l(lne,21)+l(lne,14)
IF l(lne,7)=2 OR l(lne,7)=3 THEN i0=4:npt=4:sa=0:ea=360:w(i0)=wth:stp=5:GOSUB fcircle:
cs01=COS(gpi#*l(lne,2)):sn01=-SIN(gpi#*l(lne,2))
cs02=COS(gpi#*(l(lne,2)+90)):sn02=-SIN(gpi#*(l(lne,2)+90))
xpt(1)=hx(4)+cs02*wth:ypt(1)=hy(4)+sn02*wth
xpt(4)=hx(4)-cs02*wth:ypt(4)=hy(4)-sn02*wth
IF (l(lne,11)=2 OR l(lne,11)=3) THEN hx(4)=hx(4):hy(4)=hy(4) ELSE hx(4)=hx(4)-cs01*wth:hy(4)=hy(4)-sn01*wth
xpt(2)=hx(4)+cs02*wth:ypt(2)=hy(4)+sn02*wth
xpt(3)=hx(4)-cs02*wth:ypt(3)=hy(4)-sn02*wth
fpt=1:npt=4:GOSUB plotff:

hx(3)=hx(4)-cs01*l(lne,6):hy(3)=hy(4)-sn01*l(lne,6)
hx(2)=hx(1)+cs1*l(lne,6):hy(2)=hy(1)+sn1*l(lne,6)
rad1=l(lne,4):IF l(lne,8)>0 THEN rad1=l(lne,8)
dx2=hx(3)-hx(2):dy2=hy(3)-hy(2):GOSUB findangles10::dist(2)=dpxy
dist(1)=SQR(ABS(((hx(2)-hx(1))^2)+((hy(2)-hy(1))^2)))
dist(3)=SQR(ABS(((hx(4)-hx(3))^2)+((hy(4)-hy(3))^2)))
aa(1)=l(lne,3):aa(2)=angle:aa(3)=l(lne,2)

hx3=hx(1):hy3=hy(1):a2=aa(2):angle1=aa(1):vert=2:n1=1:GOSUB curflex::dist(2)=dist(2)-elength
a2=aa(3):angle1=aa(2):vert=3:n1=2:GOSUB curflex::dist(3)=dist(3)-elength
elength=0:angle1=aa(3):n1=3:IF dist(3)>0 THEN GOSUB strflex:
RETURN

curflex:
arctan=a2-angle1:IF ABS(arctan)>180 THEN arctan=arctan+(SGN(arctan*-1)*360)
ttan=TAN(gpi#*(arctan/2))
elength=rad1*ABS(ttan)
IF dist(n1)-elength>0 THEN GOSUB strflex:
hx3=hx(vert)+COS(gpi#*a2)*elength:hy3=hy(vert)-SIN(gpi#*a2)*elength
IF dist(n1)<elength THEN RETURN
cx=hx(vert)-COS(gpi#*angle1)*elength:cy=hy(vert)+SIN(gpi#*angle1)*elength
IF ttan=>0 THEN cx=cx+(COS(gpi#*(angle1+90))*rad1):cy=cy-(SIN(gpi#*(angle1+90))*rad1)
IF ttan<0 THEN cx=cx-(COS(gpi#*(angle1+90))*rad1):cy=cy+(SIN(gpi#*(angle1+90))*rad1)
IF ttan>=0 THEN sa=(angle1-90):ea=sa+(arctan)
IF ttan<0 THEN sa=(a2+90):ea=sa-(arctan)
radius=rad1
fpt=1:npt=1
stp=wth/4
stp=stp/(rad1*.00872653#*(2*one))
stp=ABS(arctan)/stp:nstp=INT((stp+1)/2)*(2*one)
IF stp>1 THEN stp=ABS(arctan)/nstp ELSE RETURN

wth2=wth*.8:t=0

FOR angle2=sa TO ea STEP stp
hx=cx+(COS(gpi#*angle2)*radius)
hy=cy-(SIN(gpi#*angle2)*radius)
IF l(lne,10)<>1 THEN GOSUB plotflex2: ELSE xpt(npt)=hx:ypt(npt)=hy:npt=npt+1
NEXT angle2

IF l(lne,10)=1 THEN npt=npt-1:GOSUB plotff:
RETURN
strflex:
cs01=COS(gpi#*angle1):sn01=-SIN(gpi#*angle1)
cs02=COS(gpi#*(angle1+90)):sn02=-SIN(gpi#*(angle1+90))

fpt=1:npt=2
dist1=dist(n1)-elength
IF l(lne,10)=1 THEN xpt(1)=hx3:ypt(1)=hy3:xpt(2)=xpt(1)+cs01*dist1:ypt(2)=ypt(1)+sn01*dist1:goto plotff:
hx=hx3:hy=hy3
stp=wth/4:stp=dist1/stp:nstp=INT((stp+1)/2)*2
IF nstp>1 THEN stp=dist1/nstp ELSE RETURN
wth2=wth:t=0
GOSUB plotflex:
FOR t=1 TO nstp
hx=hx+cs01*stp
hy=hy+sn01*stp
IF wth2=wth THEN wth2=wth*.8 ELSE wth2=wth
GOSUB plotflex:
NEXT t
RETURN
plotflex:
xpt(1)=hx+cs02*wth2
ypt(1)=hy+sn02*wth2
xpt(2)=hx-cs02*wth2
ypt(2)=hy-sn02*wth2
fpt=1:npt=2:GOSUB plotff:
IF t>0 THEN fpt=1:npt=3:GOSUB plotff2::fpt=2:npt=4:GOSUB plotff2:
xpt(3)=xpt(1)
ypt(3)=ypt(1)
xpt(4)=xpt(2)
ypt(4)=ypt(2)

RETURN
plotflex2:
IF wth2=wth THEN wth2=wth*.8 ELSE wth2=wth
xpt(1)=hx+COS(gpi#*angle2)*wth2
ypt(1)=hy-SIN(gpi#*angle2)*wth2
xpt(2)=hx-COS(gpi#*angle2)*wth2
ypt(2)=hy+SIN(gpi#*angle2)*wth2
fpt=1:npt=2:GOSUB plotff:
IF angle2<>sa THEN fpt=1:npt=3:GOSUB plotff2::fpt=2:npt=4:GOSUB plotff2:
xpt(3)=xpt(1)
ypt(3)=ypt(1)
xpt(4)=xpt(2)
ypt(4)=ypt(2)

RETURN
AR21:
gpen=6:gosub returnpen:

if length(0)=0 then length(0)=240
if w(0)=0 then w(0)=6
if l(lne,8)>0 then half=l(lne,8) else half=1
w(0)=w(0)*2
w(1)=.75
hx(1)=hx(0)-cs2*w(1)
hy(1)=hy(0)-sn2*w(1)
length(1)=length(0)
i0=1:npt=0:gosub flength:

xpt(3)=xpt(3)+cs2:ypt(3)=ypt(3)+sn2:xpt(4)=xpt(4)+cs2:ypt(4)=ypt(4)+sn2:gosub plotff:
hx(1)=hx(0)-cs2*2:hy(1)=hy(0)-sn2*2:w(1)=.5:length(1)=10:i0=1:npt=0:gosub flength::xpt1#=xpt(2):ypt1#=ypt(2)
hx(1)=hx(1)+cs1*(length(0)-10):hy(1)=hy(1)+sn1*(length(0)-10):npt=0:gosub flength::xpt2#=xpt(1):ypt2#=ypt(1)
d(1)=.75
d(2)=w(0)-1.5
d(3)=d(2)-1.5
d(4)=length(0)-20
d(5)=w(0)-.75
length(2)=(length(0)/2)-10

hx(1)=hx(0)-cs2*d(5):hy(1)=hy(0)-sn2*d(5)
hx(1)=hx(1)+cs1*10:hy(1)=hy(1)+sn1*10
w(1)=.75:i0=1:length(1)=length(0)-20:npt=0:gosub flength:
xpt(1)=xpt(1)-cs2:ypt(1)=ypt(1)-sn2:xpt(2)=xpt(2)-cs2:ypt(2)=ypt(2)-sn2:gosub plotff:
w(1)=.75
d(1)=.75*half
d(2)=(w(0)-3)*half
w(2)=w(0)-3
if l(lne,7)=1 then d(1)=.4330126883:d(2)=d(2)*.4330126883/.75 
if n=0 then n=int(length(2)/d(2))-2:if ((n/2)-int(n/2))=0 then n=n-1
if l(lne,7)>0 then n=l(lne,7) else l(lne,7)=n
fpt=1:npt=2
length(1)=length(0)/2
hx(1)=hx(0)-cs2*.75:hy(1)=hy(0)-sn2*.75
hx(1)=hx(1)+cs1*length(0)/2:hy(1)=hy(1)+sn1*length(0)/2
xpt(fpt)=hx(1):ypt(fpt)=hy(1)
dir1=1:dir2=-1
gosub AR21a:
dir2=dir2*-1
xpt(3)=xpt2#:ypt(3)=ypt2#
gosub AR21b:
xpt(fpt)=hx(1):ypt(fpt)=hy(1)
dir1=-1:dir2=-1:npt=2
length(1)=length(0)/2
gosub AR21a:
xpt(3)=xpt1#:ypt(3)=ypt1#

dir2=dir2*-1
gosub AR21b:
RETURN
AR21a:
for t=0 to n
xpt(fpt)=xpt(fpt)+cs1*d(1)*dir1:ypt(fpt)=ypt(fpt)+sn1*d(1)*dir1
xpt(fpt)=xpt(fpt)+cs2*w(1)*dir2:ypt(fpt)=ypt(fpt)+sn2*w(1)*dir2
xpt(npt)=xpt(fpt)+cs1*d(2)*dir1:ypt(npt)=ypt(fpt)+sn1*d(2)*dir1
xpt(npt)=xpt(npt)+cs2*w(2)*dir2:ypt(npt)=ypt(npt)+sn2*w(2)*dir2

gosub plotff:
xpt(fpt)=xpt(npt):ypt(fpt)=ypt(npt)
xpt(fpt)=xpt(fpt)+cs1*d(1)*dir1:ypt(fpt)=ypt(fpt)+sn1*d(1)*dir1
xpt(fpt)=xpt(fpt)+cs2*w(1)*dir2:ypt(fpt)=ypt(fpt)+sn2*w(1)*dir2
dir2=dir2*-1
next t
return
AR21b:
xpt(fpt)=xpt(fpt)-cs2*w(1)*dir2:ypt(fpt)=ypt(fpt)-sn2*w(1)*dir2
xpt(npt)=xpt(fpt)-cs2*w(2)*dir2:ypt(npt)=ypt(fpt)-sn2*w(2)*dir2
npt=3
gosub plotff:

return
AR22:
npt=0
if l(lne,4)=0 then w(0)=12
if l(lne,6)=0 then length(0)=120
gpen=6:gosub returnpen:
hx(0)=hx(0)-cs2*w(0):hy(0)=hy(0)-sn2*w(0)
dontdraw=1:gosub flength::dontdraw=0
angle=l(lne,2):gosub sncsn2:
xpt1#=xpt(4):ypt1#=ypt(4):xpt2#=xpt(3):ypt2#=ypt(3)
xpt4#=xpt(1):ypt4#=ypt(1)
xpt3#=xpt4#-cs2*10:ypt3#=ypt4#-sn2*10
GOSUB elength2:
xpt(4)=x#:ypt(4)=y#

ttan1#=sqr(abs((xpt3#-xpt4#)^2+(ypt3#-ypt4#)^2))/w(0)
xpt(3)=xpt(2)-cs2*w(0)*ttan1#
ypt(3)=ypt(2)-sn2*w(0)*ttan1#
fpt=1:npt=5:gosub plotff:
if l(lne,7)=1 or l(lne,7)=3 then xpt(1)=xpt(1)-cs2*ttan1#:ypt(1)=ypt(1)-sn2*ttan1#:xpt(2)=xpt(2)-cs2*ttan1#:ypt(2)=ypt(2)-sn2*ttan1#:fpt=1:npt=2:gosub plotff:
if l(lne,7)=2 or l(lne,7)=3 then xpt(3)=xpt(3)+cs2*ttan1#:ypt(3)=ypt(3)+sn2*ttan1#:xpt(4)=xpt(4)+cs2*ttan1#:ypt(4)=ypt(4)+sn2*ttan1#:fpt=3:npt=4:gosub plotff:

RETURN
AR23:
npt=0
gpen=6

if plotout=0 and l(lne,15)<>0 then gpen=4
gosub returnpen:
if l(lne,2)=1 then goto fibeam:
if l(lne,2)=2 then goto fsquare:
if l(lne,2)=3 then goto fellipse:
'if lst$(lne)="BotSlab" then botSlab=l(lne,22)-(l(lne,5)/2)
l(lne,11)=0
if l(lne,15)<>0 then gosub newdepth::l(lne,16)=ypt3# else l(lne,16)=l(lne,5)
GOSUB sncsn:
GOSUB flength:
IF l(lne,7)<>0 THEN GOSUB A23a:
RETURN

A23a:

i0=1:w(1)=1:dir=sgn(l(lne,7))
if l(lne,8)=0 then length(1)=34 else length(1)=l(lne,8)
IF abs(l(lne,7))=1 OR abs(l(lne,7))=3 THEN hx(1)=hx(0):hy(1)=hy(0)::hx(1)=hx(1)+cs2*l(lne,4)*1.5*dir:hy(1)=hy(1)+sn2*l(lne,4)*1.5*dir:GOSUB flength:
IF abs(l(lne,7))=2 OR abs(l(lne,7))=3 THEN hx(1)=hx(0)+cs1*(l(lne,6)-length(1)):hy(1)=hy(0)+sn1*(l(lne,6)-length(1)):hx(1)=hx(1)+cs2*l(lne,4)*1.5*dir:hy(1)=hy(1)+sn2*l(lne,4)*1.5*dir:GOSUB flength:
GOSUB penpattern1:
RETURN

AR24:

gpen=6

if plotout=0 and l(lne,15)<>0 then gpen=4
gosub returnpen:

if l(lne,2)>0 then goto fjoist:
if l(lne,15)<>0 then gosub newdepth::l(lne,16)=ypt3# else l(lne,16)=l(lne,5)

npt=0
hx3=hx(i0):hy3=hy(i0)
w(0)=(w(0)-.5)/2
s1=(w(0))+.5
hx(i0)=hx3+cs2*s1:hy(i0)=hy3+sn2*s1:GOSUB flength:
hx(i0)=hx3-cs2*s1:hy(i0)=hy3-sn2*s1:GOSUB flength:
IF l(lne,7)<>0 THEN GOSUB A23a:

RETURN
AR25:

npt=0
gpen=6
link=l(lne,0)
if link>0 then l(lne,20)=l(link,20)+cos(gpi#*l(link,3))*l(link,6):l(lne,21)=l(link,21)-sin(gpi#*l(link,3))*l(link,6):l(lne,22)=l(link,22)+l(link,15)
if l(lne,7)<>0 then l(lne,15)=l(lne,6)*l(lne,7)
if plotout=0 and l(lne,15)<>0 then gpen=4
if plotout=0 and l(lne,22)=0 then gpen=5
gosub returnpen:
if l(lne,2)=1 then goto fibeam:
if l(lne,2)=2 then goto fsquare:
if l(lne,2)=3 then goto fellipse:
'if lst$(lne)="BotSlab" then botSlab=l(lne,22)-(l(lne,5)/2)
l(lne,11)=0
if l(lne,15)<>0 then gosub newdepth::l(lne,16)=ypt3# else l(lne,16)=l(lne,5)
GOSUB sncsn:
if l(lne,9)<2 then GOSUB flength:
RETURN
AR26:
npt=0
gpen=6:gosub returnpen:
if l(lne,2)=1 then dir1=-1:dir2=-1:hx(0)=hx(0)-cs1*d(0)*dir1:hy(0)=hy(0)-sn1*d(0)*dir1:hx(0)=hx(0)+cs2*w(0)*dir2:hy(0)=hy(0)+sn2*w(0)*dir2:w(0)=w(0)*2:d(0)=d(0)*2:goto fcbeam:
if l(lne,2)=2 then dir1=1:dir2=1:hx(0)=hx(0)-cs1*d(0)*dir1:hy(0)=hy(0)-sn1*d(0)*dir1:hx(0)=hx(0)+cs2*w(0)*dir2:hy(0)=hy(0)+sn2*w(0)*dir2:w(0)=w(0)*2:d(0)=d(0)*2:goto fcbeam:
GOSUB sncsn:
GOSUB flength:

RETURN
AR27:
gpen=6:gosub returnpen:
gosub sncsn:
i0=0
w(0)=l(lne,4)/2:d(0)=l(lne,6)/2
i0=0:GOSUB fsquare:
hx(0)=hx(0)+cs2*l(lne,14):hy(0)=hy(0)+sn2*l(lne,14):w(0)=2
npt=0:GOSUB fsquare:
if l(lne,15)=0 then fpt=1:npt=3:gosub plotff2::fpt=2:npt=4:gosub plotff2:
RETURN
AR28:
hx(0)=l(lne,20):hy(0)=l(lne,21)
if l(lne,4)=0 and l(lne,5)=0 then l(lne,4)=24*one:l(lne,5)=24*one
if l(lne,7)=7 or l(lne,7)=8 then if l(lne,6)=0 then l(lne,6)=one
swap w(i0),d(i0)
gpen=3:gosub returnpen:
npt=0:stp=9:i0=0

n=l(lne,7)
IF l(lne,8)<>0 THEN IF n=5 OR n=6 THEN GOSUB fsquare:
w(i0)=w(i0)-l(lne,8):d(i0)=d(i0)-l(lne,8)
IF n=0 or n=5 or n=6 THEN GOSUB fsquare::
IF n=1 THEN GOSUB fsquare::fpt=1:npt=3:GOSUB plotff2:
IF n=2 THEN GOSUB fcircle::fpt=15:npt=35:GOSUB plotff2:
IF n=3 THEN GOSUB fsquare::fpt=1:npt=3:GOSUB plotff2::fpt=2:npt=4:GOSUB plotff2:
IF n=4 THEN GOSUB  fcircle::fpt=15:npt=35:GOSUB plotff2::fpt=5:npt=25:GOSUB plotff2:
IF n=9 THEN GOSUB  fcircle:
IF (n=5 OR n=6) THEN GOSUB fsquare::GOSUB A28a::IF n=6 THEN GOSUB A28b:
IF n=7 OR n=8 THEN swap w(0),d(0):length(0)=l(lne,6):goto A28e:
IF n>10 AND n<20 THEN GOSUB A28c:
if l(lne,10)>0 then gosub A28d:
RETURN
A28a:
nt=INT(d(0)/2)*2
hx=hx(i0)+cs1*d(i0)
hy=hy(i0)+sn1*d(i0)
fpt=npt+1:npt=fpt+1
FOR t=1 TO nt-1
hx=hx-cs1*2:hy=hy-sn1*2
xpt(fpt)=hx+cs2*w(i0):ypt(fpt)=hy+sn2*w(i0)
xpt(npt)=hx-cs2*w(i0):ypt(npt)=hy-sn2*w(i0)
GOSUB plotff2:
NEXT t
RETURN
A28b:
nt=INT(w(0)/2)*2
hx=hx(i0)+cs2*w(i0)
hy=hy(i0)+sn2*w(i0)
fpt=npt+1:npt=fpt+1
FOR t=1 TO nt-1
hx=hx-cs2*2:hy=hy-sn2*2
xpt(fpt)=hx+cs1*d(i0):ypt(fpt)=hy+sn1*d(i0)
xpt(npt)=hx-cs1*d(i0):ypt(npt)=hy-sn1*d(i0)
GOSUB plotff2:
NEXT t
RETURN

A28c:
n1=(n-10)
IF n1=1 THEN GOSUB fsquare::RETURN
i=l(lne,5)*(n1-1)
hx(i0)=hx(i0)+(cs2*i)
hy(i0)=hy(i0)+(sn2*i)
GOSUB fsquare:
FOR t=2 TO n1
hx(i0)=hx(i0)-(cs2*l(lne,5)*2)
hy(i0)=hy(i0)-(sn2*l(lne,5)*2)
GOSUB fsquare:
NEXT t
RETURN
A28d:
gpen=7:gosub returnpen:
gosub penpattern1:
if l(lne,14)=0 then w(0)=l(lne,13)/2:d(0)=w(0):gosub fcircle::return
w(0)=l(lne,14)/2:d(0)=l(lne,13)/2:gosub fsquare:
return
A28e:
if l(lne,11)<>0 then goto A28f:
fpt=npt+1

xpt(npt+1)=hx(i0)+cs2*w(i0)::ypt(npt+1)=hy(i0)+sn2*w(i0)
xpt(npt+4)=hx(i0)-cs2*w(i0)::ypt(npt+4)=hy(i0)-sn2*w(i0)
hx=hx(i0)+cs1*length(i0):hy=hy(i0)+sn1*length(i0)
if l(lne,13)>0 then w(i0)=l(lne,13)/2
xpt(npt+2)=hx+cs2*w(i0)::ypt(npt+2)=hy+sn2*w(i0)
xpt(npt+3)=hx-cs2*w(i0)::ypt(npt+3)=hy-sn2*w(i0)
xpt(npt+5)=xpt(npt+1):ypt(npt+5)=ypt(npt+1)
npt=npt+5
GOSUB plotff:

RETURN
A28f:
fpt=npt+1

xpt(npt+1)=hx(i0)+cs2*w(i0)::ypt(npt+1)=hy(i0)+sn2*w(i0)
xpt(npt+6)=hx(i0)-cs2*w(i0)::ypt(npt+6)=hy(i0)-sn2*w(i0)
hx=hx(i0)+cs1*(length(i0)-l(lne,11)):hy=hy(i0)+sn1*(length(i0)-l(lne,11))
if l(lne,13)>0 then w(i0)=l(lne,13)/2
xpt(npt+2)=hx+cs2*w(i0)::ypt(npt+2)=hy+sn2*w(i0)
xpt(npt+5)=hx-cs2*w(i0)::ypt(npt+5)=hy-sn2*w(i0)
hx=hx(i0)+cs1*length(i0):hy=hy(i0)+sn1*length(i0)
xpt(npt+3)=hx+cs2*w(i0)::ypt(npt+3)=hy+sn2*w(i0)
xpt(npt+4)=hx-cs2*w(i0)::ypt(npt+4)=hy-sn2*w(i0)

xpt(npt+7)=xpt(npt+1):ypt(npt+7)=ypt(npt+1)
npt=npt+7
GOSUB plotff:

RETURN
AR29:

gpen=3:gosub returnpen:
i0=0
if l(lne,2)=0 and l(lne,3)=0 then l(lne,3)=360
if l(lne,2)<>0 or l(lne,3)<>0 then sa=l(lne,2):ea=l(lne,3):if ea<sa then ea=ea+360

hx(i0)=l(lne,20):hy(i0)=l(lne,21)
angle=l(lne,7)
sa=l(lne,2):ea=l(lne,3)
d(i0)=l(lne,4)/2:w(i0)=l(lne,5)/2
gosub fellipse:
if l(lne,8)<>0 then d(i0)=d(i0)-l(lne,8):w(i0)=w(i0)-l(lne,8):gosub fellipse:

return
AR30:
goto AR10:
return
AR31:
GOSUB sncsn:

IF l(lne,4)=0 AND l(lne,5)=0 THEN l(lne,4)=lheight:l(lne,5)=lwth
IF l(lne,7)=0 THEN l(lne,7)=16
gpen=7:gosub returnpen:
GOSUB getstringlength2:
wth1=l(lne,8)/2:dpth1=l(lne,13)/2:IF dpth1=0 THEN dpth1=wth1
hx(1)=l(lne,20)+cs1*l(lne,13):hy(1)=l(lne,21)+sn1*l(lne,13)
hx(1)=hx(1)+cs2*l(lne,8):hy(1)=hy(1)+sn2*l(lne,8)
npt=1:i0=1:sa=0:ea=360:w(i0)=l(lne,7)/2:stp=5:GOSUB fcircle:
xpt=hx(1):ypt=hy(1):wth=l(lne,4):dpth=l(lne,5):wth2=l(lne,7)/2
'cs1=1:sn1=0:cs2=0:sn2=-1
'IF l(lne,2)<>0 THEN cs1=COS(gpi#*l(lne,2)):sn1=-SIN(gpi#*l(lne,2)):cs2=COS(gpi#*(l(lne,2)+90)):sn2=-SIN(gpi#*(l(lne,2)+90))
gosub AR31a:

if ntxt>0 then xpt(1)=hx(1)+cs1*wth2:ypt(1)=hy(1)+sn1*wth2:xpt(2)=hx(1)-cs1*wth2:ypt(2)=hy(1)-sn1*wth2:fpt=1:npt=2:gosub plotff2:
dx2=l(lne,20)-hx(1):dy2=l(lne,21)-hy(1):gosub findangles10::if cos(gpi#*(angle-l(lne,3)))<0 then angle=l(lne,3)+180 else angle=l(lne,3)
if dpxy<wth2 then return
if l(lne,6)=0 then l(lne,6)=wth2+6
gosub sncsn2::xpt(1)=hx(1)+cs1*wth2:ypt(1)=hy(1)+sn1*wth2::xpt(2)=hx(1)+cs1*l(lne,6):ypt(2)=hy(1)+sn1*l(lne,6)
xpt(3)=l(lne,20):ypt(3)=l(lne,21):fpt=1:npt=3:gosub plotff:
dx2=xpt(3)-xpt(2):dy2=ypt(3)-ypt(2):gosub findangles10::gosub sncsn2:
dir=1:wth=4:node=3:gosub arrowhead:
RETURN
AR31a:
llst$=lst$(lne)
txpt1=xpt:typt1=ypt

GOSUB parsetext:
FOR t=0 TO ntxt
llst$=mlst$(t)
ns=len(llst$)*l(lne,5)*.75

xpt=txpt1-(cs1*ns)
ypt=typt1-(sn1*ns)
if t=0 and ntxt=0 then xpt=xpt-(cs2*wth*.5):ypt=ypt-(sn2*wth*.5)
if t=0 and ntxt=1 then xpt=xpt+(cs2*1.5):ypt=ypt+(sn2*1.5)
if t=1 and ntxt=1 then xpt=xpt-(cs2*((wth*2)+1.5)):ypt=ypt-((sn2*(wth*2)+1.5))
GOSUB subtext:

NEXT t
RETURN

AR32:
gpen=6:gosub returnpen:


if l(lne,7)=0 then l(lne,7)=l(lne,4)
if l(lne,8)=0 then l(lne,8)=l(lne,5)
w(0)=l(lne,4)/2:d(0)=l(lne,5)/2
w(1)=l(lne,7)/2:d(1)=l(lne,8)/2
hx(0)=l(lne,20):hy(0)=l(lne,21):hz(0)=l(lne,22)
hx(1)=hx(0)+cs1*l(lne,6):hy(1)=hy(0)+sn1*l(lne,6):hz(1)=hz(0)+l(lne,15)
hx(1)=hx(1)+cs2*l(lne,14):hy(1)=hy(1)+sn2*l(lne,14)
xpt(1)=hx(0)+cs2*w(0):ypt(1)=hy(0)+sn2*w(0)
xpt(4)=hx(0)-cs2*w(0):ypt(4)=hy(0)-sn2*w(0)
xpt(2)=hx(1)+cs2*w(1):ypt(2)=hy(1)+sn2*w(1)
xpt(3)=hx(1)-cs2*w(1):ypt(3)=hy(1)-sn2*w(1)
xpt(5)=xpt(1):ypt(5)=ypt(1)
fpt=1:npt=5:gosub plotff:
return
AR33:
gpen=3:gosub returnpen:
if l(lne,2)=0 and l(lne,3)=0 then l(lne,3)=360
if l(lne,2)>l(lne,3) then l(lne,3)=l(lne,3)+360
angle=l(lne,8)
sa=l(lne,2):ea=l(lne,3)
stp=l(lne,7)
gosub fellipse:
return
AR34:
gpen=1:gosub returnpen:

angle=l(lne,3):gosub sncsn2:
hx(0)=l(lne,20)+cs2*l(lne,4)/2:hy(0)=l(lne,21)+sn2*l(lne,4)/2:length(0)=l(lne,6):gosub AR34a:
hx(0)=hx(0)+cs1*l(lne,6):hy(0)=hy(0)+sn1*l(lne,6):length(0)=l(lne,4):angle=l(lne,3)-90:gosub sncsn2::gosub AR34a:
hx(0)=hx(0)+cs1*l(lne,4):hy(0)=hy(0)+sn1*l(lne,4):length(0)=l(lne,6):angle=l(lne,3)-180:gosub sncsn2::gosub AR34a:
hx(0)=hx(0)+cs1*l(lne,6):hy(0)=hy(0)+sn1*l(lne,6):length(0)=l(lne,4):angle=l(lne,3)-270:gosub sncsn2::gosub AR34a:
return
AR34a:
if l(lne,8)=0 then l(lne,8)=12
nstp=fix(length(0)/(l(lne,8)))
nstp=fix(nstp/3)*3
if nstp<3 then nstp=3
s1=length(0)/(nstp*2)
radd=sqr(s1^2+s1^2)
hx(1)=hx(0):hy(1)=hy(0)
n2=s1/2
n3=-n2
for n=1 to nstp
s3=s1+n3
radd=sqr(s3^2+s3^2)
hx(1)=hx(1)+cs1*s3:hy(1)=hy(1)+sn1*s3
hx(1)=hx(1)-cs2*s3:hy(1)=hy(1)-sn2*s3
sa=angle+135:ea=angle+45
gosub AR34b:
hx(1)=xpt(npt):hy(1)=ypt(npt)
n3=n3+n2:if n3>n2 then n3=-n2
next n

return

AR34b:
fpt=1:npt=0

FOR aa=sa to ea step -10
npt=npt+1
xpt(npt)=hx(1)+COS(gpi#*aa)*radd
ypt(npt)=hy(1)-SIN(gpi#*aa)*radd
NEXT aa

GOSUB plotff:
RETURN

elength2:
del#=(xpt1#-xpt2#)*(ypt4#-ypt3#)-(ypt1#-ypt2#)*(xpt4#-xpt3#):IF del#=0 THEN RETURN
rmu#=((ypt4#-ypt3#)*(xpt4#-xpt2#)-(xpt4#-xpt3#)*(ypt4#-ypt2#))/del#
x#=rmu#*xpt1#+(1-rmu#)*xpt2#
y#=rmu#*ypt1#+(1-rmu#)*ypt2#
xpt3#=x#:ypt3#=y#
RETURN

fsquare:

fpt=npt+1
hx=hx(i0)+cs1*d(i0):hy=hy(i0)+sn1*d(i0)
xpt(npt+1)=hx-cs2*w(i0)::ypt(npt+1)=hy-sn2*w(i0)
xpt(npt+2)=hx+cs2*w(i0)::ypt(npt+2)=hy+sn2*w(i0)
hx=hx(i0)-cs1*d(i0):hy=hy(i0)-sn1*d(i0)
xpt(npt+3)=hx+cs2*w(i0)::ypt(npt+3)=hy+sn2*w(i0)
xpt(npt+4)=hx-cs2*w(i0)::ypt(npt+4)=hy-sn2*w(i0)
xpt(npt+5)=xpt(npt+1):ypt(npt+5)=ypt(npt+1)
npt=npt+5
GOSUB plotff:
RETURN
fellipse:
IF w(i0)=d(i0) THEN GOTO fcircle:
fellipse2:
if stp=0 then stp=5
fpt=npt+1
FOR aa=sa TO ea STEP stp
aaa=angle
dpth4=COS(gpi#*aa)*d(i0)
wth4=SIN(gpi#*aa)*w(i0)
npt=npt+1
xpt(npt)=hx(i0)+COS(gpi#*aaa)*dpth4
ypt(npt)=hy(i0)-SIN(gpi#*aaa)*dpth4
xpt(npt)=xpt(npt)+COS(gpi#*(aaa+90))*wth4
ypt(npt)=ypt(npt)-SIN(gpi#*(aaa+90))*wth4
NEXT aa
npt=npt
GOSUB plotff:
RETURN
fcircle:
npt=1
if stp=0 then stp=5

fpt=npt+1
for aa=sa to ea step stp
npt=npt+1
xpt(npt)=hx(i0)+COS(gpi#*aa)*w(i0)
ypt(npt)=hy(i0)-SIN(gpi#*aa)*w(i0)
NEXt aa

GOSUB plotff:
RETURN
farc:
onpt=npt
fpt=npt+1
FOR aa=sa TO ea STEP stp
npt=npt+1
xpt(npt)=cx+COS(gpi#*aa)*radius
ypt(npt)=cy-SIN(gpi#*aa)*radius
NEXT aa
npt=npt+1
xpt(npt)=cx+COS(gpi#*ea)*radius
ypt(npt)=cy-SIN(gpi#*ea)*radius
GOSUB plotff:
npt=onpt
RETURN
flne:
xpt(1)=hx(i0):ypt(1)=hy(i0)
xpt(2)=hx(i0)+cs1*l(lne,6):ypt(2)=hy(i0)+sn1*l(lne,6)
fpt=1:npt=2:gosub plotff:
return
flength:
fpt=npt+1

xpt(npt+1)=hx(i0)+cs2*w(i0)::ypt(npt+1)=hy(i0)+sn2*w(i0)
xpt(npt+4)=hx(i0)-cs2*w(i0)::ypt(npt+4)=hy(i0)-sn2*w(i0)
hx=hx(i0)+cs1*length(i0):hy=hy(i0)+sn1*length(i0)
xpt(npt+2)=hx+cs2*w(i0)::ypt(npt+2)=hy+sn2*w(i0)
xpt(npt+3)=hx-cs2*w(i0)::ypt(npt+3)=hy-sn2*w(i0)
xpt(npt+5)=xpt(npt+1):ypt(npt+5)=ypt(npt+1)
npt=npt+5
GOSUB plotff:

RETURN
flength2:
fpt=npt+1

xpt(npt+1)=hx(i0)+cs2*w(i0)::ypt(npt+1)=hy(i0)+sn2*w(i0)
xpt(npt+4)=hx(i0)-cs2*w(i0)::ypt(npt+4)=hy(i0)-sn2*w(i0)
hx=hx(i0)+cs1*length(i0):hy=hy(i0)+sn1*length(i0)
w(i0)=w(i0)-l(lne,7)
xpt(npt+2)=hx+cs2*w(i0)::ypt(npt+2)=hy+sn2*w(i0)
xpt(npt+3)=hx-cs2*w(i0)::ypt(npt+3)=hy-sn2*w(i0)
xpt(npt+5)=xpt(npt+1):ypt(npt+5)=ypt(npt+1)
npt=npt+5
GOSUB plotff:

RETURN

fpolygon:

IF poly=0 THEN RETURN
IF poly=1 THEN GOTO fsquare:
IF poly=2 THEN GOTO fellipse:
stp=360/poly
IF w(i0)=d(i0) THEN GOTO fcircle: ELSE GOTO fellipse:

RETURN
fibeam:
fpt=1:npt=13
half=(.25*one)
hx1=hx(i0)-cs1*d(i0):hy1=hy(i0)-sn1*d(i0)
xpt(1)=hx1+cs2*w(i0):ypt(1)=hy1+sn2*w(i0)
xpt(13)=xpt(1):ypt(13)=ypt(1)
xpt(12)=hx1-cs2*w(i0):ypt(12)=hy1-sn2*w(i0)
hx1=hx(i0)-cs1*(d(i0)-one):hy1=hy(i0)-sn1*(d(i0)-one)
xpt(2)=hx1+cs2*w(i0):ypt(2)=hy1+sn2*w(i0)
xpt(11)=hx1-cs2*w(i0):ypt(11)=hy1-sn2*w(i0)
xpt(3)=hx1+cs2*half:ypt(3)=hy1+sn2*half
xpt(10)=hx1-cs2*half:ypt(10)=hy1-sn2*half
hx1=hx(i0)+cs1*d(i0):hy1=hy(i0)+sn1*d(i0)
xpt(6)=hx1+cs2*w(i0):ypt(6)=hy1+sn2*w(i0)
xpt(7)=hx1-cs2*w(i0):ypt(7)=hy1-sn2*w(i0)
hx1=hx(i0)+cs1*(d(i0)-one):hy1=hy(i0)+sn1*(d(i0)-one)
xpt(5)=hx1+cs2*w(i0):ypt(5)=hy1+sn2*w(i0)
xpt(8)=hx1-cs2*w(i0):ypt(8)=hy1-sn2*w(i0)
xpt(4)=hx1+cs2*half:ypt(4)=hy1+sn2*half
xpt(9)=hx1-cs2*half:ypt(9)=hy1-sn2*half
GOSUB plotff:


RETURN
flbeam:
half=(.25*one)
fpt=npt+1
xpt(npt+1)=hx(i0):ypt(npt+1)=hy(i0)
xpt(npt+2)=xpt(npt+1)+cs1*d(i0)*dir1:ypt(npt+2)=ypt(npt+1)+sn1*d(i0)*dir1
xpt(npt+3)=xpt(npt+2)-cs2*one*.5*dir2:ypt(npt+3)=ypt(npt+2)-sn2*one*.5*dir2
xpt(npt+4)=xpt(npt+3)-cs1*(d(i0)-.5)*dir1:ypt(npt+4)=ypt(npt+3)-sn1*(d(i0)-.5)*dir1
xpt(npt+5)=xpt(npt+4)-cs2*(w(i0)-.5)*dir2:ypt(npt+5)=ypt(npt+4)-sn2*(w(i0)-.5)*dir2
xpt(npt+6)=xpt(npt+5)-cs1*one*.5*dir1:ypt(npt+6)=ypt(npt+5)-sn1*one*.5*dir1
xpt(npt+7)=xpt(npt+6)+cs2*w(i0)*dir2:ypt(npt+7)=ypt(npt+6)+sn2*w(i0)*dir2



npt=npt+7:GOSUB plotff:
RETURN
fcbeam:
half=(.25*one)
fpt=npt+1
xpt(npt+1)=hx(i0):ypt(npt+1)=hy(i0)
xpt(npt+2)=xpt(npt+1)+cs1*d(i0)*dir1:ypt(npt+2)=ypt(npt+1)+sn1*d(i0)*dir1
xpt(npt+3)=xpt(npt+2)-cs2*(w(i0))*dir2:ypt(npt+3)=ypt(npt+2)-sn2*(w(i0))*dir2

xpt(npt+4)=xpt(npt+3)-cs1*one*.5*dir2:ypt(npt+4)=ypt(npt+3)-sn1*one*.5*dir2
xpt(npt+5)=xpt(npt+4)+cs2*(w(i0)-.5)*dir1:ypt(npt+5)=ypt(npt+4)+sn2*(w(i0)-.5)*dir1

xpt(npt+6)=xpt(npt+5)-cs1*(d(i0)-1)*dir2:ypt(npt+6)=ypt(npt+5)-sn1*(d(i0)-1)*dir2
xpt(npt+7)=xpt(npt+6)-cs2*(w(i0)-.5)*dir1:ypt(npt+7)=ypt(npt+6)-sn2*(w(i0)-.5)*dir1
xpt(npt+8)=xpt(npt+7)-cs1*one*.5*dir2:ypt(npt+8)=ypt(npt+7)-sn1*one*.5*dir2
xpt(npt+9)=xpt(npt+1):ypt(npt+9)=ypt(npt+1)


npt=npt+9:GOSUB plotff:
RETURN


fjoist:
w(1)=(w(0)-.25):d(1)=w(1)

i0=1
half=(.5*one)
w(2)=w(i0):d(2)=d(i0)
w(3)=(l(lne,4)-one)/4
hx(1)=hx(0)+cs1*d(0):hy(1)=hy(0)+sn1*d(0)
hx(1)=hx(1)+cs2*half:hy(1)=hy(1)+sn2*half
i0=1:dir1=-1:dir2=-1:GOSUB flbeam:
hx(1)=hx(0)+cs1*d(0):hy(1)=hy(0)+sn1*d(0)
hx(1)=hx(1)-cs2*half:hy(1)=hy(1)-sn2*half
i0=1:dir1=-1:dir2=1:GOSUB flbeam:
hx(1)=hx(0)-cs1*d(0):hy(1)=hy(0)-sn1*d(0)
hx(1)=hx(1)+cs2*half:hy(1)=hy(1)+sn2*half
i0=1:dir1=1:dir2=-1:GOSUB flbeam:
hx(1)=hx(0)-cs1*d(0):hy(1)=hy(0)-sn1*d(0)
hx(1)=hx(1)-cs2*half:hy(1)=hy(1)-sn2*half
i0=1:dir1=1:dir2=1:GOSUB flbeam:
i0=0:w(i0)=half:d(0)=d(0)-half:GOSUB fsquare:

return
penpattern0:
pennpatt=1
IF plotout>0 THEN GOTO pPenpattern0:
CALL PENNORMAL
RETURN
pPenpattern0:
IF llayer=1 THEN pennpatt=-1
Lyntype=0
RETURN

penpattern1:
pennpatt=-1
IF plotout>0 THEN GOTO pPenpattern1:
CALL PENPAT(VARPTR(pat%(0)))
RETURN
pPenpattern1:
IF llayer=0 THEN pennpatt=-1
Lyntype=1
RETURN
penpattern2:
pennpatt=1
IF plotout>0 THEN GOTO pPenpattern2:
CALL PENPAT(VARPTR(patb%(0)))
RETURN
pPenpattern2:

RETURN
plotff:
IF pennpatt=0 or dontdraw=1 THEN RETURN
FOR tt1=fpt+1 TO npt
xpt3#=xpt(tt1-1)
ypt3#=ypt(tt1-1)
xpt4#=xpt(tt1)
ypt4#=ypt(tt1)

gosub plotprim:
NEXT tt1
RETURN
plotff2:
IF pennpatt=0 or dontdraw=1 THEN RETURN
xpt3#=xpt(fpt)
ypt3#=ypt(fpt)
xpt4#=xpt(npt)
ypt4#=ypt(npt)
gosub plotprim:
return
cliptxt:
xpt3#=xpt:ypt3#=ypt:
xpt4#=xpt3#+cs1*dpth*ns:ypt4#=ypt3#+sn1*dpth*ns
txton=1:gosub cliplines::txton=0
xpt=xpt+pagdx(clpwin):ypt=ypt+pagdy(clpwin)
return


Cliplines:
dx2=xpt4#-xpt3#:dy2=ypt4#-ypt3#:gosub clipangles10:
xpt5#=xpt3#:ypt5#=ypt3#
pagi2=7
if clpwin>9 then beep
FOR pagi=2 TO npag(clpwin)
xpt1#=pagx(clpwin,pagi):ypt1#=pagy(clpwin,pagi):xpt2#=pagx(clpwin,pagi-1):ypt2#=pagy(clpwin,pagi-1)
rmu#=-1
xpt3#=xpt5#:ypt3#=ypt5#:GOSUB elength2:
IF (rmu#>0 AND rmu#<1) THEN pagi2=pagi2+1:pagx(clpwin,pagi2)=xpt3:pagy(clpwin,pagi2)=ypt3

NEXT pagi
IF pagi2=7 THEN xpt4#=0:RETURN
IF ABS(SIN(gpi#*clipangle))>.5 THEN GOTO Cliplinesb:
IF xpt4#>xpt5# THEN SWAP xpt4#,xpt5#:SWAP ypt4#,ypt5#
IF pagx(clpwin,8)>pagx(clpwin,9) THEN SWAP pagx(clpwin,8),pagx(clpwin,9):SWAP pagy(clpwin,8),pagy(clpwin,9)
first=(xpt4#-pagx(clpwin,8))/(pagx(clpwin,9)-pagx(clpwin,8))
second=(xpt5#-pagx(clpwin,8))/(pagx(clpwin,9)-pagx(clpwin,8))
IF first>1 AND second>1 THEN xpt4#=0:RETURN
IF first<0 AND second<0 THEN xpt4#=0:RETURN
IF first<0 THEN xpt4#=pagx(clpwin,8):ypt4#=pagy(clpwin,8)
IF second>1 THEN xpt5#=pagx(clpwin,9):ypt5#=pagy(clpwin,9)
if txton=0 then gosub pplot:
return
Cliplinesb:
IF ypt4#>ypt5# THEN SWAP xpt4#,xpt5#::SWAP ypt4#,ypt5#
IF pagy(clpwin,8)>pagy(clpwin,9) THEN SWAP pagx(clpwin,8),pagx(clpwin,9):SWAP pagy(clpwin,8),pagy(clpwin,9)
first=(ypt4#-pagy(clpwin,8))/(pagy(clpwin,9)-pagy(clpwin,8))
second=(ypt5#-pagy(clpwin,8))/(pagy(clpwin,9)-pagy(clpwin,8))
IF first>1 AND second>1 THEN xpt4#=0:RETURN
IF first<0 AND second<0 THEN xpt4#=0:RETURN
IF first<0 THEN xpt4#=pagx(clpwin,8):ypt4#=pagy(clpwin,8)
IF second>1 THEN xpt5#=pagx(clpwin,9):ypt5#=pagy(clpwin,9)
if txton=0 then gosub pplot:
return
clipangles10:
if dx2=0 and dy2=0 then dpxy=0:angle=0:return
dpxy=SQR(ABS((dx2^2)+(dy2^2))):sina=-dy2/dpxy:cosa=dx2/dpxy
IF cosa=0 THEN cosa=.000000001#
ttan=sina/cosa
atann=ATN(ttan)*114.591559#
clipangle=atann/2
IF cosa<=0 THEN clipangle=clipangle+180
IF cosa>=0 AND sina<0 THEN clipangle=clipangle+360
RETURN
plotprim:
if plotout=0 then call moveto(xpt3#/sc,ypt3#/sc):call lineto(xpt4#/sc,ypt4#/sc):return
if clpwin>0 then goto cliplines:
xpt5#=xpt4#:ypt5#=ypt4#:xpt4#=xpt3#:ypt4#=ypt3#:gosub pplot:
return
pplot:
PRINT #1, 0
PRINT #1, "LINE"
PRINT #1, 6
IF Lyntype=0 THEN PRINT #1, "CONTINUOUS"
IF Lyntype=1 THEN PRINT #1, "DASHED"

PRINT #1, 8
PRINT #1, layername$

PRINT #1, 10
PRINT #1, xpt4#+pagdx(clpwin)
PRINT #1, 20
PRINT #1, flp-(ypt4#+pagdy(clpwin))
PRINT #1, 11
PRINT #1, xpt5#+pagdy(clpwin)
PRINT #1, 21
PRINT #1,  flp-(ypt5#+pagdy(clpwin))

PRINT #1, 39
PRINT #1, 50

print #1, 62
print #1, defpen(gpen,3)
RETURN


pText:
if clpwin>0 then gosub cliptxt::if xpt4#=0 then return
GOSUB getstringlength3:
GOSUB psubtextchk:
xpt2=xpt+cs1*nst*dpth
ypt2=ypt+sn1*nst*dpth
PRINT #1, 0
PRINT #1, "TEXT"
PRINT #1, 6
IF Lyntype=0 THEN PRINT #1, "CONTINUOUS"
IF Lyntype=1 THEN PRINT #1, "DASHED"
PRINT #1, 8
PRINT #1, layername$
PRINT #1, 10
PRINT #1, xpt
PRINT #1, 20
PRINT #1, flp-ypt
PRINT #1, 30
PRINT #1, 0
PRINT #1, 11
PRINT #1, xpt2
PRINT #1, 21
PRINT #1, flp-ypt2
PRINT #1, 31
PRINT #1, 0

PRINT #1, 40
PRINT #1, wth
PRINT #1, 1
PRINT #1, llst$

PRINT #1, 50

PRINT #1, txtangle
print #1, 62
print #1, defpen(gpen,3)

PRINT #1, 72
PRINT #1, 5

RETURN

psubtextchk:
ln=LEN(llst$):skip=0
mm$=""
FOR i=1 TO ln
m$=MID$(llst$,i,1)
IF m$=";" THEN mm$=mm$+"%%c":skip=1
IF m$="'" AND i<ln AND MID$(llst$,i+1,1)="'" THEN mm$=mm$+"%%034":skip=2
IF skip=0 THEN mm$=mm$+m$ ELSE skip=skip-1
NEXT i
llst$=mm$
RETURN
plotcircle:
IF pennpatt=-1 THEN RETURN
CIRCLE cx/sc,cy/sc,radius/sc
RETURN
plotarc:
IF pennpatt=-1 THEN RETURN
fpt=20:npt=20
FOR a=sa TO ea STEP 5
xpt(npt)=cx+(COS(gpi#*a)*radius)
ypt(npt)=cy-(SIN(gpi#*a)*radius)
npt=npt+1
NEXT a
xpt(npt)=cx+(COS(gpi#*ea)*radius)
ypt(npt)=cy-(SIN(gpi#*ea)*radius)
GOSUB plotff:
RETURN

parsetext:
strt=1:ntxt=0
locate 1,5:
ns=LEN(llst$)
septext2:
IF ntxt>10 THEN RETURN
strt2=INSTR(strt,llst$,"\")
IF strt2>0 THEN mlst$(ntxt)=MID$(llst$,strt,strt2-strt):stxt(ntxt)=LEN(mlst$(ntxt)):strt=strt2+1:ntxt=ntxt+1:GOTO septext2:
septext3:
mlst$(ntxt)=MID$(llst$,strt,ns-strt+1):stxt(ntxt)=LEN(mlst$(ntxt))
IF stxt(ntxt)=0 THEN ntxt=ntxt-1
FOR t=0 TO ntxt
IF stxt(t)>stxt(ltxt) THEN ltxt=t
NEXT t
RETURN
text:
GOSUB parsetext:
txpt1=xpt:typt1=ypt
FOR t=0 TO ntxt
llst$=mlst$(t)
xpt=txpt1-(cs2*wth*1.5*t)
ypt=typt1-(sn2*wth*1.5*t)
GOSUB subtext:
NEXT t
RETURN


subtext:
IF plotout>0 THEN GOTO pText:
ns=LEN(llst$)
bxpt=xpt:bypt=ypt
FOR ll=1 TO ns
om$=m$
m$=MID$(llst$,ll,1)
c=ASC(m$):cc=0
IF ll<ns AND c=39 THEN mm$=MID$(llst$,ll+1,1):cc=ASC(mm$)
IF cc=39 THEN ll=ll+1:c=33
IF c<45 THEN GOSUB backstep:
IF c=33 THEN GOSUB fontff2:
IF c=32 THEN xpt=xpt+cs1*dpth:ypt=ypt+sn1*dpth
IF c=39 THEN GOSUB fontff::GOSUB backstep:
IF c=59 THEN GOSUB backstep::GOSUB font11:
IF c>44 THEN GOSUB Drawcharacters:
xpt=xpt+cs1*dpth*.5
ypt=ypt+sn1*dpth*.5
NEXT ll
RETURN



backstep:
xpt=xpt-cs1*dpth*.5:ypt=ypt-sn1*dpth*.5
RETURN

Drawcharacters:
GOSUB alphabetic:
IF c>44 AND c<58 THEN ON c-44 GOSUB fontf3:,fontf4:,fontf5:,font0:,font1:,font2:,font3:,font4:,font5:,font6:,font7:,font8:,font9:
IF c>64 AND c<91 THEN ON c-64 GOSUB fonta:,font8:,fontc:,font0:,fonte:,fontf:,fontg:,fonth:,font1:,fontj:,fontk:,fontl:,fontm:,fontn:,font0:,fontp:,fontq:,fontr:,font5:,fonttt:,fontu:,fontv:,fontw:,fontx:,fonty:,fontz:
IF c>96 AND c<123 THEN ON c-96 GOSUB fonta:,font8:,fontc:,font0:,fonte:,fontf:,fontg:,fonth:,font1:,fontj:,fontk:,fontl:,fontm:,fontn:,font0:,fontp:,fontq:,fontr:,font5:,fonttt:,fontu:,fontv:,fontw:,fontx:,fonty:,fontz:
RETURN
fontff:
xpt=xpt+cs1*dpth*.4
ypt=ypt+sn1*dpth*.4
f(1,1)=xpt+cs2*wth*.7
f(1,2)=ypt+sn2*wth*.7
xpt=xpt+cs1*dpth*.2
ypt=ypt+sn1*dpth*.2
f(2,1)=xpt+cs2*wth
f(2,2)=ypt+sn2*wth
CALL MOVETO(f(1,1)/sc,f(1,2)/sc):CALL LINETO(f(2,1)/sc,f(2,2)/sc)
xpt=xpt+cs1*dpth*.4
ypt=ypt+sn1*dpth*.4
RETURN

fontff2:
xpt=xpt+cs1*dpth*.25
ypt=ypt+sn1*dpth*.25
f(1,1)=xpt+cs2*wth*.7
f(1,2)=ypt+sn2*wth*.7
xpt=xpt+cs1*dpth*.25
ypt=ypt+sn1*dpth*.25
f(2,1)=xpt+cs2*wth
f(2,2)=ypt+sn2*wth
CALL MOVETO(f(1,1)/sc,f(1,2)/sc):CALL LINETO(f(2,1)/sc,f(2,2)/sc)
xpt=xpt+cs1*dpth*.25
ypt=ypt+sn1*dpth*.25
f(1,1)=xpt+cs2*wth*.7
f(1,2)=ypt+sn2*wth*.7
xpt=xpt+cs1*dpth*.25
ypt=ypt+sn1*dpth*.25
f(2,1)=xpt+cs2*wth
f(2,2)=ypt+sn2*wth
CALL MOVETO(f(1,1)/sc,f(1,2)/sc):CALL LINETO(f(2,1)/sc,f(2,2)/sc)
RETURN


fontf3:
CALL MOVETO(f(2,1)/sc,f(2,2)/sc):CALL LINETO(f(8,1)/sc,f(8,2)/sc)
RETURN
fontf4:
'call PSET(f(6,1)/sc,f(6,2)/sc)
RETURN
fontf5:
CALL MOVETO(f(7,1)/sc,f(7,2)/sc):CALL LINETO(f(3,1)/sc,f(3,2)/sc)
RETURN
font0:
CALL MOVETO(f(3,1)/sc,f(3,2)/sc):CALL LINETO(f(1,1)/sc,f(1,2)/sc)
CALL LINETO(f(7,1)/sc,f(7,2)/sc):CALL LINETO(f(9,1)/sc,f(9,2)/sc)
CALL LINETO(f(3,1)/sc,f(3,2)/sc)
RETURN

font1:
CALL MOVETO(f(4,1)/sc,f(4,2)/sc):CALL LINETO(f(6,1)/sc,f(6,2)/sc)
RETURN

font2:
CALL MOVETO(f(1,1)/sc,f(1,2)/sc):CALL LINETO(f(7,1)/sc,f(7,2)/sc)
CALL LINETO(f(8,1)/sc,f(8,2)/sc):CALL LINETO(f(2,1)/sc,f(2,2)/sc)
CALL LINETO(f(3,1)/sc,f(3,2)/sc):CALL LINETO(f(9,1)/sc,f(9,2)/sc)
RETURN
font3:
CALL MOVETO(f(1,1)/sc,f(1,2)/sc):CALL LINETO(f(7,1)/sc,f(7,2)/sc)
CALL LINETO(f(9,1)/sc,f(9,2)/sc):CALL LINETO(f(3,1)/sc,f(3,2)/sc)
CALL MOVETO(f(8,1)/sc,f(8,2)/sc):CALL LINETO(f(5,1)/sc,f(5,2)/sc)
RETURN
font4:
CALL MOVETO(f(1,1)/sc,f(1,2)/sc):CALL LINETO(f(2,1)/sc,f(2,2)/sc)
CALL LINETO(f(8,1)/sc,f(8,2)/sc)
CALL MOVETO(f(7,1)/sc,f(7,2)/sc):CALL LINETO(f(9,1)/sc,f(9,2)/sc)
RETURN
font5:
CALL MOVETO(f(7,1)/sc,f(7,2)/sc):CALL LINETO(f(1,1)/sc,f(1,2)/sc)
CALL LINETO(f(2,1)/sc,f(2,2)/sc):CALL LINETO(f(8,1)/sc,f(8,2)/sc)
CALL LINETO(f(9,1)/sc,f(9,2)/sc):CALL LINETO(f(3,1)/sc,f(3,2)/sc)
RETURN

font6:
CALL MOVETO(f(1,1)/sc,f(1,2)/sc):CALL LINETO(f(3,1)/sc,f(3,2)/sc)
CALL LINETO(f(9,1)/sc,f(9,2)/sc)
CALL LINETO(f(8,1)/sc,f(8,2)/sc):CALL LINETO(f(2,1)/sc,f(2,2)/sc)
RETURN
font7:
CALL MOVETO(f(1,1)/sc,f(1,2)/sc):CALL LINETO(f(7,1)/sc,f(7,2)/sc)
CALL LINETO(f(6,1)/sc,f(6,2)/sc)

RETURN
font8:
CALL MOVETO(f(3,1)/sc,f(3,2)/sc):CALL LINETO(f(1,1)/sc,f(1,2)/sc)
CALL LINETO(f(7,1)/sc,f(7,2)/sc):CALL LINETO(f(9,1)/sc,f(9,2)/sc)
CALL LINETO(f(3,1)/sc,f(3,2)/sc)
CALL MOVETO(f(2,1)/sc,f(2,2)/sc):CALL LINETO(f(8,1)/sc,f(8,2)/sc)
RETURN

font9:
CALL MOVETO(f(9,1)/sc,f(9,2)/sc):CALL LINETO(f(7,1)/sc,f(7,2)/sc)
CALL LINETO(f(1,1)/sc,f(1,2)/sc)
CALL LINETO(f(2,1)/sc,f(2,2)/sc):CALL LINETO(f(8,1)/sc,f(8,2)/sc)
RETURN
font11:
xpt=xpt+cs1*dpth*.2
ypt=ypt+sn1*dpth*.2
f(1,1)=xpt+cs2*wth
f(1,2)=ypt+sn2*wth
xpt=xpt+cs1*dpth*.3
ypt=ypt+sn1*dpth*.3
f(2,1)=xpt+cs2*wth*.5
f(2,2)=ypt+sn2*wth*.5
CIRCLE f(2,1)/sc,f(2,2)/sc,dpth*.6/sc
xpt=xpt+cs1*dpth*.3
ypt=ypt+sn1*dpth*.3
f(3,1)=xpt
f(3,2)=ypt
xpt=xpt+cs1*dpth*.2
ypt=ypt+sn1*dpth*.2
CALL MOVETO(f(1,1)/sc,f(1,2)/sc):CALL LINETO(f(3,1)/sc,f(3,2)/sc)
RETURN
alphabetic:
f(1,1)=xpt+cs2*wth
f(1,2)=ypt+sn2*wth
f(2,1)=xpt+cs2*wth*.5
f(2,2)=ypt+sn2*wth*.5
f(3,1)=xpt
f(3,2)=ypt
xpt=xpt+cs1*dpth*.5
ypt=ypt+sn1*dpth*.5
f(4,1)=xpt+cs2*wth
f(4,2)=ypt+sn2*wth
f(5,1)=xpt+cs2*wth*.5
f(5,2)=ypt+sn2*wth*.5
f(6,1)=xpt
f(6,2)=ypt
xpt=xpt+cs1*dpth*.5
ypt=ypt+sn1*dpth*.5
f(7,1)=xpt+cs2*wth
f(7,2)=ypt+sn2*wth
f(8,1)=xpt+cs2*wth*.5
f(8,2)=ypt+sn2*wth*.5
f(9,1)=xpt
f(9,2)=ypt
RETURN

fonta:
CALL MOVETO(f(3,1)/sc,f(3,2)/sc):CALL LINETO(f(1,1)/sc,f(1,2)/sc)
CALL LINETO(f(7,1)/sc,f(7,2)/sc):CALL LINETO(f(9,1)/sc,f(9,2)/sc)
CALL MOVETO(f(2,1)/sc,f(2,2)/sc):CALL LINETO(f(8,1)/sc,f(8,2)/sc)
RETURN
fontc:
CALL MOVETO(f(9,1)/sc,f(9,2)/sc):CALL LINETO(f(3,1)/sc,f(3,2)/sc)
CALL LINETO(f(1,1)/sc,f(1,2)/sc):CALL LINETO(f(7,1)/sc,f(7,2)/sc)
RETURN
fonte:
CALL MOVETO(f(9,1)/sc,f(9,2)/sc):CALL LINETO(f(3,1)/sc,f(3,2)/sc)
CALL LINETO(f(1,1)/sc,f(1,2)/sc):CALL LINETO(f(7,1)/sc,f(7,2)/sc)
CALL MOVETO(f(2,1)/sc,f(2,2)/sc):CALL LINETO(f(5,1)/sc,f(5,2)/sc)
RETURN
fontf:
CALL MOVETO(f(3,1)/sc,f(3,2)/sc)
CALL LINETO(f(1,1)/sc,f(1,2)/sc):CALL LINETO(f(7,1)/sc,f(7,2)/sc)
CALL MOVETO(f(2,1)/sc,f(2,2)/sc):CALL LINETO(f(5,1)/sc,f(5,2)/sc)
RETURN
fontg:
CALL MOVETO(f(5,1)/sc,f(5,2)/sc):CALL LINETO(f(8,1)/sc,f(8,2)/sc)
CALL LINETO(f(9,1)/sc,f(9,2)/sc):CALL LINETO(f(3,1)/sc,f(3,2)/sc)
CALL LINETO(f(1,1)/sc,f(1,2)/sc):CALL LINETO(f(7,1)/sc,f(7,2)/sc)
RETURN
fonth:
CALL MOVETO(f(1,1)/sc,f(1,2)/sc):CALL LINETO(f(3,1)/sc,f(3,2)/sc)
CALL MOVETO(f(7,1)/sc,f(7,2)/sc):CALL LINETO(f(9,1)/sc,f(9,2)/sc)
CALL MOVETO(f(2,1)/sc,f(2,2)/sc):CALL LINETO(f(8,1)/sc,f(8,2)/sc)
RETURN
fontj:
CALL MOVETO(f(7,1)/sc,f(7,2)/sc):CALL LINETO(f(9,1)/sc,f(9,2)/sc)
CALL LINETO(f(3,1)/sc,f(3,2)/sc):CALL LINETO(f(2,1)/sc,f(2,2)/sc)
RETURN
fontk:
CALL MOVETO(f(1,1)/sc,f(1,2)/sc):CALL LINETO(f(3,1)/sc,f(3,2)/sc)
CALL MOVETO(f(2,1)/sc,f(2,2)/sc):CALL LINETO(f(7,1)/sc,f(7,2)/sc)
CALL MOVETO(f(5,1)/sc,f(5,2)/sc):CALL LINETO(f(9,1)/sc,f(9,2)/sc)
RETURN
fontl:
CALL MOVETO(f(1,1)/sc,f(1,2)/sc):CALL LINETO(f(3,1)/sc,f(3,2)/sc)
CALL LINETO(f(9,1)/sc,f(9,2)/sc)
RETURN
fontm:
CALL MOVETO(f(3,1)/sc,f(3,2)/sc):CALL LINETO(f(1,1)/sc,f(1,2)/sc)
CALL LINETO(f(6,1)/sc,f(6,2)/sc):CALL LINETO(f(7,1)/sc,f(7,2)/sc)
CALL LINETO(f(9,1)/sc,f(9,2)/sc)
RETURN
fontn:
CALL MOVETO(f(3,1)/sc,f(3,2)/sc):CALL LINETO(f(1,1)/sc,f(1,2)/sc)
CALL LINETO(f(9,1)/sc,f(9,2)/sc):CALL LINETO(f(7,1)/sc,f(7,2)/sc)

RETURN
fontp:
CALL MOVETO(f(3,1)/sc,f(3,2)/sc):CALL LINETO(f(1,1)/sc,f(1,2)/sc)
CALL LINETO(f(7,1)/sc,f(7,2)/sc):CALL LINETO(f(8,1)/sc,f(8,2)/sc)
CALL LINETO(f(2,1)/sc,f(2,2)/sc)
RETURN
fontq:
GOSUB font0:
CALL MOVETO(f(9,1)/sc,f(9,2)/sc):CALL LINETO(f(5,1)/sc,f(5,2)/sc)
RETURN
fontr:
GOSUB fontp:
CALL MOVETO(f(9,1)/sc,f(9,2)/sc):CALL LINETO(f(5,1)/sc,f(5,2)/sc)
RETURN
fonttt:
CALL MOVETO(f(4,1)/sc,f(4,2)/sc):CALL LINETO(f(6,1)/sc,f(6,2)/sc)
CALL MOVETO(f(1,1)/sc,f(1,2)/sc):CALL LINETO(f(7,1)/sc,f(7,2)/sc)
RETURN
fontu:
CALL MOVETO(f(1,1)/sc,f(1,2)/sc):CALL LINETO(f(3,1)/sc,f(3,2)/sc)
CALL LINETO(f(9,1)/sc,f(9,2)/sc):CALL LINETO(f(7,1)/sc,f(7,2)/sc)
RETURN
fontv:
CALL MOVETO(f(1,1)/sc,f(1,2)/sc):CALL LINETO(f(6,1)/sc,f(6,2)/sc)
CALL LINETO(f(7,1)/sc,f(7,2)/sc)
RETURN
fontw:
CALL MOVETO(f(1,1)/sc,f(1,2)/sc):CALL LINETO(f(3,1)/sc,f(3,2)/sc)
CALL LINETO(f(5,1)/sc,f(5,2)/sc):CALL LINETO(f(9,1)/sc,f(9,2)/sc)
CALL LINETO(f(7,1)/sc,f(7,2)/sc)
RETURN
fontx:
CALL MOVETO(f(1,1)/sc,f(1,2)/sc):CALL LINETO(f(9,1)/sc,f(9,2)/sc)
CALL MOVETO(f(3,1)/sc,f(3,2)/sc):CALL LINETO(f(7,1)/sc,f(7,2)/sc)

RETURN
fonty:
CALL MOVETO(f(1,1)/sc,f(1,2)/sc):CALL LINETO(f(5,1)/sc,f(5,2)/sc):CALL LINETO(f(7,1)/sc,f(7,2)/sc)
CALL MOVETO(f(6,1)/sc,f(6,2)/sc):CALL LINETO(f(5,1)/sc,f(5,2)/sc):
RETURN
fontz:
CALL MOVETO(f(1,1)/sc,f(1,2)/sc):CALL LINETO(f(7,1)/sc,f(7,2)/sc)
CALL LINETO(f(3,1)/sc,f(3,2)/sc):CALL LINETO(f(9,1)/sc,f(9,2)/sc)

RETURN

'~'

changeangle:
IF c=9 THEN ca=2 ELSE ca=3
call getmouse (m%(0)):ptx=m%(1):pty=m%(0)
while mouse(_down)=0
call getmouse (m%(0))
dx2=(m%(1)+fpx)*sc:dy2=(m%(0)+fpy)*sc
dx2=dx2-l(lne,20):dy2=dy2-l(lne,21)
GOSUB findangles10:
locate 4,4:print angle
wend
if ptx=m(1) and pty=m(0) then angle=int(angle/45)*45
print angle
'while mouse(_down)<>0:wend
l(lne,ca)=angle
GOSUB updateupdate:
return



Changedim:
cursor 2
call getmouse (m%(0))
locate 1,5
ptx=(m%(1)+fpx)*sc:pty=(m%(0)+fpy)*sc
IF l(lne,1)=120 THEN l(lne,13)=ptx-l(lne,20):l(lne,14)=pty-l(lne,21):goto updateupdate:

dx=ptx-l(lne,20):dy=pty-l(lne,21)
IF dimfunction=1  AND l(lne,1)=107 THEN GOSUB findangles::l(lne,13)=COS(gpi#*difangle)*distxy:l(lne,14)=-SIN(gpi#*difangle)*distxy
IF dimfunction=1 AND (l(lne,1)=110 or l(lne,1)=119 or l(lne,1)=131) THEN GOSUB findangles::l(lne,13)=COS(gpi#*difangle)*distxy:l(lne,8)=SIN(gpi#*difangle)*distxy
IF dimfunction=1 AND l(lne,1)=116 THEN GOSUB findangles::l(lne,13)=COS(gpi#*difangle)*distxy:l(lne,14)=-SIN(gpi#*difangle)*distxy
IF dimfunction=1 AND l(lne,1)>199 and l(lne,1)<230 THEN dx2=l(lne,20)-l(l(lne,0),20):dy2=l(lne,21)-l(l(lne,0),21):GOSUB findangles10::dx=ptx-l(l(lne,0),20):dy=pty-l(l(lne,0),21):GOSUB findangles::l(lne,13)=COS(gpi#*(difangle-angle))*distxy

IF dimfunction=2 THEN GOSUB findangle87::l(lne,14)=sina2-(l(lne,5)*.4)
IF dimfunction=3 THEN GOSUB findangle87::l(lne,15)=sina2-(l(lne,5)*.4)
IF dimfunction=4 THEN GOSUB findangles::lval=COS(gpi#*difangle)*distxy
GOSUB updateupdate:
RETURN
inputprf:

INPUT "col";col
IF col=0 THEN prf(pf,0)=i:RETURN
i=i+1
prf(pf,i)=col
GOTO inputprf:
RETURN
inputtr:
locate 1,5:
INPUT "col";col
return
inselcode:
beep
locate 5,1:print "copying select"
for i=1 to nl
if sl%(i)=sl%(0) then cpy(i)=1 else cpy(i)=0
sl%(i)=0
next i
sl%(0)=0

return
clearCurLne:
IF prf(1,0)=0 THEN FOR t=0 TO 22:l(lne,t)=0:NEXT t:lst$(lne)="":lt$(lne)="":GOSUB updateupdate::RETURN
FOR t=1 TO prf(1,0)
IF prf(1,t)=-2 THEN lt$(lne)=""
IF prf(1,t)=-1 THEN lst$(lne)=""
IF prf(1,t)>0 THEN l(lne,prf(1,t))=0
NEXT t
GOSUB updateupdate:
RETURN
defaultcolors:
defpen(0,0)=0:defpen(0,1)=0:defpen(0,2)=0:defpen(0,3)=0
defpen(1,0)=0:defpen(1,1)=0:defpen(1,2)=65535:defpen(1,3)=1
defpen(2,0)=0:defpen(2,1)=65535:defpen(2,2)=65535:defpen(2,3)=249
defpen(3,0)=0:defpen(3,1)=65535:defpen(3,2)=0:defpen(3,3)=3
defpen(4,0)=65535:defpen(4,1)=65535:defpen(4,2)=0:defpen(4,3)=4
defpen(5,0)=65535:defpen(5,1)=0:defpen(5,2)=0:defpen(5,3)=5
defpen(6,0)=65535:defpen(6,1)=0:defpen(6,2)=65535:defpen(6,3)=6
defpen(7,0)=65535:defpen(7,1)=65535:defpen(7,2)=65535:defpen(7,3)=249
defpen(8,0)=65535:defpen(8,1)=65535:defpen(8,2)=65535:defpen(8,3)=249
defpen(9,0)=65535:defpen(9,1)=65535:defpen(9,2)=65535:defpen(9,3)=249
defpen(10,0)=0:defpen(10,1)=16383:defpen(10,2)=65535:defpen(10,3)=20
defpen(11,0)=0:defpen(11,1)=32767:defpen(11,2)=65535:defpen(11,3)=30
defpen(12,0)=0:defpen(12,1)=49151:defpen(12,2)=65535:defpen(12,3)=40
defpen(13,0)=0:defpen(13,1)=65535:defpen(13,2)=49151:defpen(13,3)=60
defpen(14,0)=0:defpen(14,1)=65535:defpen(14,2)=32767:defpen(14,3)=70
defpen(15,0)=0:defpen(15,1)=65535:defpen(15,2)=16383:defpen(15,3)=80
defpen(16,0)=16383:defpen(16,1)=65535:defpen(16,2)=0:defpen(16,3)=100
defpen(17,0)=32767:defpen(17,1)=65535:defpen(17,2)=0:defpen(17,3)=110
defpen(18,0)=49151:defpen(18,1)=65535:defpen(18,2)=0:defpen(18,3)=120
defpen(19,0)=65535:defpen(19,1)=49151:defpen(19,2)=0:defpen(19,3)=140
defpen(20,0)=65535:defpen(20,1)=32767:defpen(20,2)=0:defpen(20,3)=150
defpen(21,0)=65535:defpen(21,1)=16383:defpen(21,2)=0:defpen(21,3)=160
defpen(22,0)=65535:defpen(22,1)=0:defpen(22,2)=16383:defpen(22,3)=180
defpen(23,0)=65535:defpen(23,1)=0:defpen(23,2)=32767:defpen(23,3)=190
defpen(24,0)=65535:defpen(24,1)=0:defpen(24,2)=49151:defpen(24,3)=200
defpen(25,0)=49151:defpen(25,1)=0:defpen(25,2)=65535:defpen(25,3)=220
defpen(26,0)=32767:defpen(26,1)=0:defpen(26,2)=65535:defpen(26,3)=230
defpen(27,0)=16383:defpen(27,1)=0:defpen(27,2)=65535:defpen(27,3)=240
defpen(28,0)=49151:defpen(28,1)=49151:defpen(28,2)=49151:defpen(28,3)=253
defpen(29,0)=32767:defpen(29,1)=32767:defpen(29,2)=32767:defpen(29,3)=252
defpen(30,0)=16383:defpen(30,1)=16383:defpen(30,2)=16383:defpen(30,3)=251
for i=0 to 31:defpen(i,4)=.125:next i:defpen(8,4)=.45:defpen(9,4)=.525
if bkgrnd=1 then gpen=7:gosub returnpen2::return
defpen(0,0)=65535:defpen(0,1)=65535:defpen(0,2)=65535
defpen(7,0)=0:defpen(7,1)=0:defpen(7,2)=0
defpen(8,0)=0:defpen(8,1)=0:defpen(8,2)=0
defpen(9,0)=0:defpen(9,1)=0:defpen(9,2)=0
gpen=7:gosub returnpen2:
return



findangle87:
dx2=dx
dy2=dy
GOSUB findangles10:
angle2=angle-l(lne,3)
sina2=-SIN(gpi#*angle2)*dpxy
RETURN
colinput:
locate 1,5:INPUT "col";col:IF col>22 THEN RETURN
INPUT num
IF l(lne,1)<100 AND col=16 THEN GOTO colinput16:
l(lne,col)=num
GOSUB updateupdate:

RETURN
colinput16:
IF l(lne,7)<6 THEN length1=s(2,l(lne,7)) ELSE length1=l(lne,7)
IF num=1 THEN num=length1
diff=num-l(lne,16)
:l(lne,6)=l(lne,6)+diff
IF l(lne,2)=l(lne+1,2) AND l(lne,3)=l(lne+1,3) THEN GOSUB forwardback2:

GOSUB updateupdate:
RETURN
displaypv:
gpen=7:gosub returnpen2:

pposx=(posx(posv)/sc)-fpx:pposy=(posy(posv)/sc)-fpy
CIRCLE pposx,pposy ,4
IF posv=oposv THEN CIRCLE pposx,pposy ,6
RETURN
distinlinetype:
cursor 2
call getmouse(m(0))
ptx=(m%(1)+fpx)*sc:pty=(m%(0)+fpy)*sc
dx=ptx-l(lne,20):dy=pty-l(lne,21)
GOSUB findangles::lval=COS(gpi*difangle)*distxy
lval=INT(lval*100)/100
lt$(lne)=lt$(lne)+STR$(lval)
l(lne,12)=lval
RETURN
Runselect:
BEEP
FOR ll=bl TO nl:sl%(ll)=0:NEXT ll
sl%(0)=0
n=sl%(0)+1
ll=lne
sl%(ll)=n
Runselect0:
IF ll<nl THEN IF l(ll+1,0)=ll THEN ll=ll+1:sl%(ll)=n:GOTO Runselect0:
ll=lne
Runselect1:
IF ll>1 THEN IF l(ll,0)=ll-1 THEN ll=ll-1:sl%(ll)=n:GOTO Runselect1:
FOR ll=bl TO nl
IF l(ll,0)>0 AND sl%(ll)<n THEN IF sl%(l(ll,0))=n THEN sl%(ll)=n:IF l(ll+1,0)=ll THEN GOSUB fillrun:
NEXT ll
sl%(0)=sl%(0)+1
RETURN
fillrun:
IF ll<nl AND l(ll+1,0)=ll THEN ll=ll+1:sl%(ll)=n:GOTO fillrun:
RETURN
RETURN
findangles10:
if dx2=0 and dy2=0 then dpxy=0:angle=0:return
dpxy=SQR(ABS((dx2^2)+(dy2^2))):sina=-dy2/dpxy:cosa=dx2/dpxy
IF cosa=0 THEN cosa=.000000001#
ttan=sina/cosa
atann=ATN(ttan)*114.591559#
angle=atann/2
IF cosa<=0 THEN angle=angle+180
IF cosa>=0 AND sina<0 THEN angle=angle+360
RETURN
forwardback:
if l(lne,1)>199 then goto forwardback4:
IF l(lne,7)<6 THEN length1=s(2,l(lne,7)) ELSE length1=l(lne,7)
length2=fix(length1/2)
IF c=60 THEN diff=-l(lne,16):l(lne,6)=l(lne,6)+diff
IF c=62 THEN diff=length1-l(lne,16):l(lne,6)=l(lne,6)+diff
IF l(lne,3)=l(lne+1,3) AND l(lne,2)=l(lne+1,2) THEN GOSUB forwardback2:
GOSUB updateupdate:
RETURN
forwardback2:
l(lne+1,6)=l(lne+1,6)-diff
FOR ll=lne+2 TO nl
IF l(ll,0)=lne+1 AND l(ll,3)<>l(lne+1,3) THEN l(ll,13)=l(ll,13)-diff
NEXT ll
RETURN
forwardback4:
if l(lne,0)=0 then return
lne1=lne
lne2=l(lne,0)
l(lne2,22)=l(lne,22)-(l(lne2,7)*l(lne,6)):l(lne2,10)=1:l(lne,10)=0
swap l(lne,7),l(lne2,7)
lne=lne2
gosub updateupdate:
return
findangles:
distxy=SQR(ABS((dx^2)+(dy^2)))
IF distxy>0 THEN cosa=dx/distxy:sina=dy/distxy
findaangles20:
sina=sina*-1
IF cosa=0 THEN cosa=.000000001#
ttan=sina/cosa
atann=ATN(ttan)*114.591559#
angle=atann/2
IF cosa<=0 THEN angle=angle+180
IF cosa>=0 AND sina<0 THEN angle=angle+360
difangle=angle-l(lne,3)
RETURN
grouplnes:
color 1
gosub groupem:
gpen=7:gosub returnpen2:
if xpt1#=xpt3# and ypt1#=ypt3# then goto undoselect:
dx=(xpt1#+fpx)*sc:dy=(ypt1#+fpy)*sc
dx2=(xpt3#+fpx)*sc:dy2=(ypt3#+fpy)*sc
IF dx>dx2 AND dy>dy2 THEN dir=-1 ELSE dir=1
IF dx>dx2 THEN SWAP dx,dx2
IF dy>dy2 THEN SWAP dy,dy2
sdx2=dx2:sdx=dx:sdy2=dy2:sdy=dy
selcnt=0
IF dir=-1 THEN goto undoselect2:
FOR ll=bl TO nl
IF sl%(ll)>=sl%(0) THEN IF (l(ll,20)>dx AND l(ll,20)<dx2) AND (l(ll,21)>dy AND l(ll,21)<dy2) THEN selcnt=selcnt+1:sl%(ll)=sl%(0)+1
NEXT ll
IF dir=1 AND selcnt>0 THEN sl%(0)=sl%(0)+1
'WHILE MOUSE(0)<>0:WEND
BEEP
RETURN
groupem:
call getmouse(m%(0))
xpt1#=m(1):ypt1#=m(0)
while mouse(_down)=0
CALL PENMODE(10)

call getmouse(m%(0))
xpt3#=m(1):ypt3#=m(0)
xpt2#=xpt3#:ypt2#=ypt1#:xpt4#=xpt1#:ypt4#=ypt3#
call moveto(xpt1#,ypt1#):call lineto(xpt2#,ypt2#):call lineto(xpt3#,ypt3#):call lineto(xpt4#,ypt4#):call lineto(xpt1#,ypt1#)
call moveto(xpt1#,ypt1#):call lineto(xpt2#,ypt2#):call lineto(xpt3#,ypt3#):call lineto(xpt4#,ypt4#):call lineto(xpt1#,ypt1#)

wend
while mouse(_down)<>0:wend

return

selectroot:
FOR ll=bl TO nl
IF sl%(ll)>selectroot THEN sl%(ll)=selectroot
NEXT ll
sl%(0)=selectroot
BEEP
RETURN
undoselect:
IF sl%(0)<=selectroot THEN RETURN
FOR ll=bl TO nl
IF sl%(ll)>=sl%(0) THEN sl%(ll)=sl%(0)-1
NEXT ll
sl%(0)=sl%(0)-1
BEEP
RETURN
undoselect2:
IF sl%(0)<=selectroot THEN RETURN
FOR ll=bl TO nl
IF (sl%(ll)>selectroot AND sl%(ll)>=sl%(0)) THEN IF (l(ll,20)>dx AND l(ll,20)<dx2) AND (l(ll,21)>dy AND l(ll,21)<dy2) THEN sl%(ll)=sl%(0)-1
NEXT ll
BEEP
BEEP
RETURN
joiner:
ttan=TAN(gpi#*((45)/2))
changepos=ttan*changepos
RETURN

lloffset:
IF l(lne,1)>99 OR l(lne,0)=0 THEN RETURN
cursor 2
IF mse=1 THEN call getmouse(m(0)):ptx=(m%(1)+fpx)*sc:pty=(m%(0)+fpy)*sc ELSE ptx=posx(posv):pty=posy(posv)
dx2=ptx-l(l(lne,0),20):dy2=pty-l(l(lne,0),21)
GOSUB findangles10:
angle=(angle-l(l(lne,0),3))
IF l(l(lne,0),2)=0 THEN l(lne,13)=(COS(gpi#*angle)*dpxy):l(lne,14)=(SIN(gpi#*angle)*dpxy)
IF l(l(lne,0),2)<>0 THEN l(lne,15)=(-COS(gpi#*angle)*dpxy):l(lne,14)=(SIN(gpi#*angle)*dpxy)
GOSUB updateupdate:
mse=0
RETURN
Pvdist:
dx2=posx(posv)-l(lne,20)
dy2=posy(posv)-l(lne,21)
nnn=SQR(ABS((dx2^2)+(dy2^2)))
xxx=nnn:GOSUB subfractions:
IF Pvint=0 THEN Pvint=2
IF Pvint<0 THEN changepos=changepos-xxx:RETURN
changepos=xxx/Pvint:changepos(0)=xxx
RETURN
findposv:
Cursor 2
call getmouse (m%(0))
xpt=(m%(1)+fpx)*sc
ypt=(m%(0)+fpy)*sc
diff2=99999:i1=0
FOR i=0 TO npv
dx=(xpt-posx(i)):dy=(ypt-posy(i)):diff=SQR(ABS((dx^2)+(dy^2))):IF diff<diff2 then  diff=diff2:i1=i
NEXT i
IF c=106 THEN posx(posv)=posx(i1):posy(posv)=posy(i1):posz(posv)=posz(i1):beep ELSE posv=11:BEEP:BEEP
GOSUB displaypv:
locate 1,5:PRINT posv
RETURN

getdim:


fpx=(mouse(_horz)+fpx)*sc
fpy=(mouse(_vert)+fpy)*sc
fpx=(fpx/sc)-screenx
fpy=(fpy/sc)-screeny
GOSUB fpxytest:
GOTO displaypv:
RETURN
entry01:
IF l(lne,0)<0 THEN l(lne,0)=l(lne,0)*-1:RETURN
l(lne,0)=lne-l(lne,0):IF l(lne,0)<0 THEN lne=lne-1
RETURN


lneplusone:
if l(lne,1)>199 and l(lne,0)>0 and selcode=0 then IF c=97 AND l(lne,0)>bl THEN lne=l(lne,0):GOSUB onlne::GOTO toreturn:
IF sl%(0)=0 THEN IF c=115 AND lne<nl THEN lne=lne+1
IF sl%(0)=0 THEN IF c=97 AND lne>bl THEN lne=lne-1
IF (sl%(0)<>0 AND c=115) THEN GOSUB lneplus1:
IF (sl%(0)<>0 AND c=97) THEN GOSUB lneminus1:
IF selcode=1 THEN found=0::GOSUB lneplusone2::IF found=1 THEN fpx=(l(lne,20)/sc)-screenx:fpy=(l(lne,21)/sc)-screeny:GOSUB fpxytest::CLS:GOSUB playpicture::GOSUB onlne::GOSUB toreturn::RETURN ELSE GOTO lneplusone:

GOSUB onlne::GOTO toreturn:
RETURN

keyin:


n=c-48

locate 1,5
if l(lne,1)<99 and l(lne,7)=4 then return
'IF c=50 AND ductindex<6 AND l(lne,1)<13 THEN l(lne,7)=ductindex
IF n=0 THEN locate 1,5:PRINT "link-code";:INPUT l(lne,0):INPUT l(lne,1):GOTO toreturnn:
IF n=1 THEN locate 1,5:PRINT "angle1-angle2";:INPUT l(lne,2):INPUT l(lne,3):GOTO toreturnn:
IF n=2 THEN locate 1,5:PRINT "wth-depth";:INPUT l(lne,4):INPUT l(lne,5):GOTO toreturnn:
IF n=3 THEN gosub inkey::l(lne,6)=nnn:GOTO toreturnn:
IF n=4 THEN locate 1,5:PRINT "stdlength";:INPUT l(lne,7):GOTO toreturnn:
IF n=5 THEN locate 1,5:PRINT "override";:INPUT l(lne,8):GOTO toreturnn:
IF n=6 THEN locate 1,5:PRINT "char";:INPUT l(lne,9):GOTO toreturnn:
IF n=7 THEN locate 1,5:PRINT "dx";:INPUT l(lne,13):GOTO toreturnn:
IF n=8 THEN locate 1,5:PRINT "dy";:INPUT l(lne,14):GOTO toreturnn:
IF n=9 THEN locate 1,5:PRINT "dz";:INPUT l(lne,15):GOTO toreturnn:

GOTO toreturnn:
RETURN
killlne:
FOR ff=0 TO 22:l(lne,ff)=0:NEXT ff:lst$(lne)="":lt$(lne)=""
if hdl&(lne)>0 then kill picture hdl&(lne):hdl&(lne)=0
GOSUB updateupdate:

return
lneplus1:
IF lne>=nl THEN RETURN
olne=lne
FOR ll=olne+1 TO nl
IF sl%(ll)=sl%(0) THEN lne=ll:RETURN
NEXT ll
RETURN
lneminus1:
IF lne<=bl THEN RETURN
olne=lne
FOR ll=olne-1 TO bl STEP -1
IF sl%(ll)=sl%(0) THEN lne=ll:RETURN
NEXT ll
RETURN

lneplusone2:
IF lne<2 OR lne>nl-1 THEN found=1:RETURN
if l(lne,20)=0 or l(lne,21)=0 then return
if cpy(lne)=1 then found=1
return
nlplusone:
nl=nl+1
sl%(nl)=sl%(0)
RETURN
limitposv:
cursor 2
call getmouse (m(0))
xpt=(m%(1)+fpx)*sc
ypt=(m%(0)+fpy)*sc
FOR i=0 TO npv
dx=ABS(xpt-posx(i))
dy=ABS(ypt-posy(i))
IF dx+dy<4 THEN npv=i:posv=npv:BEEP:RETURN
NEXT i
RETURN
getint:
BEEP
olne=lne
cursor 2
call getmouse (m%(0))
xpt=(m%(1)+fpx)*sc
ypt=(m%(0)+fpy)*sc
gosub closestlne:
IF lstatus=1 AND closest(0)<>lne THEN lne2=l(lne,0):gosub nxtclosestlne::l(lne,0)=closest(0):GOSUB updateupdate:
IF lstatus=2 THEN lne2=lne:gosub nxtclosestlne::lne=closest(0):GOSUB keeptrack::GOSUB onlne::GOSUB toreturn::IF l(lne,1)=110 AND dimtrack=1 THEN BEEP
IF uangle<>0 AND lstatus=3 OR lstatus=4 THEN GOTO getint2:
IF lstatus=3 THEN posx(posv)=l(closest(0),20):GOTO displaypv:
IF lstatus=4 THEN posy(posv)=l(closest(0),21):GOTO displaypv:
IF lstatus=5 THEN posx(posv)=l(closest(0),20):posy(posv)=l(closest(0),21):GOTO displaypv:
return

getint2:
ll=closest(0)
dx2=l(ll,20)-posx(posv):dy2=l(ll,21)-posy(posv)
IF ABS(dx2)<.001 AND ABS(dy2)<.001 THEN RETURN
GOSUB findangles10:
angle=(angle-uangle)
distx=(COS(gpi#*angle)*dpxy)
disty=SIN(gpi#*angle)*dpxy
IF lstatus=3 THEN posx(posv)=posx(posv)+COS(gpi#*uangle)*distx:posy(posv)=posy(posv)-SIN(gpi#*uangle)*distx
IF lstatus=4 THEN posx(posv)=posx(posv)+COS(gpi#*(uangle+90))*disty:posy(posv)=posy(posv)-SIN(gpi#*(uangle+90))*disty
GOTO displaypv:
RETURN
keeptrack:

trk(3)=trk(2)
trk(2)=trk(1)
trk(1)=closest(0)
RETURN


closestlne:
diff2=99999999:closest(0)=0:i=0
for ll=1 to nl
if sl(0)=sl(ll) then dx=(xpt-l(ll,20)):dy=(ypt-l(ll,21)):diff=SQR(ABS((dx^2)+(dy^2))):IF diff<diff2 THEN diff2=diff:closest(0)=ll 
next ll
return
nxtclosestlne:
for ll=1 to nl
if sl(0)=sl(ll) and l(ll,20)=l(closest(0),20) and l(ll,21)=l(closest(0),21) and i<9 then i=i+1:closest(i)=ll
next ll
for ll=1 to i
if closest(ll)>lne2 then closest(0)=closest(ll):return
next ll
if i>0 then closest(0)=closest(1)
return

inkey:
sgna=1
'if ftonly=1 then input "ftonly";nnn:nnn=nnn*12:return
if inmetric=1 then gosub metinkey::nnn=nnn/25.4:return
IF english=0 THEN GOTO metinkey:
FOR i=1 TO 4:in(i)=0:NEXT i
nnn=0:i=1
nin:key1$=INKEY$:IF key1$="" THEN GOTO nin:

if key1$="-" then sgna=-1:goto nin:
asc2=asc1:asc1=ASC(key1$)
IF asc1>=48 AND asc1<=57 THEN n=asc1-48:in(i)=(in(i)*10)+n
IF asc1=3 AND asc2=asc1 AND in(3)=0 THEN nnn=(in(1)*12)+in(2):nnn=nnn*sgna:BEEP:RETURN
IF asc1=3 AND asc2=asc1 AND in(3)>0 THEN IF in(4)>0 THEN nnn=(in(1)*12)+in(2)+(in(3)/in(4)):nnn=nnn*sgna:BEEP:RETURN ELSE nnn=(in(1)*12)+in(2)+(in(3)/8):nnn=nnn*sgna:BEEP:RETURN
IF asc1=3  THEN i=i+1:GOTO nin:
GOTO nin:
RETURN
metinkey:
locate 1,5:
INPUT "mm";nnn
RETURN
finduangle:
cursor 2
call getmouse(m(0))
posx4=(m%(1)+fpx)*sc:posy4=(m%(0)+fpy)*sc
dist2=9999999
uangle=0
FOR f=1 TO ngrids
FOR ll=1 TO lgrid(f)
dx2=posx4-grid(f,ll,1):dy2=posy4-grid(f,ll,2):dist=SQR(ABS(dx2^2+dy2^2))
IF dist<dist2 THEN dist=dist:uangle=grid(f,ll,3)
dx2=posx4-grid(f,ll,4):dy2=posy4-grid(f,ll,5):dist=SQR(ABS(dx2^2+dy2^2))
IF dist<dist2 THEN dist2=dist:uangle=grid(f,ll,3)
NEXT ll
NEXT f
IF uangle>360 THEN uangle=uangle-360
IF uangle>90 AND uangle<270 THEN uangle=uangle+180
GOSUB printline:
RETURN
fpxytest:
IF fpx<-screenx*2 THEN fpx=-screenx*2
IF fpx>32700 THEN fpx=32700
IF fpy<-screeny*2 THEN fpy=-screeny*2
IF fpy>32700 THEN fpy=32700
RETURN

inputstring:
IF prf(0,0)>0 THEN GOTO inmultcol:
IF stronly=0 THEN GOTO inputstringdir:
edit menu 3
call getmouse(m(0))
edit FIELD #1, "Name",(screenx-226,screeny-42)-(screenx+226,screeny+42),_framed    ,_leftJust
IF whichstring=1 THEN edit$(1)=lst$(lne) ELSE edit$(1)=lt$(lne)
inputstringa:
cnt=INSTR(1,edit$(1),chr$(13)):if cnt>0 then goto returninputstring:
if len(edit$(1))>250 then edit$(1)=left$(edit$(1),250):goto returninputstring:
HANDLEEVENTS

goto inputstringa:
return

returninputstring:
n1=len(edit$(1))
llst$=left$(edit$(1),cnt-1)
if n1-(cnt+2)>0 then rlst$=right$(edit$(1),n1-(cnt+1)) else rlst$=""
IF whichstring=1 THEN lst$(lne)=llst$+rlst$ else lt$(lne)=llst$+rlst$
IF whichstring=1 THEN llst2$=lst$(lne):gosub makecaps::lst$(lne)=llst$
IF whichstring=2 THEN llst2$=lt$(lne):gosub makecaps::lt$(lne)=llst$

edit field close #1
flushevents

gosub seteditmenu:

c=100:goto strtput2:

return

inputstringdir:
locate 1,2
IF whichstring=1 THEN INPUT "string";lst$(lne):if makecaps=1 then llst2$=lst$(lne):gosub makecaps::lst$(lne)=llst$
IF whichstring=2 THEN INPUT "linetype";lt$(lne):if makecaps=1 then llst2$=lt$(lne):gosub makecaps::lt$(lne)=llst$

RETURN
inmultcol:
print "i am here 1"
locate 1,5:
FOR i=1 TO prf(0,0)
PRINT "input col";prf(0,i):IF prf(0,i)>=0 THEN INPUT a ELSE INPUT a$
IF prf(0,i)>0 THEN l(lne,prf(0,i))=a
IF prf(0,i)=-1 THEN lst$(lne)=a$
IF prf(0,i)=-2 THEN lt$(lne)=a$
NEXT i
RETURN
LibMerge:
ofilename$=gfilename$:oVolRefNum%=VolRefNum%
if c=76 then VolRefNum%=Libnum1 else VolRefNum%=Libnum2
input "file number";gfilename$
if gfilename$="0" then gFilename$ = FILES$ (_fOpen, "TEXT", , VolRefNum%):Libnum1=VolRefNum%
if gfilename$="1" then gFilename$ = FILES$ (_fOpen, "TEXT", , VolRefNum%):Libnum1=VolRefNum%
IF gfilename$="2" THEN IF libp=0 THEN libp=1:BEEP:BEEP:PRINT "Library Positioning off":RETURN ELSE libp=0:BEEP:PRINT "Library Positioning on":RETURN

if gFilename$="" then gFilename$ = FILES$ (_fOpen, "TEXT", , VolRefNum%):if c=76 then Libnum1=VolRefNum% else Libnum2=VolRefNum%
print gFilename$,VolRefNum%
nl2=nl
rr=nl
gosub Rtn105a:
bl2=nl2+1
sl%(0)=sl%(0)+1:FOR lne=bl2 TO nl:sl%(lne)=sl%(0):NEXT lne
cursor 4:osc=sc:sc=psc
posxx=l(bl2,20):posyy=l(bl2,21)
FOR lne=bl2 TO nl
IF libp=0 THEN l(lne,20)=posx(posv)+(l(lne,20)-posxx):l(lne,21)=posy(posv)+(l(lne,21)-posyy)
gosub record:
NEXT lne
lne=bl2
sc=osc:cursor 2
gfilename$=ofilename$
VolRefNum%=oVolRefNum%
RETURN

listfiles:
locate 1,5
ll2=1:l(ll2,7)=1
nfles(0)=0
FOR ll=1 TO nl
IF l(ll,1)=9999 THEN l(ll,7)=ll+1:l(ll2,8)=ll-1:ll2=ll:nfles(0)=nfles(0)+1:nfles(nfles(0))=ll
NEXT ll
l(nfles(1),7)=nfles(1)+1
l(ll2,8)=nl
FOR t=1 TO nfles(0)
PRINT t;"  ";lst$(nfles(t));"  ";l(nfles(t),7);"  ";l(nfles(t),8)
NEXT t

RETURN
markpv:
FOR i=0 TO npv
CALL MOVETO((posx(i)/sc)-fpx,(posy(i)/sc)-fpy):PRINT i;
NEXT i
RETURN

newelevation:
GOSUB Getcode:
IF l(lne,2)<>0 THEN l(lne,22)=nnn:RETURN
IF c=66 THEN wth2=l(lne,5)/2 ELSE wth2=-l(lne,5)/2
IF l(lne,7)=4 THEN olne2=lne:elev=nnn+wth2:elev1=elev+l(lne,5)/2:elev2=l(lne,22)+l(lne,5)/2:difelev=elev1-elev2:GOTO newelevation3:
l(lne,22)=nnn+wth2
IF l(lne,0)=0 OR l(lne,1)>99 THEN RETURN
IF code>1 AND code<6 THEN newelevation2:
IF l(l(lne,0),2)=0 AND l(lne,2)=0 THEN l(lne,15)=l(lne,22)-l(l(lne,0),22)
RETURN
newelevation2:
IF l(l(lne,0),2)=0 OR nnn<>0 THEN RETURN
dist1=l(l(lne,0),17)
GOSUB findradd::IF code=5 AND l(lne,8)=0 THEN radd1=l(lne,5)
dist2=(l(lne,5)/2)+radd1
l(lne,22)=l(l(lne,0),22)+(SGN(l(l(lne,0),2))*(dist1+dist2))
l(l(lne,0),6)=l(l(lne,0),17)
GOSUB updateupdate:
RETURN
newelevation3:
IF l(lne,7)=4 AND l(lne,0)<>0 AND lne>1 THEN lne=lne-1:GOTO newelevation3:
l(lne,22)=l(lne,22)+difelev
GOSUB updateupdate:
lne=olne2
RETURN
nearestcol:
IF john>0 THEN GOSUB john::return
posx4=l(lne,20):posy4=l(lne,21)
GOSUB Rtn504a:
dx2=ABS(dx2):dy2=ABS(dy2)
CALL MOVETO(l(lne,20)/sc-fpx,l(lne,21)/sc-fpy):PRINT "V:";
xxx=dx2:GOSUB subfractions:
CALL MOVETO(l(lne,20)/sc-fpx,l(lne,21)/sc-fpy+10):PRINT "H:";
xxx=dy2:GOSUB subfractions:
RETURN

onlne:

CALL TEXTMODE(1)
movex=(INT(RND(3))-1)*20
movey=(INT(RND(3))-1)*20
CALL MOVETO (l(lne,20)/sc-fpx+movex-7,l(lne,21)/sc-fpy+movey):PRINT lne;
CALL PENPAT(VARPTR(pat%(0)))
CALL MOVETO (l(lne,20)/sc-fpx+movex,l(lne,21)/sc-fpy+movey):CALL LINETO(l(lne,20)/sc-fpx,l(lne,21)/sc-fpy)
CALL PENNORMAL
CIRCLE l(lne,20)/sc-fpx,l(lne,21)/sc-fpy,2
IF (l(lne,1)=107 AND l(lne,0)>0) THEN CIRCLE l(l(lne,0),20)/sc-fpx,l(l(lne,0),21)/sc-fpy,2:CALL MOVETO (l(l(lne,0),20)/sc-fpx,l(l(lne,0),21)/sc-fpy):PRINT l(lne,0);

CALL TEXTMODE(0)
RETURN
optionw:
l(nl,0)=0
FOR t=1 TO 9:l(nl,t)=l(lne,t):NEXT t:lst$(nl)=lst$(lne):lt$(nl)=""
FOR t=10 TO 19:l(nl,t)=0:NEXT t
IF l(lne,1)>100 THEN l(nl,13)=l(lne,13):l(nl,14)=l(lne,14):l(nl,15)=l(lne,15):l(nl,19)=l(lne,19):lst$(nl)=lst$(lne):lt$(nl)=lt$(lne):if l(nl,1)=110 then l(nl,14)=0:l(nl,15)=0
IF l(lne,0)>0 THEN l(nl,0)=nl-(lne-l(lne,0))
IF l(nl,0)>0 AND l(nl,1)>=200 THEN dx2=l(nl,20)-l(l(nl,0),20):dy2=l(nl,21)-l(l(nl,0),21):GOSUB findangles10::l(nl,3)=angle
if l(lne,1)>199 and l(lne,1)<300 then l(nl,17)=0:l(nl,18)=0:lt$(nl)=""
lne=nl:l(nl,12)=0
sl%(nl)=sl%(0)
GOSUB onlne::GOSUB toreturn::
GOTO updateupdate:
RETURN
optionq:
FOR t=1 TO 9:l(lne+1,t)=l(lne,t):NEXT t:lst$(lne+1)=lst$(lne):lt$(lne+1)=""
FOR t=10 TO 19:l(lne+1,t)=0:NEXT t
l(lne+1,20)=posx(posv):l(lne+1,21)=posy(posv):l(lne+1,22)=posz(posv)
IF l(lne,1)>100 THEN l(lne+1,13)=l(lne,13):l(lne+1,14)=l(lne,14):l(lne+1,15)=l(lne,15):lst$(lne+1)=lst$(lne):l(lne+1,12)=0:if l(lne+1,1)=110 then l(lne+1,14)=0:l(lne+1,15)=0

IF l(lne,0)>0 THEN l(lne+1,0)=lne
lne=lne+1
IF lne>nl THEN nl=lne:el=lne

GOSUB onlne::GOSUB toreturn:
GOTO updateupdate:
IF sl%(0)>0 THEN sl%(nl)=sl%(0)
RETURN
shiftpv:
BEEP
cursor 2
call getmouse(m(0))
locate 1,5
ptx=(m%(1)+fpx)*sc:pty=(m%(0)+fpy)*sc
dist1=100:dist2=100
FOR i=0 TO npv
IF c=65 THEN dx=ABS(posx(i)-ptx):IF dx<dist1 THEN dist1=dx:n=i
IF c=83 THEN dy=ABS(posy(i)-pty):IF dy<dist2 THEN dist2=dy:n=i
NEXT i
IF c=65 THEN posx(posv)=posx(n)
IF c=83 THEN posy(posv)=posy(n)
GOSUB displaypv:
RETURN
pvmove:
BEEP
GOSUB inkey:
LOCATE 1,5:PRINT "                                                         "
IF nnn=0 THEN changepos=changepos: ELSE changepos(0)=changepos:changepos=nnn
LOCATE 1,5:PRINT npv;angle4;saveangle;:xxx=changepos:GOSUB subfractions:
tinn:c$=INKEY$:IF c$="" THEN GOTO tinn:
c=ASC(c$)
if tangleon=1 then tangle=l(lne,3)
IF c=114 THEN IF repeat=0 THEN repeat=1:BEEP:BEEP:GOTO tinn: ELSE repeat=0:BEEP:GOTO strtput:
IF c=46 THEN changepos8=changepos:GOTO tinn:
IF c=92 THEN dx2=posx(posv)-l(lne,20):dy2=posy(posv)-l(lne,21):GOSUB findangles10::l(lne,3)=angle:GOSUB updateupdate::GOTO tinn:
IF c=108 THEN IF tangleon=0 THEN tangleon=1:BEEP:BEEP:GOTO tinn: ELSE tangleon=0:BEEP:GOTO strtput:

IF c=64 THEN INPUT "changeangle";changle:if l(lne,0)>0 then l(lne,3)=l(l(lne,0),3)+changle:GOSUB updateupdate::goto printline: else  l(lne,3)=l(trk(2),3)+changle:GOSUB updateupdate::goto printline:
IF c=118 THEN locate 1,5:INPUT "Save Angle=";tangle:BEEP:GOTO tinn:
IF c=103 THEN locate 1,5:INPUT "Col#";col:IF col>0 THEN l(lne,col)=changepos:GOSUB updateupdate::GOSUB printline::RETURN ELSE l(lne,col)=tangle:GOSUB updateupdate::GOSUB printline::RETURN
IF c=107 THEN locate 1,5:INPUT "Col#";col:IF col>0 THEN changepos=l(lne,col):GOSUB updateupdate::GOSUB printline::RETURN ELSE tangle=l(lne,col):GOSUB updateupdate::GOSUB printline::RETURN
IF c=96 THEN INPUT "col";col:changepos(col)=changepos:GOTO tinn:
IF c=32 THEN GOSUB changeposrtn::GOTO tinn:
IF c=126 THEN GOSUB changeposrtndir::GOTO tinn:
IF c=106 THEN GOSUB joiner::GOTO tinn:
IF c=110 THEN changepos=l(lne,4)/2:BEEP:GOTO tinn:
IF c=109 THEN changepos=l(lne,5)/2:BEEP:GOTO tinn:
IF c=195 THEN tangle=l(lne,3):BEEP:GOTO tinn:
IF c=104 AND sl%(0)>0 THEN GOSUB pvmove2::GOTO tinn:
IF c=105 THEN INPUT "Pvinterval";Pvint
IF c=120 THEN posv=0:npv=0:GOTO tinn:
IF c=98 THEN GOSUB pvperimeter::RETURN
IF (c=45 OR c=43 OR c=47 OR c=42 OR c=27 OR c=61) THEN GOSUB Calculator::GOTO tinn:
IF c=28 THEN angle3=tangle+180:GOTO interpose1:
IF c=29 THEN angle3=tangle+0:GOTO interpose1:
IF c=30 THEN angle3=tangle+90:GOTO interpose1:
IF c=31 THEN angle3=tangle+270:GOTO interpose1:
IF c=3 THEN repeat=0:RETURN
IF (c<48 OR c>57) THEN repeat=0:GOTO strtput2:
IF c=48 THEN repeat=0:RETURN
IF c=49 THEN angle3=uangle+225
IF c=50 THEN angle3=uangle+270
IF c=51 THEN angle3=uangle+315
IF c=52 THEN angle3=uangle+180
IF c=53 THEN changepos(0)=changepos:changepos=changepos8:GOTO tinn:
IF c=54 THEN angle3=uangle+0
IF c=55 THEN angle3=uangle+135
IF c=56 THEN angle3=uangle+90
IF c=57 THEN angle3=uangle+45
interpose1:
IF angle3>360 THEN angle3=angle3-360
posx(posv)=posx(posv)+COS(gpi#*(angle3))*changepos:posy(posv)=posy(posv)-SIN(gpi#*(angle3))*changepos
GOSUB trackpv:
GOSUB displaypv:
IF repeat=1 THEN GOTO tinn:
RETURN
changeposrtn:
c$=INKEY$
IF c$<"0" OR c$>"9" THEN changeposrtn:
c=ASC(c$)
col=c-48
changepos=changepos(col)
xxx=changepos:GOSUB subfractions:
RETURN
changeposrtndir:
locate 1,5:
FOR t=0 TO 9
IF changepos(t)>0 THEN PRINT t;:xxx=changepos(t):GOSUB subfractions:
NEXT t
RETURN

pvperimeter:
INPUT "0=origin 1=ends";pvdir
olne=lne
FOR lne=bl TO nl
IF sl%(lne)=sl%(0) THEN GOSUB perconv:
NEXT lne
lne=olne
BEEP
RETURN

perconv:
IF pvdir=0 THEN GOSUB incnpv::posx(npv)=l(lne,20):posy(npv)=l(lne,21):RETURN
IF pvdir=1 THEN GOSUB incnpv::GOSUB sncsn::posx(npv)=l(lne,20)+cs1*l(lne,6):posy(npv)=l(lne,21)+sn1*l(lne,6):RETURN
RETURN
Perimeter:
fpt=lne
npt=nl
npts=(nl-fpt)
FOR t=0 TO npts
n1=nl+t+1
n2=fpt+t
GOSUB transfer2:
NEXT t
nl=nl+t
RETURN
transfer2:
IF l(n2,0)>0 THEN l(n2,0)=n2-l(n2,0)
FOR tt=0 TO 22:l(n1,tt)=l(n2,tt):NEXT tt:lst$(n1)=lst$(n2):lt$(n1)=lt$(n2)
IF l(n1,0)>0 THEN l(n1,0)=n1-l(n1,0)
RETURN
incnpv:
npv=npv+1:IF npv>99 THEN npv=1
RETURN
pvmove2:
olne=lne
slcnt=1
FOR lne=bl TO nl
IF slcnt<100 AND sl%(lne)=sl%(0) THEN slcnt=slcnt+1:posx(t)=l(lne,20):posy(t)=l(lne,21)
NEXT lne
npv=slcnt:BEEP
lne=olne
RETURN
positioninxy:
call getmouse(m(0))
xpt=(m%(1)+fpx)*sc
ypt=(m%(0)+fpy)*sc
dx=xpt-posx(posv):signx=SGN(dx)
dy=ypt-posy(posv):signy=SGN(dy)
dx=ABS(dx):dy=ABS(dy)
IF changepos8=0 THEN stx=6 ELSE stx=changepos8
corrx=(INT(((dx/stx)-INT(dx/stx))+.5)+INT(dx/stx))*stx
corry=(INT(((dy/stx)-INT(dy/stx))+.5)+INT(dy/stx))*stx
l(nl,20)=posx(posv)+(corrx*signx)
l(nl,21)=posy(posv)+(corry*signy)
RETURN

Calculator:
BEEP
LOCATE 4,1:PRINT"                                  "
LOCATE 5,1:PRINT"                                  "
LOCATE 6,1:PRINT"                                  "
LOCATE 4,1:xxx=changepos:GOSUB subfractions:
IF c=43 THEN PRINT "+";:GOSUB inkey::xxx=nnn:GOSUB subfractions::changepos=changepos+nnn:xxx=changepos:GOSUB subfractions:
IF c=45 THEN PRINT "-";:GOSUB inkey::xxx=nnn::GOSUB subfractions::changepos=changepos-nnn:xxx=changepos:GOSUB subfractions:
IF c=42 THEN INPUT "*";z11:changepos=changepos*z11:xxx=changepos:GOSUB subfractions:
IF c=47 THEN INPUT "/";z11:changepos=changepos/z11:xxx=changepos:GOSUB subfractions:
IF c=27 THEN changepos=0:xxx=changepos:GOSUB subfractions:
IF c=61 THEN INPUT changepos
RETURN
trackpv:
IF (trackpv=0 OR repeat=1) THEN RETURN
IF npv<99 THEN npv=npv+1 ELSE npv=savepv+1
posx(npv)=posx(posv):posy(npv)=posy(posv)
RETURN

playpicture:
CLS

PICTURE (-fpx,-fpy)-(32700*dsc-fpx,32700*dsc-fpy),border&
IF pictureselect=0 THEN gosub playpicts:
call moveto(screenx-5,screeny):call lineto(screenx+5,screeny)
call moveto(screenx,screeny-5):call lineto(screenx,screeny+5)
gosub playgrids:
oposv=posv:FOR posv=0 TO npv:GOSUB displaypv::NEXT posv:posv=oposv
IF posdwg=1 THEN GOSUB Rtn506a:
IF screenselect=1  THEN GOTO screenselect:

IF sl%(0)=0 THEN goto regularplay: ELSE goto selectplay:

return
'AND presetsc2<8
regularplay:
FOR ll%=bl TO nl
if hdl&(ll%)>0 then PICTURE (-fpx,-fpy)-((32700*dsc)-fpx,(32700*dsc)-fpy),hdl&(ll%)
NEXT ll%

return
selectplay:
FOR ll%=bl TO nl
if hdl&(ll%)>0 and sl%(ll%)=sl%(0) then PICTURE (-fpx,-fpy)-((32700*dsc)-fpx,(32700*dsc)-fpy),hdl&(ll%)
NEXT ll%

return
playpicts:
FOR ll%=1 TO 30
if pb(ll%)=2 and phdl&(ll%)>0 THEN PICTURE (-fpx,-fpy)-((32700*dsc)-fpx,(32700*dsc)-fpy),phdl&(ll%)
nEXT ll%
return
playgrids:
FOR ll%=1 TO 8
if pb(40+ll%)=2 THEN PICTURE (-fpx,-fpy)-((32700*dsc)-fpx,(32700*dsc)-fpy),hdlpics&(ll%)
nEXT ll%
return
screenselect:

selcnt=0
'expscreen=1-(presetsc2/20)
dx=-0
dy=-0
dx2=(screenx*2)+0
dy2=(screeny*2)+0
dx=(dx+fpx)*sc:dy=(dy+fpy)*sc
dx2=(dx2+fpx)*sc:dy2=(dy2+fpy)*sc
FOR ll%=bl TO nl
if hdl&(ll%)=0 then goto nxtscreenselect:

IF sl%(ll%)<>sl%(0) THEN GOTO nxtscreenselect:
IF (l(ll%,20)>dx AND l(ll%,20)<dx2) AND (l(ll%,21)>dy AND l(ll%,21)<dy2) THEN PICTURE (-fpx,-fpy)-((32700*dsc)-fpx,(32700*dsc)-fpy),hdl&(ll%):GOTO nxtscreenselect:
IF l(ll%,6)<24 or l(ll%,2)<>0 THEN GOTO nxtscreenselect:
length=l(ll%,6)
repeatscreenselect:
xpt=l(ll%,20)+COS(gpi#*l(ll%,3))*length:ypt=l(ll%,21)-SIN(gpi#*l(ll%,3))*length

IF (xpt>dx AND xpt<dx2) AND (ypt>dy AND ypt<dy2) THEN PICTURE (-fpx,-fpy)-((32700*dsc)-fpx,(32700*dsc)-fpy),hdl&(ll%):GOTO nxtscreenselect:
length=length-24:IF length>24 THEN GOTO repeatscreenselect:
nxtscreenselect:NEXT ll%
RETURN
printline:
IF posdwg=1 THEN RETURN
gpen=7:gosub returnpen2:
LOCATE 0,0

locate 0,0
CALL TEXTMODE(0)
IF pictureselect=1 THEN PRINT "Ã";
IF screenselect=1 THEN PRINT "ú";
IF update=1 THEN PRINT "¥";
'IF selkeys=1 THEN PRINT "×";
PRINT lne;
PRINT using "¨####";l(lne,0);
PRINT "c";l(lne,1);
PRINT int(l(lne,2)*1000)/1000;"¡  ";
PRINT int(l(lne,3)*1000)/1000;"¡  ";
PRINT int(l(lne,4)*1000)/1000;"Òx";
PRINT int(l(lne,5)*1000)/1000;"Òx";
PRINT int(l(lne,6)*1000)/1000;"Ò,   ";
PRINT int(l(lne,7)*1000)/1000;",   ";
print int(l(lne,8)*1000)/1000;",   ";
PRINT l(lne,9);",   ";
PRINT "{";int(l(lne,10)*1000)/1000;",   ";
PRINT int(l(lne,11)*1000)/1000;",   ";
print l(lne,12);"}                       "
'PRINT int(l(lne,12)*1000)/1000;"}                       "
PRINT int(l(lne,20)*1000)/1000;"Ò   ";
PRINT int(l(lne,21)*1000)/1000;"Ò   ";
PRINT int(l(lne,22)*1000)/1000;"Ò   ";
PRINT "dx";int(l(lne,13)*1000)/1000;",   ";
PRINT "dy";int(l(lne,14)*1000)/1000;",   ";
PRINT "dz";int(l(lne,15)*1000)/1000;"   ";
PRINT "(";int(l(lne,16)*1000)/1000;",   ";
PRINT int(l(lne,17)*1000)/1000;",   ";
PRINT int(l(lne,18)*1000)/1000;")   ";
PRINT l(lne,19);"                                 "
PRINT "{"lst$(lne);",    ";lt$(lne);"}";"                                                                   "
ddcode=0

IF l(lne,2)<>0 THEN LOCATE 0,3:PRINT "OE:";:xxx=l(lne,22):GOSUB subfractions:
IF l(lne,2)<>0 THEN LOCATE 22,3:PRINT "EE:";:xxx=l(lne,22)+(SGN(l(lne,2))*l(lne,6)):GOSUB subfractions:
IF l(lne,2)<>0 THEN LOCATE 0,4:PRINT ;" ";sl%(0);" ";bl;"-";nl;"  ";gfilename$;"  ";volrefnum%;" ";keycnt:gpen=7:gosub returnpen2::RETURN
LOCATE 0,3:PRINT "                                            "
LOCATE 0,3:PRINT "TE:";:xxx=l(lne,22)+(l(lne,5)/2):GOSUB subfractions:
LOCATE 22,3:PRINT "BE:";:xxx=l(lne,22)-(l(lne,5)/2):GOSUB subfractions:
if l(lne,12)>0 then LOCATE 33,3:PRINT "OH:";:xxx=l(lne,12)-changepos(8):GOSUB subfractions: else locate 33,3:print "                        "

LOCATE 0,4:PRINT sl%(0);" ";bl;"-";nl;"  ";gfilename$;" ";VolRefNum;" ";"  ";keycnt;

gpen=7:gosub returnpen2:
RETURN

roundodd:
if l(lne,16)=0 then return
IF l(lne,7)<6 THEN length1=s(2,l(lne,7)) ELSE length1=l(lne,7)
diff=l(lne,16)-length1
if diff>-2 then l(lne,16)=0:l(lne,6)=l(lne,6)-diff::GOSUB updateupdate::return
diff=l(lne,16)
if diff<2 then l(lne,16)=0:l(lne,6)=l(lne,6)-diff::GOSUB updateupdate::return
diff=l(lne,16)-fix(l(lne,16)+.5)
l(lne,6)=l(lne,6)-diff
GOSUB updateupdate:
RETURN
DefaultEnglish:
one=1
gosub setdefaults:
sc$(1)="3":sc$(2)="2"
sc$(3)="1 1Ú2":sc$(4)="1"
sc$(5)="3Ú4":sc$(6)="1Ú2"
sc$(7)="3Ú8 ":sc$(8)="1Ú4 {2}"
sc$(9)="3Ú16 {1 1Ú2}":sc$(10)="1Ú8 {1}"
sc$(11)="3Ú32 {3Ú4}":sc$(12)="1Ú16 {1Ú2}"
sc$(13)="3Ú64 {3Ú8}":sc$(14)="1Ú32 {1Ú4}"
sc$(15)="3Ú128 {3Ú16}":sc$(16)="1Ú64 {1Ú8}"
sc$(17)="3Ú256 {3Ú32}":sc$(18)="1Ú128 {1Ú16}"
sc$(19)="3Ú512 {3Ú64}":sc$(20)="1Ú256 {1Ú32}"
opresetsc2=1
scale(1)=12/(3*ssc):scale(2)=12/(2*ssc):FOR t=3 TO 19 STEP 2:scale(t)=scale(t-2)*2:scale(t+1)=scale(t-1)*2:NEXT t

ab=ab-1
FOR t=1 TO 20-ab
scale(t)=scale(t+ab)
sc$(t)=sc$(t+ab)
NEXT t
scale(0)=20-ab
psc=scale(1):sc=scale(10):sc10=scale(10):dsc=psc/sc
mini=4:gosub setmenu:
return
DefaultMetric:
one=25.4
ssc=ssc/25.4
gosub setdefaults:
sc$(1)="1:10":scale(1)=1/(ssc*(1/10))
sc$(2)="1:15":scale(2)=1/(ssc*(1/15))
sc$(3)="1:20":scale(3)=1/(ssc*(1/20))
sc$(4)="1:25":scale(4)=1/(ssc*(1/25))
sc$(5)="1:30"::scale(5)=1/(ssc*(1/30))
sc$(6)="1:35":scale(6)=1/(ssc*(1/35))
sc$(7)="1:40":scale(7)=1/(ssc*(1/40))
sc$(8)="1:45":scale(8)=1/(ssc*(1/45))
sc$(9)="1:50":scale(9)=1/(ssc*(1/50))
sc$(10)="1:100":scale(10)=1/(ssc*(1/100))
sc$(11)="1:150":scale(11)=1/(ssc*(1/150))
sc$(12)="1:200":scale(12)=1/(ssc*(1/200))
sc$(13)="1:250":scale(13)=1/(ssc*(1/250))
sc$(14)="1:300":scale(14)=1/(ssc*(1/300))
sc$(15)="1:350":scale(15)=1/(ssc*(1/350))
sc$(16)="1:400 {1Ú8}":scale(16)=1/(ssc*(1/400))
sc$(17)="1:450 {3Ú32}":scale(17)=1/(ssc*(1/450))
sc$(18)="1:500 {1Ú16}":scale(18)=1/(ssc*(1/500))
sc$(19)="1:750 {3Ú64}":scale(19)=1/(ssc*(1/750))
sc$(20)="1:1000 {1Ú32}":scale(20)=1/(ssc*(1/1000))
opresetsc2=1
ab=ab-1
FOR t=1 TO 20-ab
scale(t)=scale(t+ab)
sc$(t)=sc$(t+ab)
NEXT t
scale(0)=20-ab
psc=scale(1):sc=scale(10):sc10=scale(10):dsc=psc/sc
mini=2:GOSUB setmenu:
return
setdefaults:
scopt=1:lne=1:nl=1:bl=1:lheight=3*one:lwth=2*one:presetsc1=2:presetsc2=4:il=10
pat(0)=&H55AA
pat(1)=&HAA55
pat(2)=&H55AA
pat(3)=&HAA55
patb(0)=0
patb(1)=0
patb(2)=0
patb(3)=0

s(1,0)=8*one
s(1,1)=7.5*one
s(1,2)=8*one
s(1,3)=8*one
s(1,4)=8*one
s(1,5)=8*one
s(2,0)=56.25*one
s(2,1)=59*one
s(2,2)=120*one
s(2,3)=240*one
s(2,4)=480*one
s(2,5)=2400*one
s(3,0)=6*one
s(3,1)=6*one
s(3,2)=6*one
s(3,3)=6*one
s(3,4)=6*one
s(3,5)=6*one
s(4,0)=6*one
return
selectmove:
BEEP
posx4#=l(lne,20):posy4#=l(lne,21):olne3=lne
FOR lne=bl TO nl
IF sl%(lne)=sl%(0) AND sl%(0)>0 THEN l(lne,20)=posx(posv)+(l(lne,20)-posx4#):l(lne,21)=posy(posv)+(l(lne,21)-posy4#)
NEXT lne
lne=olne3:BEEP
GOTO selectupdate:
RETURN
selectupdate:
cursor 4:olne=lne:osc=sc:sc=psc
FOR lne=bl TO nl
IF (sl%(lne)>=sl%(0) OR (sl%(l(lne,0))>=sl%(0) AND l(lne,0)>0)) THEN gosub record:
NEXT lne
GOSUB undoselect:
sc=osc:lne=olne:cursor 2
RETURN

setmenu:

mini=4:oitem2=3:oitem10=1:oitem10=1

MENU 1,0,1,"File":MENU 1,1,1,"New":MENU 1,2,1,"Save...":MENU 1,3,1,"Save As...":MENU 1,4,1,"Open...":MENU 1,5,1,"Merge"
MENU 1,6,1,"Select by line":MENU 1,7,1,"Select Save":MENU 1,8,1,"Open Pictures"
MENU 1,9,1,"Background color"
MENU 1,10,1,"Select Append Save"
MENU 1,11,1,"Save Rfi's":MENU 1,12,1,"Add a B-file":MENU 1,13,1,"Open B-files":MENU 1,14,1,"Save B-files":MENU 1,15,1,"*Save last B-file"
MENU 1,16,1,"*Replace Last B-file":MENU 1,17,1,"Save Last B-file AS...":MENU 1,18,1,"Merge files":MENU 1,19,1,"Copy&Save":MENU 1,20,1,"Change folder":MENU 1,21,1,"Quit"
if english=0 then MENU 2,0,1,"Min":MENU 2,1,1,"m":MENU 2,2,1,"dm":MENU 2,3,2,"cm":MENU 2,4,1,"mm":mini=2:oitem2=2:oitem10=1
if english=1 then MENU 2,0,1,"Min":MENU 2,1,1,"1":MENU 2,2,1,"1Ú2":MENU 2,3,2,"1Ú4":MENU 2,4,1,"1Ú8":MENU 2,5,1,"1Ú16":MENU 2,6,1,"1Ú32":MENU 2,7,1,"1Ú64":MENU 2,8,1,"1Ú128"
gosub seteditmenu:
meNU 4,0,1,"Find":MENU 4,1,1,"Add/a":MENU 4,2,1,"Subtract/s":MENU 4,3,1,"forge/f"
MENU 4,4,1,"Bm El Calc":MENU 4,5,1,"Reverse":MENU 4,6,1,"Universal angle":MENU 4,7,1,"Increments":MENU 4,8,1,"RFI-Nearest Col":MENU 4,9,1,"Edit String Only/i":MENU 4,10,1,"Profile"
MENU 4,11,1,"Code117":MENU 4,12,1,"Changes":MENU 4,13,1,"Copy from lne":MENU 4,14,1,"pagon=off":MENU 4,15,1,"Multiple Saves":MENU 4,16,1,"Nearest 1":MENU 4,17,1,"Round Odd":MENU 4,18,1,"SL Extent":MENU 4,19,1,"Reduce File Size"
MENU 5,0,1,"Rout":MENU 5,1,1,"Z Coordinates/z":MENU 5,2,1,"Ruler":MENU 5,3,1,"All top/bottom elev/j":MENU 5,4,1,"Find Columns/k":
MENU 5,5,1,"PV-Circle":MENU 5,6,1,"Position Drawing/p":MENU 5,7,1,"Group":MENU 5,8,1,"Choose Grids":mENU 5,9,1,"Copy Grids"
menu 5,10,1,"Swap":MENU 5,11,1,"Load Table":MENU 5,12,1,"Pv Intervals":MENU 5,13,1,"Locate":MENU 5,14,1,"To 107":MENU 5,15,1,"Clipping":MENU 5,16,1,"Copy to pvs":MENU 5,17,1,"Breakout 119":MENU 5,18,1,"Fix elevations"
MENU 5,19,1,"Odd Lenth to Transition":MENU 5,20,1,"Intersection"
MENU 6,0,1,"Scale"
FOR t=1 TO scale(0):MENU 6,t,1,sc$(t):NEXT t
meNU 7,0,1,"Grids":MENU 7,1,1,"Input":MENU 7,2,1,"New":MENU 7,3,1,"Save":MENU 7,4,1,"Open":MENU 7,5,1,"Set Window"
MENU 8,0,1,"Duct":MENU 8,1,1,"TDC":MENU 8,2,1,"S&D":MENU 8,3,1,"10 feet":MENU 8,4,1,"20 feet":MENU 8,5,1,"40 feet":MENU 8,6,1,"200 feet":MENU 8,7,1,"No change"
MENU 9,0,1,"Dim":MENU 9,1,1,"Input Height":MENU 9,2,1,"Lengths/0":MENU 9,3,1,"WxD/1":MENU 9,4,1,"Odd/2":MENU 9,5,1,"Trans/3":MENU 9,6,1,"x dist/4":MENU 9,7,1,"y dist/5":MENU 9,8,1,"Get Dim/6":MENU 9,9,1,"T.E.ÚB.E./7"
MENU 9,10,1,"CÚL ELEV/8":MENU 9,11,1,"RiseÚFall/9":MENU 9,12,1,"All dim":MENU 9,13,1,"Beams":MENU 9,14,1,"Allign":MENU 9,15,1,"Reduce":MENU 9,16,1,"Seq Input":MENU 9,17,1,"Instring":MENU 9,18,1,"Hor Num":MENU 9,19,1,"Beams T/B"
MENU 10,0,1,"Paper":MENU 10,1,1,"Custom Paper":MENU 10,2,1,"48''x36''":MENU 10,3,1,"42''x30''":MENU 10,4,1,"17''x11''":MENU 10,5,1,"11''x8.5''"
MENU 10,6,1,"Plot Files":MENU 10,7,1,"window":MENU 10,8,1,"Line Type":MENU 10,9,1,"Custom Pens":MENU 10,10,1,"Hours summary"
ON MENU FN HandleMenu
return
seteditmenu:
MENU 3,0,1,"Edit":MENU 3,1,1,"Insert lne/e":MENU 3,2,1,"Copy/w":MENU 3,3,1,"Adjust":MENU 3,4,1,"Rotate/r":MENU 3,5,1,"Last Line/l":MENU 3,6,1,"Changes/u":MENU 3,7,1,"boot/b"
MENU 3,8,1,"length/n":MENU 3,9,1,"move/m":MENU 3,10,1,"Flip Horizontal"
MENU 3,11,1,"Flip Vertical":MENU 3,12,1,"Clear":MENU 3,13,1,"Delete lne/x":MENU 3,14,1,"Select All/'":MENU 3,15,1,"Copy/c":MENU 3,16,1,"Paste/v":MENU 3,17,1,"Breakout":MENU 3,18,1,"Branch":MENU 3,19,1,"Cfms":MENU 3,20,1,"Equal Select/d"

return
subfractions:
if english=0 then goto MetricSubfractions:
sggn=SGN(xxx)
xxx=ABS(xxx)
frct=xxx-fix(xxx)
in=fix(xxx)

IF frct>0 THEN  GOSUB Dofractions: ELSE den=0


IF ddcode=1 THEN in2=in:ft=0 ELSE ft=fix((in+.005)/12):in2=in-(ft*12)

IF sggn=-1 THEN subfract$="-" ELSE subfract$=""
IF ft>0 THEN  subfract$=subfract$+STR$(ft)+"'-":IF in2=0 THEN subfract$=subfract$+"0''" 
IF in2>0 THEN  subfract$=subfract$+RIGHT$(STR$(in2),LEN(STR$(in2))-1):IF den=0 THEN subfract$=subfract$+"''"
IF den>0 THEN  subfract$=subfract$+STR$(frct)+"/"+RIGHT$(STR$(den),LEN(STR$(den))-1)+"''"
IF MID$(subfract$,1,1)=" " THEN subfract$=RIGHT$(subfract$,LEN(subfract$)-1)
PRINT subfract$
RETURN
Dofractions:
frct=fix((frct*mini)+.5):den=mini
IF frct=mini THEN in=in+1:den=0:RETURN
IF frct=0 THEN den=0:RETURN
Dofractions2:IF frct/2-FIX(frct/2)=0 AND den>1 THEN den=den/2:frct=frct/2:GOTO Dofractions2:
RETURN

toreturnn:
IF (c=48 AND l(lne,0)<>0) THEN GOSUB entry01:
toreturn2:

toreturn:locate 1,5:GOSUB printline:


RETURN
MetricSubfractions:
sggn=SGN(xxx)
xxx=INT(ABS(xxx+.5))

subfract$=STR$(xxx)
ns=LEN(subfract$)
subfract$=RIGHT$(subfract$,ns-1)
IF sggn<0 THEN subfract$="-"+subfract$
PRINT subfract$
RETURN


updatesection:
IF l(lne,7)<6 THEN length1=s(2,l(lne,7)) ELSE length1=l(lne,7)
IF c=42 THEN IF l(lne,16)>0 THEN length=(length1-l(lne,16)) ELSE length=length1
IF c=47 THEN IF l(lne,16)>0 THEN length=l(lne,16) ELSE length=length1
IF c=42 THEN l(lne,6)=l(lne,6)+length:changepos=changepos+length:xxx=changepos:GOSUB subfractions:
IF c=47 THEN l(lne,6)=l(lne,6)-length:changepos=changepos-length:xxx=changepos:GOSUB subfractions:
IF l(lne,6)<0 THEN l(lne,6)=0
GOSUB updateupdate:
RETURN


updateupdate:
keyinupdate=0
alterations=1
IF update=0 AND c<>3 THEN RETURN
cursor 4
olne=lne
osc=sc:sc=psc
IF l(lne,0)=lne-1 AND lne>1 THEN lne=lne-1
GOSUB record::gosub play:

uloop:

IF lne<nl THEN lne=lne+1:IF l(lne,0)>0 THEN GOSUB record::gosub play::GOTO uloop:
sc=osc
lne=olne
cursor 2
GOSUB onlne::GOSUB toreturn:
RETURN
updateupdate2:
olne=lne
osc=sc:sc=psc

for lne=1 to nl
GOSUB record:
next lne
sc=osc
for lne=1 to nl
if sl%(lne)=sl%(0) then gosub play:
next lne

lne=olne
cursor 2
GOSUB onlne::GOSUB toreturn::GOTO displaypv:

RETURN
record:

if hdl&(lne)<>0 then kill picture hdl&(lne):hdl&(lne)=0
picture on (0,0)-(32700,32700)
GOSUB draw:
PICTURE OFF,hdl&(lne)
RETURN
play:
if hdl&(lne)>0 then PICTURE (-fpx,-fpy)-(32700*dsc-fpx,32700*dsc-fpy),hdl&(lne)
return
Varelev:

while mouse(_down)=0
found=0
call getmouse(m(0)):ptx=(m%(1)+fpx)*sc:pty=(m%(0)+fpy)*sc
if l(lne,1)=123 or l(lne,1)=124 then gosub DepthBms:
if l(lne,1)>199 and l(lne,1)<229 then gosub DepthPipe:
if l(lne,1)=1 or l(lne,1)=21 or l(lne,1)=13 or l(lne,1)=33 then gosub DepthTrans:
if found=0 then return
LOCATE 1,3:PRINT "                                                                                                                           "
LOCATE 1,3:PRINT "TE:";
xxx=telev1:GOSUB subfractions:
LOCATE 22,3:PRINT "BE:";
xxx=belev1:GOSUB subfractions:
wend
while mouse(_down)<>0:wend
RETURN
NewDepth:
dx2=l(lne,6):dy2=l(lne,15)
NewDepth2:
GOSUB findangles10:
xpt1#=0:ypt1#=0:xpt2#=0:ypt2#=100
xpt3#=cos(gpi#*(angle+90))*l(lne,5)::ypt3#=sin(gpi#*(angle+90))*l(lne,5)
xpt4#=xpt3#+cos(gpi#*angle)*100::ypt4#=ypt3#+sin(gpi#*angle)*100
gosub elength2:
return

DepthBms:
dx2=ptx-l(lne,20):dy2=pty-l(lne,21)
GOSUB findangles10:
angle=ABS(angle-l(lne,3))
nnn=(COS(gpi*angle)*dpxy)
if nnn<0 then nnn=0
if nnn>l(lne,6) then nnn=l(lne,6)
diff=l(lne,15)*(nnn/l(lne,6))
telev1=l(lne,22)+diff+(l(lne,5)/2)
belev1=telev1-l(lne,16)
found=1
return
DepthPipe:
link=l(lne,0):if link=0 then return
depth=l(lne,22)-l(link,22):if depth=0 then return
dx2=l(lne,20)-l(link,20):dy2=l(lne,21)-l(link,21):gosub findangles10::angle1=angle:length=dpxy
dx2=ptx-l(link,20):dy2=pty-l(link,21)
GOSUB findangles10:
angle=ABS(angle-angle1)
nnn=(COS(gpi*angle)*dpxy)
if nnn<0 then nnn=0
if nnn>length then nnn=length
diff=depth*(nnn/length)
telev1=l(link,22)+diff+(l(lne,16)/2)
belev1=l(link,22)+diff-(l(lne,16)/2)
found=1
return
DepthTrans:
link=l(lne,0):if link=0 then return
lne1=lne
dx2=ptx-l(lne,20):dy2=pty-l(lne,21)
GOSUB findangles10:
angle=ABS(angle-l(lne,3))
dist(1)=(COS(gpi*angle)*dpxy)
if dist(1)<0 then telev1=l(link,22)+l(link,5)/2:belev1=l(link,22)-l(link,5)/2
if dist(1)>l(lne1,17) then telev1=l(lne,22)+l(lne1,5)/2:belev1=l(lne,22)-l(lne1,5)/2
if dist(1)>0 and dist(1)<=l(lne1,17) then gosub J18d1:
print dist(1)/l(lne,17);telev1;belev1
found=1
return'~'

john:

ON john GOTO J1:,J2:,J3:,J4:,J5:,J6:,J7:,J8:,J9:,J10:,J11:,J12:,J13:,J14:,J15:,J16:,J17:,J18:,J19:,J20:,J21:,J22:,J23:,J24:,J25:,J26:,J27:,J28:,J29:,J30:,J31:,J32:,J33:,J34:,J35:,J36:,J37:,J38:,J39:,J40:,J41:,J42:,J43:

J1:
FOR t=1 TO 2
dx2=l(trk(1),20)-l(trk(2),20):dy2=l(trk(1),21)-l(trk(2),21):GOSUB findangles10:
nl=nl+1:sl%(nl)=sl%(0)
l(nl,1)=114:l(nl,3)=angle:l(nl,6)=dpxy
l(nl,20)=(l(trk(2),20)+l(trk(3),20))/2
l(nl,21)=(l(trk(2),21)+l(trk(3),21))/2
dx2=l(trk(2),20)-l(trk(3),20):dy2=l(trk(2),21)-l(trk(3),21)
dpxy=SQR(ABS((dx2^2)+(dy2^2)))
l(nl,7)=INT(dpxy/24)
lne=nl:GOSUB updateupdate:
SWAP trk(1),trk(3)
NEXT t
RETURN
J2:
dx2=l(trk(1),20)-l(trk(2),20):dy2=l(trk(1),21)-l(trk(2),21):GOSUB findangles10:
nl=nl+1:sl%(nl)=sl%(0)
l(nl,1)=123:l(nl,3)=angle:l(nl,6)=dpxy-changepos*2
l(nl,20)=l(trk(2),20)+COS(gpi*angle)*changepos
l(nl,21)=l(trk(2),21)-SIN(gpi*angle)*changepos
l(nl,4)=6
lne=nl:GOSUB updateupdate:
RETURN
J3:
IF changepos<2 THEN RETURN
dx2=l(trk(1),20)-l(trk(2),20):dy2=l(trk(1),21)-l(trk(2),21):GOSUB findangles10:
FOR t=1 TO changepos-1
nl=nl+1:sl%(nl)=sl%(0)
dist=dpxy/changepos
FOR tt=1 TO 19:l(nl,tt)=l(trk(2),tt):NEXT tt:lst$(nl)=lst$(trk(2))
l(nl,20)=l(trk(2),20)+COS(gpi*angle)*(dist*t)
l(nl,21)=l(trk(2),21)-SIN(gpi*angle)*(dist*t)
lne=nl:GOSUB updateupdate:
NEXT t
RETURN
J4:

GOSUB sncsn:
xpt1=l(lne,20):ypt1=l(lne,21)
xpt2=xpt1+cs1*l(lne,6):ypt2=ypt1+sn1*l(lne,6)
nl2=nl
FOR ll=1 TO nl2
IF sl%(ll)=sl%(0) AND ll<>lne AND l(ll,2)=0 THEN GOSUB J4a:
NEXT ll
if l(lne,1)>122 and l(lne,1)<127 then gosub J4d:

RETURN

J4a:
xpt4=l(ll,20):ypt4=l(ll,21):xpt3=xpt4+COS(gpi*l(ll,3))*l(ll,6):ypt3=ypt4-SIN(gpi*l(ll,3))*l(ll,6):dist2=l(ll,6):angle2=l(ll,3)
IF l(ll,1)=107 AND l(ll,0)>0 THEN xpt4=l(l(ll,0),20):ypt4=l(l(ll,0),21):xpt3=l(ll,20):ypt3=l(ll,21):dx2=xpt3-xpt4:dy2=ypt3-ypt4:GOSUB findangles10::dist2=dpxy:angle2=angle
IF l(ll,1)=128 OR l(ll,1)=103 OR l(ll,1)=104 OR l(ll,1)=109 THEN GOSUB J4b:
GOSUB elength2:
IF del=0 THEN RETURN
dx2=xpt3-l(lne,20):dy2=ypt3-l(lne,21):dpxy=SQR(ABS((dx2^2)+(dy2^2)))
xpt5=l(lne,20)+cs1*dpxy:ypt5=l(lne,21)+sn1*dpxy:dist1=dpxy
IF ABS(xpt3-xpt5)>1 OR ABS(ypt3-ypt5)>1 OR dpxy>l(lne,6) THEN RETURN
dx2=xpt3-xpt4:dy2=ypt3-ypt4:dpxy=SQR(ABS((dx2^2)+(dy2^2)))
xpt5=xpt4+COS(gpi*angle2)*dpxy:ypt5=ypt4-SIN(gpi*angle2)*dpxy
IF ABS(xpt3-xpt5)>1 OR ABS(ypt3-ypt5)>1 OR dpxy>dist2 THEN RETURN
CIRCLE xpt3/sc-fpx,ypt3/sc-fpy,4
nl=nl+1:GOSUB clearline::FOR i=1 TO 22:l(nl,i)=l(ll,i):NEXT i:lst$(nl)=lst$(ll)
l(nl,20)=posx(posv)+dist1:l(nl,21)=posy(posv)-l(ll,22)
IF l(nl,1)<100 THEN l(nl,1)=20:l(nl,2)=2:l(nl,3)=0:SWAP l(nl,4),l(nl,5)
IF l(nl,1)<20 THEN l(nl,1)=0

IF l(nl,1)=123 THEN l(nl,2)=1:l(nl,3)=90:if l(nl,15)<>0 then gosub J4c:
IF l(nl,1)=124 THEN l(nl,2)=1:l(nl,3)=90:if l(nl,15)<>0 then gosub J4c:
IF l(nl,1)=125 THEN l(nl,2)=1:l(nl,3)=90:if l(nl,15)<>0 then gosub J4c:
IF l(nl,1)=126 THEN l(nl,2)=1:l(nl,3)=90:if l(nl,15)<>0 then gosub J4c:
IF l(nl,1)=114 THEN l(nl,6)=1.5:l(nl,3)=90

IF l(nl,1)=111 THEN l(nl,3)=270:l(nl,2)=0:l(nl,21)=posy(posv)-l(lne,22)-24:l(nl,6)=l(lne,22)+24
IF l(nl,1)=107 THEN l(nl,1)=113:l(nl,3)=90:l(nl,21)=posy(posv):l(nl,6)=l(ll,22)
IF l(nl,1)=113 THEN l(nl,1)=113:l(nl,3)=90:l(nl,21)=posy(posv):l(nl,6)=l(ll,22)
IF l(nl,1)=128 OR l(nl,1)=103 OR l(nl,1)=104 THEN l(nl,21)=posy(posv)-l(lne,22):l(nl,1)=0:l(nl,3)=90:l(nl,6)=6
IF l(nl,1)=109 THEN l(nl,21)=posy(posv):l(nl,1)=0:l(nl,3)=90:l(nl,6)=l(lne,6)
RETURN
J4b:
xpt4=l(ll,20)+cs2*l(ll,4)/2:ypt4=l(ll,21)+sn2*l(ll,4)/2
xpt3=l(ll,20)-cs2*l(ll,4)/2:ypt3=l(ll,21)-sn2*l(ll,4)/2
dx2=xpt3-xpt4:dy2=ypt3-ypt4:GOSUB findangles10::dist2=dpxy:angle2=angle


return
J4c:
nl=nl+1:GOSUB clearline::FOR i=0 TO 22:l(nl,i)=l(nl-1,i):NEXT i:lst$(nl)=lst$(nl-1)
l(nl,21)=l(nl,21)+l(nl,15)
return
J4d:
nl=nl+1:GOSUB clearline::FOR i=1 TO 19:l(nl,i)=l(lne,i):NEXT i:lst$(nl)=lst$(lne)
l(nl,3)=0::SWAP l(nl,4),l(nl,5)
l(nl,20)=posx(posv):l(nl,21)=posy(posv)-l(lne,22)-(l(lne,5)/2)
if l(nl,1)=124 then l(nl,1)=121 else l(nl,1)=122
if l(lne,15)<>0 then dx2=l(lne,6):dy2=-l(lne,15):gosub findangles10::l(nl,3)=angle:l(nl,6)=dpxy:l(nl,10)=angle

return


J5:
INPUT "code";cde
changeangle=0
olne=lne
zero=0
IF cde>1999 THEN cde=cde-2000:zero=2
IF cde>999 THEN cde=cde-1000:zero=1
IF cde>499 THEN changeangle=5:cde=cde-500
IF cde>399 THEN changeangle=4:cde=cde-400
IF cde>299 THEN changeangle=3:cde=cde-300
IF cde>199 THEN changeangle=2:cde=cde-200
IF cde>99 THEN changeangle=1:cde=cde-100
dct=INT(cde/20):code=cde-(dct*20)
nl=nl+1:GOSUB clearline::sl%(nl)=sl%(0)
l(nl,1)=cde:l(nl,0)=lne:l(nl,3)=l(lne,3):l(nl,4)=l(lne,4):l(nl,7)=l(lne,7):l(nl,5)=l(lne,5):l(nl,6)=36:IF l(nl,4)=0 THEN l(nl,4)=20:l(nl,5)=10
IF cde=29 THEN  l(nl,1)=26:dct=1:code=6:l(nl,8)=3:l(nl,6)=6:l(nl,4)=8:l(nl,5)=8
IF code=9 THEN l(nl,6)=0
IF changeangle<4 THEN l(nl,3)=(90*changeangle)
IF changeangle=4 THEN l(nl,2)=2:l(nl,3)=l(lne,3)
IF changeangle=5 THEN l(nl,2)=-2:l(nl,3)=l(lne,3)
IF code>5 AND code<9 THEN l(nl,4)=l(nl,4)/2:l(nl,13)=l(lne,6)
IF zero=1 THEN l(nl,6)=0:l(nl,0)=0:l(nl,20)=posx(posv):l(nl,21)=posy(posv)
IF zero=2 THEN GOSUB J5b:

lne=olne
GOSUB updateupdate:
IF l(nl,1)=26 AND l(nl,8)=3 THEN lne=olne ELSE lne=nl
RETURN
J5a:
nl=nl+1:GOSUB clearline::sl%(nl)=sl%(0)
l(nl,1)=cde:l(nl,0)=lne:l(nl,4)=l(lne,4):l(nl,5)=l(lne,5):l(nl,7)=l(lne,7):l(nl,6)=36
IF changeangle<0 THEN l(nl,2)=1:l(nl,3)=l(lne,3) ELSE l(nl,2)=0:l(nl,3)=l(lne,3)+changeangle
IF zero=1 OR zero=3 THEN l(nl,0)=0:l(nl,20)=posx(posv):l(nl,21)=posy(posv):l(nl,0)=0:l(nl,4)=20:l(nl,5)=10:l(nl,3)=changeangle
IF zero=2 THEN l(nl,6)=0:l(nl,4)=l(nl,4)/2
IF zero=3 THEN l(nl,6)=0
lne=nl
RETURN
J5b:
l(nl,4)=l(nl,4)/2
nl=nl+1:FOR t=1 TO 22:l(nl,t)=l(nl-1,t):NEXT t
l(nl,0)=nl-1
l(nl-1,14)=(l(lne,4)/2)-(l(nl-1,4)/2)
IF changeangle=3 THEN l(nl-1,14)=l(nl-1,14)*-1
l(nl-1,3)=l(lne,3)
l(nl-1,6)=0
l(nl-1,1)=0
sl%(nl)=sl%(0)
RETURN

J6:
locate 5,1
INPUT "=<min";min
INPUT "LengthMin";LengthMin
INPUT "LengthMax";LengthMax
FOR ll=1 TO nl
IF sl%(0)=sl%(ll) THEN GOSUB J6a:
NEXT ll
RETURN
J6a:
stdlength=(l(ll,4)+l(ll,5))*2
IF stdlength=<min THEN l(ll,7)=LengthMin ELSE l(ll,7)=LengthMax
IF l(ll,1)>19 AND l(ll,1)<99 THEN l(ll,7)=2
return
J7:
olne2=lne
lstatus=2:GOSUB getint:
FOR i=1 TO prf(1,0)
IF prf(1,i)>=0 THEN l(lne,prf(1,i))=l(olne2,prf(1,i))
IF prf(1,i)=22 THEN l(lne,prf(1,i))=l(olne2,prf(1,i))+(l(olne2,5)/2)-(l(lne,5)/2)
IF prf(1,i)=-1 THEN lst$(lne)=lst$(olne2)
IF prf(1,i)=-2 THEN lt$(lne)=lt$(olne2)
NEXT i
GOSUB updateupdate:

RETURN
J8:

FOR ll=1 TO nl
IF sl%(0)=sl%(ll) THEN GOSUB J8a:
NEXT ll
RETURN
J8a:
llst2$=lt$(ll)
gosub Makecaps:
lst$(ll)=llst$
RETURN
Makecaps:
ns=LEN(llst2$)
llst$=""
FOR i=1 TO ns
m$=MID$(llst2$,i,1)
mm=ASC(m$)
IF mm>96 AND mm<123 THEN mm=mm-32:m$=CHR$(mm)
llst$=llst$+m$
NEXT i

return
J9:
lne1=trk(2):lne2=trk(1)
if l(lne2,1)<>128 then return
l(lne1,4)=l(lne2,13):l(lne1,5)=l(lne2,13):l(lne1,9)=0
lne=lne1
GOSUB updateupdate:

return
dx=l(lne1,20)-l(lne2,20):dy=l(lne1,21)-l(lne2,21):dpxy=SQR(ABS((dx^2)+(dy^2)))
IF l(lne1,1)=21 THEN l(lne1,8)=12:l(lne1,6)=12::l(lne1,4)=l(lne2,13):l(lne1,5)=l(lne2,13):l(lne1,9)=0
IF l(lne1,1)=6 OR l(lne1,1)=26 THEN l(lne1,1)=26:l(lne1,8)=3:l(lne1,6)=6::l(lne1,4)=l(lne2,13):l(lne1,5)=l(lne2,13):l(lne1,9)=0
lne=lne1
GOSUB updateupdate:
RETURN

J10:
nl=nl+1:sl%(nl)=sl%(0)

FOR t=0 TO 22:l(nl,t)=0:NEXT t
l(nl,20)=l(trk(2),20)+COS(gpi*l(trk(2),3))*l(trk(2),6)
l(nl,21)=l(trk(2),21)-SIN(gpi*l(trk(2),3))*l(trk(2),6)
ptx=l(trk(1),20)+COS(gpi*l(trk(1),3))*l(trk(1),6)
pty=l(trk(1),21)-SIN(gpi*l(trk(1),3))*l(trk(1),6)
IF l(trk(1),6)=0 THEN l(nl,7)=2
l(nl,2)=l(trk(2),3)
l(nl,3)=l(trk(2),3)
l(nl,4)=l(trk(2),4)
l(nl,5)=l(trk(2),5)
l(nl,1)=120
l(nl,6)=one
l(nl,13)=ptx-l(nl,20):l(nl,14)=pty-l(nl,21)
dx2=l(trk(1),20)-l(nl,20):dy2=l(trk(1),21)-l(nl,21):gosub findangles10::l(nl,2)=int(angle)
lne=nl:GOSUB updateupdate:
RETURN
J11:
GOSUB J9:
GOSUB J10:

RETURN
J12:
if l(lne,1)=110 or l(lne,1)=119 then goto J19:

olne2=lne
IF sl%(0)=0 THEN GOSUB J12a::goto updateupdate:
FOR lne=1 TO nl
IF sl%(lne)=sl%(0) AND sl%(0)>0 THEN GOSUB J12a:

NEXT lne
lne=olne2
GOSUB updateupdate:
RETURN
J12a:
gosub Getcode:
if code>1 and code<6 then l(l(lne,0),6)=l(l(lne,0),6)-1
IF (l(lne,1)=26 AND l(lne,8)=3) OR l(lne,1)=9 OR l(lne,1)=120 THEN RETURN
IF l(lne,9)=2 THEN l(lne,4)=l(lne,4)-changepos(8):l(lne,5)=l(lne,5)-changepos(8):l(lne,9)=0 ELSE l(lne,4)=l(lne,4)+changepos(8):l(lne,5)=l(lne,5)+changepos(8):l(lne,9)=2

RETURN
J13:
if sl%(0)=0 then gosub J13a::return
for ll=1 to nl
if sl%(ll)=sl%(0) and l(ll,1)=1 or l(ll,1)=21 then gosub J13a::l(ll,8)=tlength
next ll
return
 J13a:
diff1=ABS(l(ll,4)-l(l(ll,0),4))
diff2=ABS(l(ll,5)-l(l(ll,0),5))
IF diff1>diff2 THEN diff=diff1 ELSE diff=diff2
tlength=INT(.866025403#*(diff/.5))+1
IF (tlength/2)-INT(tlength/2)>0 THEN tlength=tlength+1
if sl%(0)=0 then locate 1,5:print tlength
IF tlength<12 THEN tlength=12

RETURN
J14:
offset=0
olne2=lne
lstatus=2:GOSUB getint:
IF lstolne=olne2 THEN incr=incr+1 ELSE incr=1
offset=SGN(l(lne,14))
nl=nl+1:sl%(nl)=sl%(0):FOR ii=1 TO 19:l(nl,ii)=l(lne,ii):NEXT ii:lst$(nl)=lst$(lne):l(nl,0)=olne2
'IF l(lne,0)=0 THEN l(nl,0)=0
IF l(nl,6)>120 THEN l(nl,6)=120
IF l(lne,0)>0 THEN l(nl,3)=l(olne2,3)+(l(lne,3)-l(l(lne,0),3)) ELSE l(nl,3)=0
lne=nl
GOSUB Getcode:
IF dct2<>dct THEN l(lne,1)=dct2*20+code
IF l(lne,0)>0 THEN IF code<6 OR code>8 THEN l(lne,4)=l(l(lne,0),4):l(lne,5)=l(l(lne,0),5) ELSE l(nl,13)=l(l(nl,0),17)+(incr*14):lne=olne2
'IF l(lne,0)=0 THEN l(lne,20)=posx(posv):l(lne,21)=posy(posv)
IF code=1 THEN l(lne,4)=l(l(lne,0),4)-2:l(lne,14)=ABS((l(lne,4)-l(l(lne,0),4))/2)*offset
GOSUB updateupdate:
lstolne=olne2
RETURN
J15:
if l(lne,1)=110 or l(lne,1)=119 then goto J19:

nl=nl+1:GOSUB clearline:
l(nl,1)=12:l(nl,3)=l(lne,3):l(nl,4)=l(lne,4):l(nl,5)=l(lne,5):l(nl,6)=.0001:l(nl,8)=.0001
'call getmouse(m(0)):xpt1=m%(1)/sc-fpx:ypt1=m%(0)/sc+fpy
call getmouse (m%(0)):xpt1=(m%(1)+fpx)*sc:ypt1=(m%(0)+fpy)*sc
dx2=xpt1-l(lne,20):dy2=ypt1-l(lne,21):GOSUB findangles10:

l(nl,20)=l(lne,20)+COS(gpi*l(lne,3))*(dpxy)
l(nl,21)=l(lne,21)-SIN(gpi*l(lne,3))*(dpxy)
lne=nl:GOSUB updateupdate:
return
J16:
nl2=nl
cnt=1
FOR nl=1 TO nl2
IF sl%(nl)=sl%(0) THEN IF nl<>lne AND lst$(nl)=lst$(lne) THEN cnt=cnt+1:GOSUB clearline:
NEXT nl
IF cnt>1 THEN lst$(lne)=lst$(lne)+"\TYP OF "+STR$(cnt)
nl=nl2
RETURN
J17:
xpt(1)=l(lne,20):ypt(1)=l(lne,21)
xpt(2)=l(lne,20)+cos(gpi#*l(lne,3))*l(lne,6):ypt(2)=l(lne,21)-sin(gpi#*l(lne,3))*l(lne,6)
found=0
for lne2=1 to nl
if l(lne2,1)<99 and lne<>lne2 and l(lne,4)=l(lne2,4) and l(lne,5)=l(lne2,5) and l(lne,7)<>l(lne2,7) then gosub J17a::if found>0 then lne=lne2:gosub updateupdate::return
next lne2
return
J17a:

xpt(3)=l(lne2,20):ypt(3)=l(lne2,21)
xpt(4)=l(lne2,20)+cos(gpi#*l(lne2,3))*l(lne2,6):ypt(4)=l(lne2,21)-sin(gpi#*l(lne2,3))*l(lne2,6)

if abs(xpt(1)-xpt(3))<1 and abs(ypt(1)-ypt(3))<1 then found=1:l(lne2,22)=l(lne,22)
if abs(xpt(1)-xpt(4))<1 and abs(ypt(1)-ypt(4))<1 then found=2
if abs(xpt(2)-xpt(3))<1 and abs(ypt(2)-ypt(3))<1 then found=3:l(lne2,22)=l(lne,22)
if abs(xpt(2)-xpt(4))<1 and abs(ypt(2)-ypt(4))<1 then found=4:diff=l(lne,22)-l(lne2,22):olne2=lne2:gosub J17b:
print lne2;found
RETURN
J17b:
if l(lne2,7)=4 and l(lne2,0)>0 then lne2=l(lne2,0):goto J17b:
if l(lne2,7)<>4 then return
l(lne2,22)=l(lne2,22)+diff


return
J18:
olne=lne
lne1=lne
if sl%(0)=0 then goto nxtJ18:
for lne1=1 to nl
if inkey$="q" then return
if sl%(lne1)=sl%(0) then gosub nxtJ18:
next lne1
nxtJ18:
angle1=l(lne1,3)
for t=23 to 26:l(lne1,t)=9999:next t
for t=27 to 29:l(lne1,t)=0:next t
if l(lne1,22)=0 then return
gosub J18a:
lne=olne
return
J18a:
lne3=lne1:bpt=0:i0=1:angle1=l(lne1,3):angle=angle1:gosub sncsn2:
gosub J18b::bpt1=1:ept1=bpt
if ept1=0 then return
for lne2=1 to nl
if lne2<>lne1 and l(lne2,22)>0 then lne3=lne2:bpt=ept1:i0=2:angle2=l(lne2,3):angle=angle2:gosub sncsn2::gosub J18b:

next lne2

return
J18b:
if l(lne3,1)<100 then lne=lne3:gosub Getcode:
if lne3=lne2 then if l(lne1,0)>0 then if l(lne1,0)=lne2 then return
if lne3=lne2 then if l(lne2,0)>0 then if l(lne2,0)=lne1 then return
if lne3=lne2 and l(lne3,1)>199 and l(lne3,1)<229 then if l(lne1,0)>0 and l(lne1,0)=l(lne2,0) then return
w(i0)=l(lne3,4)/2:d(i0)=l(lne3,5)/2
hx(i0)=l(lne3,20):hy(i0)=l(lne3,21):hz(i0)=l(lne3,22):length(i0)=l(lne3,6):updn(i0)=0
if l(lne3,1)=123 or l(lne3,1)=124 then hz(i0)=hz(i0)+(l(lne3,5)/2)-(l(lne3,16)/2):d(i0)=l(lne3,16)/2
if l(lne3,1)>199 then if l(lne3,0)>0 then gosub J18200: else return
if l(lne3,1)<100 and l(lne3,2)=0 then gosub J18duct:
if l(lne3,1)<100 and l(lne3,2)<>0 then gosub J18updnduct:
if l(lne3,1)=123 then updn(i0)=l(lne3,15):gosub J18run:
if l(lne3,1)=124 then updn(i0)=l(lne3,15):gosub J18run:
if l(lne3,1)=101 or l(lne3,1)=102 and l(lne3,2)=0 then gosub J18run:
'if l(lne3,1)=113 then gosub J18113:
if l(lne3,1)=109 then gosub J18square:
if l(lne3,1)=104 then swap w(i0),d(i0):gosub J18square:
if l(lne3,1)=103 then gosub J18square:
if l(lne3,1)=114 then gosub J18114:
if l(lne3,1)=128 then swap w(i0),d(i0):if l(lne3,7)<>7 or l(lne3,7)<>8 then gosub J18square: else gosub J18run:
return

J18113:

xpt(bpt+1)=hx(i0):ypt(bpt+1)=hy(i0)
xpt(bpt+2)=hx(i0)+cs1*length(i0):ypt(bpt+2)=hy(i0)+sn1*length(i0)
bpt=bpt+2
if lne3=lne2 then bpt2=ept1+1::ept2=bpt:gosub J18c:

return
J18200:
if l(lne3,0)=0 then return
d(i0)=l(lne3,16)/2
hx(i0)=l(l(lne3,0),20):hy(i0)=l(l(lne3,0),21):hz(i0)=l(l(lne3,0),22)
dx2=l(lne3,20)-l(l(lne3,0),20):dy2=l(lne3,21)-l(l(lne3,0),21):gosub findangles10::gosub sncsn2::length(i0)=dpxy
updn(i0)=l(lne3,22)-l(l(lne3,0),22)
if i0=1 then angle1=angle else angle2=angle
gosub J18run:

return

J18run:
xpt(bpt+1)=hx(i0):ypt(bpt+1)=hy(i0)
xpt(bpt+2)=hx(i0)+cs1*length(i0):ypt(bpt+2)=hy(i0)+sn1*length(i0)
xpt(bpt+3)=xpt(bpt+1)+cs2*w(i0):ypt(bpt+3)=ypt(bpt+1)+sn2*w(i0)
xpt(bpt+4)=xpt(bpt+2)+cs2*w(i0):ypt(bpt+4)=ypt(bpt+2)+sn2*w(i0)
xpt(bpt+5)=xpt(bpt+1)-cs2*w(i0):ypt(bpt+5)=ypt(bpt+1)-sn2*w(i0)
xpt(bpt+6)=xpt(bpt+2)-cs2*w(i0):ypt(bpt+6)=ypt(bpt+2)-sn2*w(i0)
xpt(bpt+7)=xpt(bpt+3):ypt(bpt+7)=ypt(bpt+3)
xpt(bpt+8)=xpt(bpt+5):ypt(bpt+8)=ypt(bpt+5)
xpt(bpt+9)=xpt(bpt+4):ypt(bpt+9)=ypt(bpt+4)
xpt(bpt+10)=xpt(bpt+6):ypt(bpt+10)=ypt(bpt+6)
bpt=bpt+10
if lne3=lne2 then bpt2=ept1+1::ept2=bpt:gosub J18c:
return
J18duct:
if l(lne3,6)<1 then return
gosub J18run:

return
J18square:

hx(i0)=hx(i0)-cs1*d(i0):hy(i0)=hy(i0)-sn1*d(i0):length(i0)=d(i0)*2
d(i0)=l(lne3,6)/2:hz(i0)=l(lne3,22)+d(i0)
if lst$(lne3)="col" or l(lne3,1)=109 then d(i0)=l(lne3,22):hz(i0)=0
gosub J18run:
return
J18updnduct:

hx(i0)=hx(i0)-cs1*d(i0):hy(i0)=hy(i0)-sn1*d(i0):length(i0)=d(i0)*2
d(i0)=l(lne3,6)/2:hz(i0)=l(lne3,22)+d(i0)*sgn(l(lne3,2))
if l(lne3,22)=l(l(lne3,0),22) then d(i0)=d(i0)+l(l(lne3,0),5)/4:hz(i0)=hz(i0)-(l(l(lne3,0),5)/4)*sgn(l(lne3,2))
gosub J18run:

return

J18114:
l(lne3,6)=ABS(l(lne3,6))
nlnes=l(lne3,7)
xpt(bpt+1)=hx(i0)+cs2*((nlnes-1)/2)*l(lne3,4)
ypt(bpt+1)=hy(i0)+sn2*((nlnes-1)/2)*l(lne3,4)
xpt(bpt+2)=xpt(bpt+1)+cs1*l(lne3,6)
ypt(bpt+2)=ypt(bpt+1)+sn1*l(lne3,6)
FOR t=1 TO nlnes-1
xpt(bpt+3)=xpt(bpt+1)-cs2*l(lne3,4):ypt(bpt+3)=ypt(bpt+1)-sn2*l(lne3,4)
xpt(bpt+4)=xpt(bpt+2)-cs2*l(lne3,4):ypt(bpt+4)=ypt(bpt+2)-sn2*l(lne3,4)
bpt=bpt+2
NEXT t
if nlnes>1 then bpt=bpt+2
hz(i0)=l(lne3,22)+.75
d(i0)=.75
if lne3=lne2 then bpt2=ept1+1::ept2=bpt:gosub J18c:

RETURN
J18c:
if w(1)<length(1) and w(2)<length(2) then dx2=hx(1)-hx(2):dy2=hy(1)-hy(2):dpxy=sqr(abs(dx2^2+dy2^2)):if dpxy>length(2)+length(1) then return
cnt=0
updn(3)=0
for ll1=bpt1 to ept1 step 2
xpt1#=xpt(ll1):ypt1#=ypt(ll1)
xpt2#=xpt(ll1+1):ypt2#=ypt(ll1+1)

for ll2=bpt2 to ept2 step 2
xpt3#=xpt(ll2):ypt3#=ypt(ll2)
xpt4#=xpt(ll2+1):ypt4#=ypt(ll2+1)
gosub J18elength::
if found=1 then cnt=cnt+1:gosub J18d::if updn(3)=0 then return
next ll2
next ll1
if cnt=0 then gosub J18e:

return
J18d:
if hz(2)=0 then l(lne1,26)=-l(lne2,22):l(lne1,24)=-l(lne2,22):l(lne1,29)=l(lne1,29)+1:return
if updn(1)=0 then elev1=hz(1):telev1=elev1+d(1):belev1=elev1-d(1):lne=lne1:gosub Getcode::if code=1 or code=13 or code=9 then updn(3)=1:gosub J18d1:
if updn(2)=0 then elev2=hz(2):telev2=elev2+d(2):belev2=elev2-d(2):lne=lne2:gosub Getcode::if code=1 or code=13 or code=9 then updn(3)=1:gosub J18d2:
if updn(1)<>0 then elev1=hz(1)+((dist(1)/length(1))*updn(1)):telev1=elev1+d(1):belev1=elev1-d(1):updn(3)=1
if updn(2)<>0 then elev2=hz(2)+((dist(2)/length(2))*updn(2)):telev2=elev2+d(2):belev2=elev2-d(2):updn(3)=1
hilow=elev2-elev1
if hilow>0 then difelev=belev2-telev1:if difelev<l(lne1,24) then l(lne1,24)=difelev:l(lne1,23)=belev2:l(lne1,27)=lne2:if l(lne1,24)<0 then l(lne1,29)=l(lne1,29)+1:circle hx(2)/sc-fpx,hy(2)/sc-fpy,4
if hilow<=0 then difelev=belev1-telev2:if difelev<l(lne1,26) then l(lne1,26)=difelev:l(lne1,25)=telev2:l(lne1,28)=lne2:if l(lne1,26)<0 then l(lne1,29)=l(lne1,29)+1:circle hx(2)/sc-fpx,hy(2)/sc-fpy,6
return
J18d1:
if code=9 then goto J18d19:
link=l(lne1,0):if link=0 then return
if dist(1)>l(lne1,17) then return
xpt5=0:ypt5=l(link,22)+l(link,5)/2
xpt6=l(lne1,17):ypt6=l(lne1,22)+l(lne1,5)/2
telev1=ypt5+((dist(1)/l(lne1,17))*(ypt6-ypt5))
xpt5=0:ypt5=l(link,22)-l(link,5)/2
xpt6=l(lne1,17):ypt6=l(lne1,22)-l(lne1,5)/2
belev1=ypt5+((dist(1)/l(lne1,17))*(ypt6-ypt5))
elev1=(telev1+belev1)/2
return
J18d19:
if dist(1)>l(lne1,17) then return
telev1=telev1+4:belev1=belev1-1.5
elev1=(telev1+belev1)/2
return

J18d2:
if code=9 then goto J18d29:
link=l(lne2,0):if link=0 then return
if dist(2)>l(lne2,17) then return
xpt5=0:ypt5=l(link,22)+l(link,5)/2
xpt6=l(lne2,17):ypt6=l(lne2,22)+l(lne2,5)/2
telev2=ypt5+((dist(2)/l(lne2,17))*(ypt6-ypt5))
xpt5=0:ypt5=l(link,22)-l(link,5)/2
xpt6=l(lne2,17):ypt6=l(lne2,22)-l(lne2,5)/2
belev2=ypt5+((dist(2)/l(lne2,17))*(ypt6-ypt5))
elev2=(telev2+belev2)/2

return
J18d29:
if dist(2)>l(lne2,17) then return
telev2=telev2+4:belev2=belev2-1.5
elev2=(telev2+belev2)/2
return

J18elength:
found=0
del#=(xpt1#-xpt2#)*(ypt4#-ypt3#)-(ypt1#-ypt2#)*(xpt4#-xpt3#):IF del#=0 THEN RETURN
rmu#=((ypt4#-ypt3#)*(xpt4#-xpt2#)-(xpt4#-xpt3#)*(ypt4#-ypt2#))/del#
if rmu#=<0 or rmu#>=1 then return
x#=rmu#*xpt1#+(1-rmu#)*xpt2#
y#=rmu#*ypt1#+(1-rmu#)*ypt2#

del#=(xpt3#-xpt4#)*(ypt2#-ypt1#)-(ypt3#-ypt4#)*(xpt2#-xpt1#):IF del#=0 THEN RETURN
rmu#=((ypt2#-ypt1#)*(xpt2#-xpt4#)-(xpt2#-xpt1#)*(ypt2#-ypt4#))/del#
if rmu#=<0 or rmu#>=1 then return
found=1
dx2=x#-hx(2):dy2=y#-hy(2):GOSUB findangles10:
angle=abs(angle-angle2)
dist(2)=(COS(gpi*angle)*dpxy)
J18elength2:

dx2=x#-hx(1):dy2=y#-hy(1):GOSUB findangles10:
angle=abs(angle-angle1)
dist(1)=(COS(gpi*angle)*dpxy)
circle x#/sc-fpx,y#/sc-fpy,4

RETURN
J18e:
cnt=0
for ll1=bpt1 to ept1
xpt1#=xpt(ll1):ypt1#=ypt(ll1)
dx2=xpt1#-hx(2):dy2=ypt1#-hy(2):GOSUB findangles10:
angle=abs(angle-angle2)
dist(2)=COS(gpi*angle)*dpxy
dy=abs(sin(gpi*angle)*dpxy)
if dy<w(2) and dist(2)>0 and dist(2)<length(2) then x#=xpt1#:y#=ypt1#:gosub J18elength2::gosub J18d:
next ll1
return
J19:
dimfunction=1:goto Changedim:
return
IF l(lne,1)<>110 THEN RETURN
call getmouse(m(0)):xpt3=m%(1):ypt1=m%(0)
WHILE MOUSE(_down)<>0
WEND
call getmouse(m(0)):xpt1=(m%(1)+fpx)*sc:ypt1=(m%(0)+fpy)*sc
if xpt3=m%(1) and ypt3=m%(0) then l(lne,20)=xpt1:l(lne,21)=ypt1:goto updateupdate:
return

dx2=xpt1-l(lne,20):dy2=ypt1-l(lne,21):GOSUB findangles10::angle=INT((angle/45)+.5)*45
l(lne,20)=l(lne,20)+COS(gpi*angle)*dpxy
l(lne,21)=l(lne,21)-SIN(gpi*angle)*dpxy
IF l(lne,6)=0 THEN l(lne,20)=xpt1:l(lne,21)=ypt1 ELSE goto updateupdate:
WHILE MOUSE(0)=0:WEND
WHILE MOUSE(0)<>0:WEND
call getmouse(m(0)):xpt2=(m%(1)+fpx)*sc:ypt2=(m%(0)+fpy)*sc
dx2=xpt2-xpt1:dy2=ypt2-ypt1
IF ABS(dx2)<1 AND ABS(dy2)<1 THEN goto updateupdate:
l(lne,13)=xpt2:l(lne,8)=ypt2
l(lne,13)=l(lne,13)-l(lne,20):l(lne,8)=l(lne,21)-l(lne,8)
GOSUB updateupdate:
RETURN


J20:
GOSUB inkey::IF nnn>0 THEN el1=nnn
xxx=el1:GOSUB subfractions:
GOSUB inkey::IF nnn>0 THEN el2=nnn
xxx=el2:GOSUB subfractions:
l(lne,15)=el2-el1
l(lne,22)=el1-(l(lne,5)/2)
GOSUB updateupdate:
RETURN
J21:
lne2=trk(1):lne1=trk(2)
if l(lne2,1)=128 then goto J21a:
l(lne1,20)=l(lne2,20)+cos(gpi*l(lne2,3))*l(lne2,6)
l(lne1,21)=l(lne2,21)-sin(gpi*l(lne2,3))*l(lne2,6)
lne=lne1:gosub updateupdate:
return
J21a:
l(lne1,13)=l(lne2,20)-l(lne1,20)
l(lne1,14)=l(lne2,21)-l(lne1,21)
lne=lne1:gosub updateupdate:

return
J21b:
l(lne1,20)=l(lne2,20)+cos(gpi*l(lne2,3))*l(lne1,6)
l(lne1,21)=l(lne2,21)=sin(gpi*l(lne2,3))*l(lne1,6)

return

l(nl,13)=ptx-l(nl,20):l(nl,14)=pty-l(nl,21)
J22:

xpt3=posx(posv):ypt3=posy(posv)
xpt4=xpt3+COS(gpi*l(lne,3))*20
ypt4=ypt3-SIN(gpi*l(lne,3))*20
xpt1=l(lne,20)
ypt1=l(lne,21)
angle1=l(lne,3)+90
xpt2=xpt1+COS(gpi*angle1)*20
ypt2=ypt1-SIN(gpi*angle1)*20
GOSUB elength2:
dx2=xpt3-xpt1:dy2=ypt3-ypt1:GOSUB findangles10::dist2=dpxy:angle2=angle:wth=l(lne,4)/2:hx=l(lne,20):hy=l(lne,21):col2=l(lne,2)
'GOTO nxtRtnD4c:
RETURN
J23:
IF l(lne,1)<>110 THEN RETURN
oldnl=nl:nl=lne
reversed=l(nl,12)
GOSUB RtnD4a:
nl=oldnl
GOSUB updateupdate:
RETURN
J24:
INPUT "col";col
IF col>30 THEN GOTO Rtnin2:
IF col=1 THEN GOTO Rtnin3:
ll=lne-1
inputlengths2:
IF col=4 THEN ll=ll+1:INPUT w:IF w<>0 THEN INPUT d:l(ll,4)=w:l(ll,5)=d:GOTO inputlengths2: ELSE RETURN
GOSUB inkey:
IF nnn<>0 THEN ll=ll+1:l(ll,col)=nnn:GOTO inputlengths2:
GOSUB updateupdate:

RETURN
Rtnin3:
olne=lne
INPUT "dct";dct3
ll=lne:dct3=dct3*20
FOR lne=ll TO nl
IF lne>ll AND l(lne,0)=0 THEN lne=olne:RETURN
GOSUB Getcode:
l(lne,1)=dct3+code
NEXT lne
lne=olne
RETURN


Rtnin2:
IF col=31 THEN dx=1:dy=-1
IF col=32 THEN dx=1:dy=1
IF col=33 THEN dx=-1:dy=1
IF col=34 THEN dx=-1:dy=-1
GOSUB inkey:
IF nnn=0 THEN RETURN
x1=nnn
GOSUB inkey:
IF nnn=0 THEN RETURN
y1=nnn
npv=npv+1:IF npv>199 THEN npv=0
posx(npv)=posx(posv)+(x1*dx)
posy(npv)=posy(posv)+(y1*dy)
GOTO Rtnin2:
RETURN
J25:
nl2=nl
FOR ll=1 TO nl2
IF sl%(ll)=sl%(0) THEN GOSUB J25a:
NEXT ll

RETURN

J25a:
PRINT ll
length=l(ll,6)-l(ll,17)
IF length<12 OR l(ll,1)>99 THEN RETURN
nl=nl+1
GOSUB clearline:
l(nl,0)=ll
l(nl,6)=(length/3)*2
l(nl,13)=l(ll,17)+(length/6)
l(nl,3)=l(ll,3)
l(nl,2)=l(ll,2)
l(nl,4)=l(ll,4)+4
l(nl,5)=l(ll,5)+4
l(nl,9)=1
IF l(nl,2)=0 THEN lt$(nl)="d135"
RETURN
J26:
INPUT "el type";elbow
INPUT "throat";throat
lne=lne+1:ll=l(lne,0)
GOSUB Rtn301:
GOSUB Rtn301:
GOSUB Rtn301:
lne0=lne-1
lne1=lne
lne2=lne+1
lne3=lne+2
IF throat=0 THEN IF l(lne0,1)<20 THEN throat=6*one ELSE throat=l(lne,5)
IF l(lne0,1)<20 THEN code=4:code2=0:length=(l(lne,5)/2)+throat
IF l(lne0,1)>19 THEN code=25:code2=20:length=(l(lne,5)/2)+throat
l(lne1,4)=l(lne0,4):l(lne1,5)=l(lne0,5):l(lne1,3)=l(lne0,3):l(lne1,8)=throat:l(lne1,7)=l(lne0,7)
l(lne2,4)=l(lne0,4):l(lne2,5)=l(lne0,5):l(lne2,3)=l(lne0,3):l(lne2,8)=throat:l(lne2,7)=l(lne0,7):lt$(lne2)=""
l(lne3,4)=l(lne0,4):l(lne3,5)=l(lne0,5):l(lne3,3)=l(lne0,3):l(lne3,7)=l(lne0,7):lt$(lne3)=""
l(lne1,0)=lne1-1:l(lne1,1)=code:l(lne1,2)=elbow:l(lne1,6)=length
l(lne2,0)=lne2-1:l(lne2,1)=code:l(lne2,2)=0:l(lne2,6)=length
l(lne3,0)=lne3-1:l(lne3,1)=code2:l(lne3,2)=0:l(lne3,6)=24*one

l(lne0,6)=l(lne0,6)-l(lne1,6)-l(lne2,6)-l(lne3,6)
IF elbow=1 OR elbow=2 OR elbow=6 THEN dir=1:IF code=4 THEN lt$(lne1)="1" ELSE lt$(lne1)="14"
IF elbow=3 OR elbow=4 OR elbow=7  THEN dir=-1:IF code=4 THEN lt$(lne1)="3" ELSE lt$(lne1)="23"
l(lne2,22)=l(lne0,22)+(length*2*SGN(dir))
lne=lne-1:GOSUB updateupdate:
lne=lne3
RETURN
J27:
FOR ll=1 TO nl
IF sl%(0)=sl%(ll) THEN IF l(ll,1)=21 AND l(ll,0)>0 THEN GOSUB J27a:

NEXT ll
RETURN
J27a:
a=ABS(l(ll,4)-l(l(ll,0),4))
b=ABS(l(ll,5)-l(l(ll,0),5))
IF b>a THEN a=b
IF a<=16 THEN l(ll,8)=12
IF a>16 THEN l(ll,8)=24
RETURN

J28:
olne=lne

nl=nl+1:GOSUB clearline::l(nl,1)=110:l(nl,4)=lheight:l(nl,7)=20:l(nl,5)=lwth:l(nl,20)=posx(posv):l(nl,21)=posy(posv):l(nl,14)=0:l(nl,15)=0
call getmouse(m(0)):msex=(m%(1)+fpx)*sc:msey=(m%(0)+fpy)*sc
dx2=msex-posx(posv):dy2=msey-posy(posv):GOSUB findangles10::angle=fix(angle+22.5):angle3=fix(angle/45)*45:l(nl,3)=angle3+uangle
dx2=l(lne,20)-posx(posv):dy2=l(lne,21)-l(nl,21)
GOSUB findangles10:
angle=(angle-l(nl,3)):angle2=angle
l(nl,6)=ABS(COS(gpi*angle)*dpxy)
l(nl,15)=-SIN(gpi*angle)*dpxy
posx(posv)=posx(posv)+COS(gpi*l(nl,3))*l(nl,6)
posy(posv)=posy(posv)-SIN(gpi*l(nl,3))*l(nl,6)
IF l(lne,2)=0 AND l(lne,1)<99 THEN GOSUB J28a::l(nl,15)=l(nl,15)+changepos*SGN(l(nl,15))
IF l(lne,2)<>0 OR l(lne,1)>99 THEN l(nl,15)=l(nl,15)+changepos*SGN(l(nl,15))
l(nl,14)=0


lne=nl:xxx=l(lne,6):xxx2=xxx:GOSUB subfractions::lst$(nl)=subfract$:GOSUB centerinlength::GOSUB updateupdate:
sl%(lne)=sl%(0)
RETURN
J28a:
ptx=l(lne,20)+COS(gpi*l(lne,3))*l(lne,6)
pty=l(lne,21)-SIN(gpi*l(lne,3))*l(lne,6)
dx2=ptx-l(nl,20):dy2=pty-l(nl,21)
GOSUB findangles10:
angle=(angle-l(nl,3)):angle3=angle
dist=ABS(COS(gpi*angle)*dpxy)
dist2=-SIN(gpi*angle)*dpxy
IF ABS(dist2)<ABS(l(nl,15)) THEN l(nl,6)=dist:l(nl,15)=dist2
IF changepos(8)>8 THEN IF l(lne,4)>changepos(8) THEN l(nl,6)=l(nl,6)-(l(lne,4)/2)

IF ABS(angle2-angle3)>100 THEN l(nl,15)=0
RETURN


J29:

dx=l(lne,20)-l(lne,5)/2
dy=l(lne,21)-l(lne,4)/2
dx2=l(lne,20)+l(lne,5)/2
dy2=l(lne,21)+l(lne,4)/2
FOR ll=1 TO nl
sl%(ll)=0
IF ll<>lne AND l(ll,6)>0 AND (l(ll,1)=113 OR l(ll,1)=114) THEN GOSUB J29a:
NEXT ll
sl%(0)=1
RETURN
J29a:
length=l(ll,6)
ns=INT(length/(4*one))
FOR t=0 TO ns
xpt=l(ll,20)+COS(gpi*l(ll,3))*4*t
ypt=l(ll,21)-SIN(gpi*l(ll,3))*4*t
IF (xpt>dx AND xpt<dx2) AND (ypt>dy AND ypt<dy2) THEN sl%(ll)=1:RETURN
NEXT t

RETURN
J30:
RETURN
J31:
RETURN
J32:
if l(lne,1)=110 or l(lne,1)=119 then goto J19:
lne1=trk(1):lne2=trk(2):lne=lne2:lne3=l(lne2,0):lne4=lne2:IF l(lne3,6)=0 THEN lne3=l(lne3,0)
if l(lne2,1)=120 then goto J32b:
GOSUB Getcode:
dx2=l(lne1,20)-l(lne2,20):dy2=l(lne1,21)-l(lne2,21)
IF ABS(dx2)<.001 AND ABS(dy2)<.001 THEN RETURN
GOSUB findangles10:
angle=(angle-l(lne2,3)):angle2=angle
distx=(COS(gpi*angle)*dpxy):IF l(lne2,2)=0 THEN distx=distx-l(lne2,6)
disty=SIN(gpi*angle)*dpxy
IF l(lne2,2)<>0 THEN goto J32a:
difangle=0:IF (l(lne2,3)<>l(lne3,3)) THEN difangle=l(lne2,3)-l(lne3,3):IF ABS(difangle)>180 THEN difangle=difangle+(SGN(difangle*-1)*360)
IF code>5 AND code<13 THEN l(lne2,13)=l(lne2,13)-(SGN(difangle)*disty):lne=lne2
IF code=5 OR code=4 THEN l(lne3,6)=l(lne3,6)-(SGN(difangle)*disty):lne=lne3
'IF ABS(disty)<=.001 THEN l(lne2,6)=l(lne2,6)+distx:distx=0
'IF ABS(disty)<=.001 THEN IF l(lne1,1)=128 AND l(lne1,7)<>7 AND l(lne4,2)=0 THEN GOSUB J32a:
GOSUB updateupdate:
lne=lne4
RETURN
J32a:
l(lne3,6)=l(lne3,6)+distx
gosub updateupdate:
return
J32b:
if l(lne1,1)<>128 then l(lne2,20)=l(lne1,20)+cos(gpi#*l(lne1,3))*l(lne1,6):l(lne2,21)=l(lne1,21)-sin(gpi#*l(lne1,3))*l(lne1,6)
if l(lne1,1)=128 then l(lne2,13)=l(lne1,20)-l(lne2,20):l(lne2,14)=l(lne1,21)-l(lne2,21)
gosub updateupdate:
return
J33:
if l(lne,1)=110 or l(lne,1)=119 then goto J19:
if l(lne,7)=4 then return
call getmouse (m%(0)):ptx=(m%(1)+fpx)*sc:pty=(m%(0)+fpy)*sc
dx2=ptx-l(lne,20):dy2=pty-l(lne,21)
GOSUB findangles10:
angle=angle-l(lne,3)
distx=COS(gpi*angle)*dpxy
disty=distx-l(lne,6)
IF l(lne,7)<6 THEN stdl1=s(2,l(lne,7)) ELSE stdl1=l(lne,7)
stdl2=fix(stdl1/2):print "stdl2=";stdl2
'gosub getcode::if code=1 and abs(distx)<1 then l(lne,8)=l(lne,17)+l(lne,16):l(lne,16)=0:gosub updateupdate::return
if disty>6 then goto J33a:
if disty<-6 then goto J33b:
if abs(disty)<6 then goto J33c:
return
J33a:
if l(lne,16)=0 then diff=stdl2
if l(lne,16)>0 and l(lne,16)<stdl2 then diff=stdl2-l(lne,16)
if l(lne,16)>=stdl2 then diff=stdl1-l(lne,16)
l(lne,6)=l(lne,6)+diff
print "diff=";diff
gosub ifendpiece:
if found=1 then l(ll3,6)=l(ll3,6)-diff:gosub forwardback3:
gosub updateupdate:
return

J33b:
if l(lne,16)=0 then diff=stdl1-stdl2
if l(lne,16)>stdl2 then diff=l(lne,16)-stdl2
if l(lne,16)>0 and l(lne,16)<=stdl2 then diff=l(lne,16)
diff=diff*-1

l(lne,6)=l(lne,6)+diff

gosub ifendpiece:
if found=1 then print "endpiece=";ll3:l(ll3,6)=l(ll3,6)-diff:gosub forwardback3:
gosub updateupdate:
return
J33c:
beep
if disty>0 then diff=fix(disty)-(l(lne,16)-fix(l(lne,16)))
if disty<0 then diff=fix(disty)-(l(lne,16)-fix(l(lne,16)))
l(lne,6)=l(lne,6)+diff
gosub ifendpiece:
if found=1 then print "endpiece=";ll3:l(ll3,6)=l(ll3,6)-diff:gosub forwardback3:
gosub updateupdate:
return

ifendpiece:
found=0
for ll3=lne+1 to nl

if l(ll3,0)=lne and abs(sin(l(ll3,3)-l(lne,3)))<.01 and l(ll3,6)>0 and l(ll3,14)=0 then found=1:return

next ll3
return
forwardback3:

FOR ll=ll3+1 TO nl
IF l(ll,0)=ll3 and  abs(sin(l(ll3,3)-l(ll,3)))>.5 THEN l(ll,13)=l(ll,13)-diff
NEXT ll
RETURN


J34:
gosub Rtn518:

RETURN
J35:
if l(lne,1)>199 then goto J35b:
call getmouse (m%(0)):ptx=(m%(1)+fpx)*sc:pty=(m%(0)+fpy)*sc
dx2=ptx-l(lne,20):dy2=pty-l(lne,21)
GOSUB findangles10:
angle=angle-l(lne,3)
distx=COS(gpi*angle)*dpxy
if abs(distx)<1 then lt$(lne)="b":return
if distx>l(lne,6) then distx=0 else distx=int(l(lne,6)-distx)
m$=str$(distx):ns=len(m$)
lt$(lne)=lt$(lne)+right$(m$,ns-1)+" "

gosub updateupdate:

RETURN
J35b:
link=l(lne,0)
call getmouse (m%(0)):ptx=(m%(1)+fpx)*sc:pty=(m%(0)+fpy)*sc
dx2=ptx-l(link,20):dy2=pty-l(link,21)
length=l(link,6)
GOSUB findangles10:
print angle
angle=angle-l(link,3)

distx=COS(gpi*angle)*dpxy
print distx
if distx>length+10 then lt$(lne)="b":return
if distx<0 then distx=0 else distx=int(distx)
m$=str$(distx):ns=len(m$)
lt$(lne)=lt$(lne)+right$(m$,ns-1)+" "

gosub updateupdate:

RETURN

J36:
locate 1,5
link=l(lne,0)
input "dir";dir
if dir=0 then goto J36a:
GOSUB inkey:
xxx=nnn:gosub subfractions:
l(lne,15)=(l(link,5)/2)+(dir*nnn)-(l(lne,5)/2)
gosub updateupdate:
return
J36a:
GOSUB inkey:
xxx=nnn:gosub subfractions:
l(lne,15)=-(l(link,5)/2)+(dir*nnn)+(l(lne,5)/2)
gosub updateupdate:

RETURN

J37:
olne=lne
cnt=0
input "code";n
for lne=1 to nl
gosub sncsn:
diff1=0:diff2=0

if n=1 then if l(lne,1)<99 then gosub Getcode::link=l(lne,0):if code=6 or code=7 or code=8 then if l(lne,5)>l(link,5) then cnt=cnt+1:sl%(lne)=sl%(0)+1
if n=2 then if l(lne,1)<99 then if l(lne,16)-fix(l(lne,16))>0 then cnt=cnt+1:sl%(lne)=sl%(0)+1
if n=3 then if l(lne,1)<99 then gosub Getcode::gosub intransverseconn::if found=1 then cnt=cnt+1:sl%(lne)=sl%(0)+1
if n=4 then if l(lne,1)=110 and l(lne,6)>0 and l(lne,18)=4 or l(lne,18)=5 then diff1=9999:diff2=9999:gosub J37a::if diff1>.1 or diff2>.1 then cnt=cnt+1:sl%(lne)=sl%(0)+1
if n=120 then if l(lne,1)=120 and l(lne,7)=2 and l(lne,11)=0 then diff1=0:diff2=0:gosub J37c::if diff1=0 or diff2=0 then cnt=cnt+1:sl%(lne)=sl%(0)+1
if n=128 then if l(lne,1)=128 and l(lne,17)>0 then if l(lne,13)>0 and l(lne,14)=0 then gosub J37f:

next lne
if cnt>0 then sl%(0)=sl%(0)+1
lne=olne
return
J37a:
xpt(1)=l(lne,20):ypt(1)=l(lne,21)
xpt(2)=l(lne,20)+cs1*l(lne,6):ypt(2)=l(lne,21)+sn1*l(lne,6)
for ll2=1 to nl
if l(ll2,1)<>110 or l(ll2,1)<>119 then gosub J37b:


next ll2
if diff1<.1 then l(lne,17)=lne2
if l(lne2,1)=111 then l(lne,14)=0
if l(lne3,1)=111 then l(lne,15)=0
return

J37b:

dx2=l(ll2,20)-xpt(1):dy2=l(ll2,21)-ypt(1)
GOSUB findangles10:
angle=angle-l(lne,3)
distx=COS(gpi*angle)*dpxy
disty=sin(gpi*angle)*dpxy
if abs(distx)<diff1 then diff1=abs(distx):lne2=ll2
dx2=l(ll2,20)-xpt(2):dy2=l(ll2,21)-ypt(2)
GOSUB findangles10:
angle=angle-l(lne,3)
distx=COS(gpi*angle)*dpxy
disty=sin(gpi*angle)*dpxy
if abs(distx)<diff2 then diff2=abs(distx):lne3=ll2
RETURN
J37c:
xpt(1)=l(lne,20):ypt(1)=l(lne,21)
xpt(2)=l(lne,20)+l(lne,13):ypt(2)=l(lne,21)+l(lne,14)
for ll2=1 to nl
if l(ll2,2)=0 and l(ll2,1)<99 then gosub J37d:
if l(ll2,1)=128 then gosub J37e:
next ll2


return
J37d:
xpt(3)=l(ll2,20)+cos(gpi#*l(ll2,3))*l(ll2,6):ypt(3)=l(ll2,21)-sin(gpi#*l(ll2,3))*l(ll2,6)
xpt(4)=abs(xpt(1)-xpt(3)):ypt(4)=abs(ypt(1)-ypt(3)):if xpt(4)>ypt(4) then diff=xpt(4) else diff=ypt(4)
if diff<1 then diff1=1:l(lne,17)=ll2:l(lne,20)=xpt(3):l(lne,21)=ypt(3)

return
J37e:
xpt(3)=l(ll2,20):ypt(3)=l(ll2,21)
xpt(4)=abs(xpt(2)-xpt(3)):ypt(4)=abs(ypt(2)-ypt(3)):if xpt(4)>ypt(4) then diff=xpt(4) else diff=ypt(4)
if diff<1 then diff2=1:l(ll2,17)=lne:l(lne,13)=xpt(3)-l(lne,20):l(lne,14)=ypt(3)-l(lne,21)

return
J37f:
link=l(lne,17)
if (l(link,1)=120 and l(lne,13)<>l(link,4)) or l(l(link,17),4)<>l(link,4) then sl%(link)=sl%(0)+1:sl%(lne)=sl%(0)+1::sl%(l(link,17))=sl%(0)+1:cnt=cnt+1


return

intransverseconn:
if l(lne,0)=0 then return
if l(lne,3)=l(l(lne,0),3) or l(lne,2)=0 then return
if l(lne,6)<1 then return
if l(lne,13)=0 then return
found=0:w(1)=l(lne,4)/2
IF l(lne,7)<6 THEN tlength=s(3,l(lne,7)) ELSE tlength=(6*one)
if l(lne,8)>0 then tlength=l(lne,8)
IF code=0 or code=10 or code=11 or code=12 THEN dist1=l(lne,13)-w(1)-1:dist2=l(lne,13)+w(1)+1:found=1
IF code=6 THEN dist1=l(lne,13)-w(1)-tlength-1:dist2=l(lne,13)+w(1)+1:found=1
IF code=7 THEN dist1=l(lne,13)-w(1)-1:dist2=l(lne,13)+w(1)+tlength+1:found=1
IF code=8 THEN dist1=l(lne,13)-w(1)-tlength-1:dist2=l(lne,13)+w(1)+tlength+1:found=1
if found=0 then return
found=0
dist=l(l(lne,0),17)
if 0>dist1 and 0<dist2 then found=1:locate 5,5:return
dist=dist+l(l(lne,0),16)
if dist>dist1 and dist<dist2 then found=1:return
IF l(lne,7)<6 THEN interval=s(2,l(l(lne,0),7)) ELSE interval=l(l(lne,0),7)
for i=1 to l(l(lne,0),18)
dist=dist+interval
if dist>dist1 and dist<dist2 then found=1:return
next i

return

J38:
return
J39:
input n
for lne=1 to nl

if l(lne,1)<99 and l(lne,2)=0 then gosub Getcode:
   if l(lne,1)<99 and l(lne,7)<>4 and l(lne,6)>0 and l(lne,2)=0 then if l(lne,18)>0 then cnt=0:n=0:gosub J39a::goto J39b:
if l(lne,1)<99 and l(lne,7)<>4 and l(lne,6)>0 and l(lne,2)=0 then cnt=0:n=1:gosub J39a::goto J39b:
if l(lne,1)<99 and l(lne,7)<>4 and l(lne,6)>0 and l(lne,2)=0 then if l(lne,16)>0 then cnt=0:gosub J39a::goto J39b:
if l(lne,1)<99 and l(lne,7)<>4 and l(lne,6)>0 and l(lne,2)=0 then if l(lne,17)>0 then cnt=0:gosub J39a::goto J39b:
'if l(lne,1)<99 and l(lne,7)<>4 and l(lne,6)>0 and l(lne,2)=0 then n=4:gosub J39a:
'if l(lne,1)<99 and l(lne,7)=4 and l(lne,6)>0 and l(lne,2)=0 and lst$(lne)="conn" then n=4:gosub J39a:
'if l(lne,1)=111 then n=4:gosub J39a:
'if l(lne,1)<99 and l(lne,7)<>4 and l(lne,6)>0 and l(lne,2)=0 then n=7:gosub J39a:
'if l(lne,1)<99 and l(lne,7)<>4 and l(lne,6)>0 and l(lne,2)=0 then if code=13 and l(lne,15)<>0 then n=8:gosub J39a:
'if l(lne,1)<99 and l(lne,7)<>4 and l(lne,6)>0 and l(lne,2)=0 then if code=13 and l(lne,14)<>0 then n=9:gosub J39a:
'if l(lne,1)=128 then n=128:gosub J39a:
next lne
sl%(0)=sl%(0)+1
return
J39a:
for ll2=1 to nl
if l(ll2,1)=110 and l(ll2,17)=lne and l(ll2,18)=n then cnt=cnt+1
next ll2
return
J39b:
if n=0 then if cnt<>l(lne,18) then sl%(lne)=sl%(0)+1

if n=1 then if l(lne,6)>0 and cnt<>1 then sl%(lne)=sl%(0)+1
if n=2 then if l(lne,16)>0 and cnt<>1 then sl%(lne)=sl%(0)+1
if n=3 then if l(lne,17)>0 and cnt<>1 then sl%(lne)=sl%(0)+1

return
J40:
olne=lne
locate 1,5:input "wth";wth3
for lne=1 to nl

if l(lne,1)<99 and l(lne,2)=0 then gosub Getcode:
  if l(lne,1)<99 and l(lne,7)<>4 and l(lne,6)>0 and l(lne,2)=0 then if l(lne,18)>0 then n=0:for ll1=1 to l(lne,18):gosub J40a::next ll1
if l(lne,1)<99 and l(lne,6)>0 and l(lne,2)=0 then n=1:gosub J40a:
if l(lne,1)<99 and l(lne,7)<>4 and l(lne,6)>0 and l(lne,2)=0 then if l(lne,16)>0 then n=2:gosub J40a:
if l(lne,1)<99 and l(lne,7)<>4 and l(lne,6)>0 and l(lne,2)=0 then if l(lne,17)>0 then n=3:gosub J40a:
if l(lne,1)<99 and l(lne,7)<>4 and l(lne,6)>0 and l(lne,2)=0 then n=4:gosub J40a:
if l(lne,1)<99 and l(lne,7)=4 and l(lne,6)>0 and l(lne,2)=0 and lst$(lne)="conn" then n=4:gosub J40a:
if l(lne,1)=111 then n=4:gosub J40a:
if l(lne,1)<99 and l(lne,7)<>4 and l(lne,6)>0 and l(lne,2)=0 then n=7:gosub J40a:
if l(lne,1)<99 and l(lne,7)<>4 and l(lne,6)>0 and l(lne,2)=0 then if code=13 and l(lne,15)<>0 then n=8:gosub J40a:
if l(lne,1)<99 and l(lne,7)<>4 and l(lne,6)>0 and l(lne,2)=0 then if code=13 and l(lne,14)<>0 then n=9:gosub J40a:
if l(lne,1)=128 then n=128:gosub J40a:
next lne
lne=olne

return

J40a:

for ll2=1 to nl
if l(ll2,1)=110 and l(ll2,17)=0 and l(ll2,18)=n then found=0:gosub J40b::if found=1 then l(ll2,17)=lne:return
next ll2
return
J40b:
gosub distxy:
gosub DimtoNum:
if n=0 then gosub J40c::if l(ll2,18)=0 then if distx>s1 and distx<s2 and disty<l(lne,4)/2 then if abs(stnum(1)-interval)<1 then found=1
if n=1 then if distx>0 and distx<l(lne,6) and disty<(l(lne,4)/2)*wth3 then if abs(stnum(1)-l(lne,4))<1 and abs(stnum(2)-l(lne,5))<1 then found=1
if n=2 then if distx>l(lne,17) and distx<l(lne,17)+l(lne,16) and disty<(l(lne,4)/2)*wth3 then if abs(stnum(1)-l(lne,16))<1 then found=1
if n=3 then if code<>5 then if distx>-3 and distx<l(lne,17) and disty<(l(lne,4)/2)*wth3 and stnum(1)-l(lne,17)<1then found=1
if n=3 then if code=5 then if distx>-2 and distx<l(lne,17) and disty<(l(lne,4)/2)*3 then found=1
if n=4 and l(lne,1)<99 then if distx>0 and distx<l(lne,6) and (disty<1 or abs(disty-abs(l(lne,4)/2)<1)) then if abs(l(ll2,6)-stnum(1))<1 then found=1
if n=4 and l(lne,1)=111 then if distx>0 and distx<l(lne,6) and disty<1 then if abs(l(ll2,6)-stnum(1))<1 then found=1
if n=7 then if distx>0 and distx<l(lne,6) and disty<(l(lne,4)/2)*wth3 then if abs(stnum(1)-(l(lne,22)+l(lne,5)/2))<1 and (stnum(2)-(l(lne,22)-l(lne,5)/2))<1 then found=1
if n=8 then if abs(stnum(1)-l(lne,15))<1 then found=1
if n=9 then if abs(stnum(1)-l(lne,14))<1  then found=1
if n=128 and l(lne,7)<>7 then if abs(distx)-abs(l(lne,4)/2)<1 and disty-abs(l(lne,5)/2)<1 then found=1
if n=128 and l(lne,7)=7 then if distx>0 and distx<l(lne,6) and  disty-abs(l(lne,4)/2)<1 then found=1
return
J40c:
IF l(lne,7)<6 THEN interval=s(2,l(lne,7)) ELSE interval=l(lne,7)
s1=l(lne,17)+l(lne,16)+((ll1-1)*interval):s2=l(lne,17)+l(lne,16)+((ll1)*interval):s3=abs(l(lne,4)/2)

return
if stnum(1)-l(ll2,6)<1 then goto J40b:
J40d:
for lne=1 to nl
gosub distxy:
next lne
return
distxy:
dx2=l(ll2,20)-l(lne,20):dy2=l(ll2,21)-l(lne,21)
GOSUB findangles10:
angle=angle-l(lne,3)
distx=COS(gpi*angle)*dpxy
disty=abs(sin(gpi*angle)*dpxy)
difangle=abs(sin(gpi*angle))
return
DimtoNum:
ns=LEN(lst$(ll2)):mm$="":num=0:col=0
for i=1 to 4:in(i)=0:next i
FOR ll=1 TO ns
m$=MID$(lst$(ll2),ll,1)
if m$>="0" and m$<="9" then num=num*10+val(m$)
if m$=" " then if num>0 then in(2)=num:num=0
if m$="/" then if num>0 then in(3)=num:num=0
m$=MID$(lst$(ll2),ll,2)
if m$="'-" then if num>0 then in(1)=num:ll=ll+1:num=0
if m$="''" and in(3)=0 then in(2)=num:num=0 
if m$="''" and in(3)=0 then col=col+1:stnum(col)=(in(1)*12)+in(2):ll=ll+1:for i=0 to 4:in(i)=0:next i:num=0
if m$="''" and in(3)>0 then col=col+1:in(4)=num:stnum(col)=(in(1)*12)+in(2)+(in(3)/in(4)):ll=ll+1:for i=0 to 4:in(i)=0:next i:num=0
nEXT ll
stnum(0)=col
if INSTR(1,lst$(ll2),";")>0 then if col=1 then col=2:stnum(2)=stnum(1)
stnum(0)=col
return
J41:
olne2=lne
nl2=nl
lne=l(olne2,17)
multidim=1
if l(olne2,18)=0 then gosub RtnD0:
if l(olne2,18)=1 then gosub RtnD1:
if l(olne2,18)=2 then gosub RtnD2:
if l(olne2,18)=3 then gosub RtnD3:
if l(olne2,18)=4 then gosub RtnD4:
if l(olne2,18)=5 then gosub RtnD5:
if l(olne2,18)=6 then gosub RtnD6:
if l(olne2,18)=7 then gosub RtnD7:
if l(olne2,18)=8 then gosub RtnD8:
if l(olne2,18)=9 then gosub RtnD9:
lst$(olne2)=lst$(nl)
nl=nl2
lne=olne2
multidim=0
gosub updateupdate:

return
J42:
for lne=1 to nl
if l(lne,1)=128 and sl%(lne)=sl%(0) and l(lne,15)>0 then l(lne,15)=int((l(lne,15)/.016387)/1728*60)
next lne

return
J43:
nl=nl+1
gosub clearline:
l(nl,0)=nl-1
l(nl,1)=200
l(nl,20)=posx(posv):l(nl,21)=posy(posv)
if l(lne,1)=103 then if l(lne,2)=0 and l(lne,3)=0 then l(nl,1)=210 else l(nl,1)=211 
lne=nl
gosub updateupdate:

return