REM Start of BASIC! Program GOSUB deffn BUNDLE.CREATE glob BUNDLE.PUT glob,"tension",0.33 e_mode_select=1 e_mode_menu=2 e_mode_men1=3 e_mode_men2=4 e_mode_men3=5 e_mode_men4=6 e_mode_insert=31 e_mode_delete=32 e_mode_movenode=11 e_mode_movecontrol=12 e_mode_smoothAuto=21 e_mode_smoothManual=22 e_mode_cornerAuto=23 e_mode_cornerManual=24 e_mode_tension=45 e_type_auto_smooth=0 e_type_auto_corner=2 e_type_manual_smooth=1 e_type_manual_corner=3 DIM l[8] DIM x[8],y[8] DIM gon[8] DIM goc[16] DIM gobc[16] DIM bmc[4] GR.OPEN 255,255,255,255,0,1 GR.SCREEN sx,sy rx=sx/12 ry=sy/20 BUNDLE.PUT glob,"rx",rx BUNDLE.PUT glob,"ry",ry LIST.CREATE n,lpl LIST.ADD lpl,rx* 8,ry*16 LIST.ADD lpl,rx* 7,ry* 7.5 LIST.ADD lpl,rx* 11,ry* 7 LIST.ADD lpl,rx* 8,ry* 4 LIST.ADD lpl,rx* 4,ry* 4 LIST.ADD lpl,rx* 1,ry* 7 LIST.ADD lpl,rx* 5,ry* 7.5 LIST.ADD lpl,rx* 4,ry*16 LIST.CREATE n,lsp LIST.CREATE n,lpoly LIST.CREATE s,lfnam FOR i=1 TO 8 LIST.GET lpl,i*2-1,x[i] LIST.GET lpl,i*2,y[i] NEXT i GOSUB createbitmaps GR.BITMAP.DRAW gomen1,bmen1,0,-ry*10 GR.BITMAP.DRAW gomen2,bmen2,rx*2,-ry*4 GR.BITMAP.DRAW gomen3,bmen3,rx*4,-ry*5 GR.BITMAP.DRAW gomen4,bmen4,rx*6,-ry*7 lsp=polyToSpline(lpl,1) splineToPoly(lsp,lpoly) GR.COLOR 255,255,0,0,1 GR.SET.STROKE 3 GR.POLY gopoly,lpoly GR.SET.STROKE 1 GR.COLOR 255,255,0,0,1 FOR i=1 TO 8 GR.CIRCLE gon[i],x[i],y[i],rx/10 NEXT i GR.COLOR 255,0,0,255,1 FOR i=1 TO 8 LIST.GET lsp,i*8+1,type LIST.GET lsp,i*8+3,x1 LIST.GET lsp,i*8+4,y1 GR.LINE goc[i*2-1],x1,y1,x[i],y[i] GR.BITMAP.DRAW gobc[i*2-1],bmc[type+1],x1-16,y1-16 LIST.GET lsp,i*8+2,type LIST.GET lsp,i*8+7,x1 LIST.GET lsp,i*8+8,y1 GR.LINE goc[i*2],x1,y1,x[i],y[i] GR.BITMAP.DRAW gobc[i*2],bmc[type+1],x1-16,y1-16 NEXT i GR.BITMAP.DRAW gomen,bmen,0,0 FOR i=9 TO nlsp STEP 8 LIST.GET lsp,i+2,c1x LIST.GET lsp,i+3,c1y LIST.GET lsp,i+4,px LIST.GET lsp,i+5,py LIST.GET lsp,i+6,c2x LIST.GET lsp,i+7,c2y GR.COLOR 255,0,0,255 GR.SET.STROKE 1 GR.LINE vd,c1x,c1y,px,py GR.LINE vd,c2x,c2y,px,py NEXT i GR.TEXT.DRAW goact,rx*10,ry*0.6,"-" GOSUB redraw hideControl(gon[],goc[],gobc[]) !mode=e_mode_new mode=e_mode_select DO GR.TOUCH tt,tx,ty IF tt&!ott THEN IF ty<(2*ry) THEN menselx=INT(tx/rx/2) IF menopen=1 THEN hidemenu(gomen1,glob) ELSEIF menopen=2 THEN hidemenu(gomen2,glob) ELSEIF menopen=3 THEN hidemenu(gomen3,glob) ELSEIF menopen=4 THEN hidemenu(gomen4,glob) ENDIF IF menselx=0 THEN showmenu(gomen1,glob) menopen=1 mode=e_mode_men1 ELSEIF menselx=1 THEN showmenu(gomen2,glob) menopen=2 mode=e_mode_men2 ELSEIF menselx=2 THEN showmenu(gomen3,glob) menopen=3 mode=e_mode_men3 ELSEIF menselx=3 THEN showmenu(gomen4,glob) menopen=4 mode=e_mode_men4 ELSE mode=e_mode_select GR.MODIFY goact,"text","-" menopen=0 hideControl(gon[],goc[],gobc[]) ENDIF ELSE IF mode=e_mode_select THEN ELSEIF mode=e_mode_movenode THEN !find the node, closest to tx,ty LIST.SIZE lsp,nlsp lmin=1e99 p=0 FOR i=9 TO nlsp STEP 8 LIST.GET lsp,i+4,x LIST.GET lsp,i+5,y l=HYPOT(tx-x,ty-y) IF l0 THEN !move the node an its control points LIST.GET lsp,p-2,c1x LIST.GET lsp,p-1,c1y LIST.GET lsp,p,px LIST.GET lsp,p+1,py LIST.GET lsp,p+2,c2x LIST.GET lsp,p+3,c2y dx=tx-px dy=ty-py LIST.REPLACE lsp,p-2,c1x+dx LIST.REPLACE lsp,p-1,c1y+dy LIST.REPLACE lsp,p,tx LIST.REPLACE lsp,p+1,ty LIST.REPLACE lsp,p+2,c2x+dx LIST.REPLACE lsp,p+3,c2y+dy !check the control points of the node LIST.SIZE lsp,nlsp np=nlsp/8-1 pn=(p-5)/8 calculateControl(lsp,pn) moveControl(lsp,pn,goc[],gobc[]) !check the control points of the neigbour nodes IF pn=1 THEN calculateControl(lsp,pn+1) moveControl(lsp,pn+1, goc[],gobc[]) calculateControl(lsp,np) moveControl(lsp,np, goc[],gobc[]) ELSEIF pn=np THEN calculateControl(lsp,1) moveControl(lsp,1, goc[],gobc[]) calculateControl(lsp,np-1) moveControl(lsp,np-1, goc[],gobc[]) ELSE calculateControl(lsp,pn+1) moveControl(lsp,pn+1, goc[],gobc[]) calculateControl(lsp,pn-1) moveControl(lsp,pn-1, goc[],gobc[]) ENDIF splinetopoly(lsp,lpoly) GR.MODIFY gon[(p-4)/8],"x",tx,"y",ty GR.RENDER ENDIF ELSEIF mode=e_mode_movecontrol THEN pn=INT(p/8) LIST.REPLACE lsp,p,tx LIST.REPLACE lsp,p+1,ty calculateControl(lsp,pn) moveControl(lsp,pn,goc[],gobc[]) splinetopoly(lsp,lpoly) GR.RENDER ELSEIF mode=e_mode_tension THEN tens=ROUND((ty-3*ry)/(sy-4*ry),2) IF tens<0 THEN tens=0 IF tens>1 THEN tens=1 BUNDLE.PUT glob,"tension",tens GR.MODIFY goact,"text","tension "+STR$(tens) LIST.SIZE lsp,nlsp np=nlsp/8-1 FOR i=1 TO np calculateControl(lsp,i) moveControl(lsp,i,goc[],gobc[]) NEXT i splinetopoly(lsp,lpoly) ENDIF %mode ELSEIF !tt&ott THEN ELSE PAUSE 50 ENDIF ott=tt GR.TEXT.SIZE sy/30 GR.TEXT.ALIGN 2 GR.SET.STROKE 1 GR.RENDER ott=tt UNTIL 0 deffn: !lpl is a polygon list like !GR.POLY is using it. !if closed=0 then the spline is open !all other values close the spline !Region FN polyToSpline FN.DEF polyToSpline(lpl,closed) BUNDLE.GET 1,"tension",tens LIST.CREATE n,lsp LIST.SIZE lpl,n IF closed=0 THEN !spline is open LIST.ADD lsp,0,0,0,0,0,0,0,0 ELSE !spline is closed LIST.ADD lsp,1,0,0,0,0,0,0,0 LIST.GET lpl,1,ox LIST.GET lpl,2,oy LIST.GET lpl,3,x LIST.GET lpl,4,y LIST.GET lpl,n-1,oox LIST.GET lpl,n,ooy LET l1=HYPOT(ox-oox,oy-ooy) LET l2=HYPOT(x-ox,y-oy) LET f1=tens*l1/(l1+l2) LET f2=tens*l2/(l1+l2) LET dx=x-oox LET dy=y-ooy LET a=ox-dx*f1 LET b=oy-dy*f1 LET c=ox+dx*f2 LET d=oy+dy*f2 LIST.ADD lsp,0,0,a,b,ox,oy,c,d !GR.CIRCLE vd,ox,oy,5 !GR.LINE vd,a,b,c,d LET oox=ox LET ooy=oy LET ox=x LET oy=y ENDIF LIST.GET lpl,1,oox LIST.GET lpl,2,ooy LIST.GET lpl,3,ox LIST.GET lpl,4,oy FOR i=5 TO n-1 STEP 2 LIST.GET lpl,i,x LIST.GET lpl,i+1,y LET l1=HYPOT(ox-oox,oy-ooy) LET l2=HYPOT(x-ox,y-oy) LET f1=tens*l1/(l1+l2) LET f2=tens*l2/(l1+l2) LET dx=x-oox LET dy=y-ooy LET a=ox-dx*f1 LET b=oy-dy*f1 LET c=ox+dx*f2 LET d=oy+dy*f2 LIST.ADD lsp,0,0,a,b,ox,oy,c,d !GR.CIRCLE vd,ox,oy,5 !GR.LINE vd,a,b,c,d LET oox=ox LET ooy=oy LET ox=x LET oy=y NEXT i IF closed=0 THEN !spline is open LIST.GET lsp,11,a LIST.GET lsp,12,b LIST.GET lpl,1,x LIST.GET lpl,2,y LET a=(a+x)/2 LET b=(b+y)/2 LIST.INSERT lsp, 9,0 LIST.INSERT lsp,10,0 LIST.INSERT lsp,11,0 LIST.INSERT lsp,12,0 LIST.INSERT lsp,13,x LIST.INSERT lsp,14,y LIST.INSERT lsp,15,a LIST.INSERT lsp,16,b !GR.LINE vd,x,y,a,b LET c=(c+ox)/2 LET d=(d+oy)/2 LIST.ADD lsp,0,0,c,d,ox,oy !GR.LINE vd,ox,oy,c,d ELSE !spline is closed LIST.GET lpl,1,x LIST.GET lpl,2,y LET l1=HYPOT(ox-oox,oy-ooy) LET l2=HYPOT(x-ox,y-oy) LET f1=tens*l1/(l1+l2) LET f2=tens*l2/(l1+l2) LET dx=x-oox LET dy=y-ooy LET a=ox-dx*f1 LET b=oy-dy*f1 LET c=ox+dx*f2 LET d=oy+dy*f2 LIST.ADD lsp,0,0,a,b,ox,oy,c,d !GR.CIRCLE vd,ox,oy,5 !GR.LINE vd,a,b,c,d ENDIF FN.RTN lsp FN.END !EndRegion !Region FN drawSpline FN.DEF drawSpline(ls) LIST.SIZE ls,cn FOR j=9 TO cn-9 STEP 8 LIST.GET ls,j+1,t1 LIST.GET ls,j+4,p1x LIST.GET ls,j+5,p1y LIST.GET ls,j+6,s1x LIST.GET ls,j+7,s1y LIST.GET ls,j+8,t2 LIST.GET ls,j+10,s2x LIST.GET ls,j+11,s2y LIST.GET ls,j+12,p2x LIST.GET ls,j+13,p2y LET n=(HYPOT(s1x-p1x,s1y-p1y)+ HYPOT(s2x-s1x,s2y-s1y)+ HYPOT(p2x-s2x,p2y-s2y))/20 LET ox=p1x LET oy=p1y FOR i=0 TO 1 STEP 1/n LET x1=p1x+(s1x-p1x)*i LET y1=p1y+(s1y-p1y)*i LET x2=s1x+(s2x-s1x)*i LET y2=s1y+(s2y-s1y)*i LET x3=s2x+(p2x-s2x)*i LET y3=s2y+(p2y-s2y)*i LET x=x1+i* (x2*2-x1*2+i*(x3-x2*2+x1)) LET y=y1+i* (y2*2-y1*2+i*(y3-y2*2+y1)) GR.LINE vd,ox,oy,x,y LET ox=x LET oy=y NEXT i GR.LINE vd,ox,oy,p2x,p2y NEXT j LIST.GET ls,1,closed IF closed THEN LIST.GET ls,cn-7,t1 LIST.GET ls,cn-3,p1x LIST.GET ls,cn-2,p1y LIST.GET ls,cn-1,s1x LIST.GET ls,cn,s1y LIST.GET ls,9,t2 LIST.GET ls,11,s2x LIST.GET ls,12,s2y LIST.GET ls,13,p2x LIST.GET ls,14,p2y LET n=(HYPOT(s1x-p1x,s1y-p1y)+ HYPOT(s2x-s1x,s2y-s1y)+ HYPOT(p2x-s2x,p2y-s2y))/20 LET ox=p1x LET oy=p1y FOR i=0 TO 1 STEP 1/n LET x1=p1x+(s1x-p1x)*i LET y1=p1y+(s1y-p1y)*i LET x2=s1x+(s2x-s1x)*i LET y2=s1y+(s2y-s1y)*i LET x3=s2x+(p2x-s2x)*i LET y3=s2y+(p2y-s2y)*i LET x=x1+i* (x2*2-x1*2+i*(x3-x2*2+x1)) LET y=y1+i* (y2*2-y1*2+i*(y3-y2*2+y1)) GR.LINE vd,ox,oy,x,y LET ox=x LET oy=y NEXT i GR.LINE vd,ox,oy,p2x,p2y ENDIF FN.END !EndRegion !Region FN splineToPoly FN.DEF splineToPoly(ls,lpoly) LIST.CLEAR lpoly LIST.SIZE ls,cn FOR j=9 TO cn-9 STEP 8 LIST.GET ls,j+1,t1 LIST.GET ls,j+4,p1x LIST.GET ls,j+5,p1y LIST.GET ls,j+6,s1x LIST.GET ls,j+7,s1y LIST.GET ls,j+8,t2 LIST.GET ls,j+10,s2x LIST.GET ls,j+11,s2y LIST.GET ls,j+12,p2x LIST.GET ls,j+13,p2y LET n=(HYPOT(s1x-p1x,s1y-p1y)+ HYPOT(s2x-s1x,s2y-s1y)+ HYPOT(p2x-s2x,p2y-s2y))/20 LET ox=p1x LET oy=p1y LIST.ADD lpoly,ox,oy FOR i=0 TO 1 STEP 1/n LET x1=p1x+(s1x-p1x)*i LET y1=p1y+(s1y-p1y)*i LET x2=s1x+(s2x-s1x)*i LET y2=s1y+(s2y-s1y)*i LET x3=s2x+(p2x-s2x)*i LET y3=s2y+(p2y-s2y)*i LET x=x1+i* (x2*2-x1*2+i*(x3-x2*2+x1)) LET y=y1+i* (y2*2-y1*2+i*(y3-y2*2+y1)) LIST.ADD lpoly,x,y LET ox=x LET oy=y NEXT i LIST.ADD lpoly,p2x,p2y NEXT j LIST.GET ls,1,closed IF closed THEN LIST.GET ls,cn-7,t1 LIST.GET ls,cn-3,p1x LIST.GET ls,cn-2,p1y LIST.GET ls,cn-1,s1x LIST.GET ls,cn,s1y LIST.GET ls,9,t2 LIST.GET ls,11,s2x LIST.GET ls,12,s2y LIST.GET ls,13,p2x LIST.GET ls,14,p2y LET n=(HYPOT(s1x-p1x,s1y-p1y)+ HYPOT(s2x-s1x,s2y-s1y)+ HYPOT(p2x-s2x,p2y-s2y))/20 LET ox=p1x LET oy=p1y LIST.ADD lpoly,ox,oy FOR i=0 TO 1 STEP 1/n LET x1=p1x+(s1x-p1x)*i LET y1=p1y+(s1y-p1y)*i LET x2=s1x+(s2x-s1x)*i LET y2=s1y+(s2y-s1y)*i LET x3=s2x+(p2x-s2x)*i LET y3=s2y+(p2y-s2y)*i LET x=x1+i* (x2*2-x1*2+i*(x3-x2*2+x1)) LET y=y1+i* (y2*2-y1*2+i*(y3-y2*2+y1)) LIST.ADD lpoly,x,y LET ox=x LET oy=y NEXT i LIST.ADD lpoly,p2x,p2y ENDIF FN.END !EndRegion FN.DEF selectNode(ls,tx,ty,resx,resy) LET dmin=1e99 LIST.SIZE ls,cn FOR j=9 TO cn-9 STEP 8 LIST.GET ls,j+1,t1 LIST.GET ls,j+4,p1x LIST.GET ls,j+5,p1y LIST.GET ls,j+6,s1x LIST.GET ls,j+7,s1y LIST.GET ls,j+8,t2 LIST.GET ls,j+10,s2x LIST.GET ls,j+11,s2y LIST.GET ls,j+12,p2x LIST.GET ls,j+13,p2y LET n=(HYPOT(s1x-p1x,s1y-p1y)+ HYPOT(s2x-s1x,s2y-s1y)+ HYPOT(p2x-s2x,p2y-s2y))/20 FOR i=0 TO 1 STEP 1/n LET x1=p1x+(s1x-p1x)*i LET y1=p1y+(s1y-p1y)*i LET x2=s1x+(s2x-s1x)*i LET y2=s1y+(s2y-s1y)*i LET x3=s2x+(p2x-s2x)*i LET y3=s2y+(p2y-s2y)*i LET x=x1+i* (x2*2-x1*2+i*(x3-x2*2+x1)) LET y=y1+i* (y2*2-y1*2+i*(y3-y2*2+y1)) LET d=HYPOT(tx-x,ty-y) IF d0 THEN LIST.CLEAR lsp LIST.GET lfnam,sel,fna$ BYTE.OPEN r,fnr,fna$ BYTE.READ.NUMBER fnr,nlsp FOR i=1 TO nlsp BYTE.READ.NUMBER fnr,dat LIST.ADD lsp,dat NEXT i LIST.GET lsp,2,tens BUNDLE.PUT glob,"tension",tens BYTE.CLOSE fnr GOSUB redraw POPUP "loaded" ENDIF GR.MODIFY goact,"text","-" RETURN