REM Start of BASIC! Program WAKELOCK 4 FN.DEF triskelPar(d,n,turns,c1$, fill,bmp) LIST.CREATE n,lpl GR.PAINT.GET paint !a negative number of turns should ! reverse the spiral direction lr IF turns>0 THEN lr=1 ELSE lr=-1 turns=-turns ENDIF d-=2 !n equal circles arranged within ! a circumcircle d have ! this radius: rc=d/(1/SIN(PI()/n)+1)/2 !the circle on which the centers ! of the circles are has ! the radius: rt=d/2-rc ec1=turns %end counter spiral 1 ec2=turns-1/n %end counter spiral 2 f1=rc/ec1 %factor for spiral radius !angle correction per spiral ang=PI()/n-FRAC(turns)*PI()*2 nst=turns*200 %steps per spiral !main center mmx=d/2+1 mmy=d/2+1 !correction of the spiral center ! points to the main center so ! that the spiral ends match rt-=(f1*ec1-f1*ec2)/2/SIN(PI()/n) !go through all spiral centers FOR j=0 TO 0.99 STEP 1/n !calculate the spiral center mx=mmx+COS(lr*(j*PI()*2-PI()/2))*rt my=mmy+SIN(lr*(j*PI()*2-PI()/2))*rt !angle correction of the spiral arot=j*PI()*2 !coordinates of the first half ! of the spiral backwards FOR i=ec2 TO -0.0001 STEP -ec2/nst p=lr*(i*PI()*2+arot+ang+PI()) r=f1*i x=mx+COS(p)*r y=my+SIN(p)*r LIST.ADD lpl,x,y NEXT i !coordinates of the second half ! of the spiral forward FOR i=0 TO ec1+0.0001 STEP ec1/nst p=lr*(i*PI()*2+arot+ang) r=f1*i x=mx+COS(p)*r y=my+SIN(p)*r LIST.ADD lpl,x,y NEXT i !coordinates for angular ! correction of the Triskel IF ABS(j-(1/n*INT(n/2)))<0.0001 THEN qq=ec1-1/4 p=lr*(qq*PI()*2+arot+ang) r=f1*qq x11=mx+COS(p)*r y11=my+SIN(p)*r ENDIF IF ABS(j-(1/n*INT(n/2+1)))<0.0001 THEN qq=ec1-1/4-1/n p=lr*(qq*PI()*2+arot+ang) r=f1*qq x12=mx+COS(p)*r y12=my+SIN(p)*r ENDIF NEXT j !angular correction of the Triskel acor=-TODEGREES(ATAN((y12-y11)/(x12-x11))) !draw triskel into bitmap GR.BITMAP.DRAWINTO.START bmp GR.SET.STROKE 2 IF fill<0 THEN !perimeter for "negative" filling GR.SET.ANTIALIAS 0 GR.COLOR HEX(MID$(c1$,1,2)),HEX(MID$(c1$,3,2)),HEX(MID$(c1$,5,2)),HEX(MID$(c1$,7,2)),0 GR.CIRCLE vd,mmx,mmy,mmx-1 ELSEIF fill>0 THEN GR.COLOR HEX(MID$(c1$,1,2)),HEX(MID$(c1$,3,2)),HEX(MID$(c1$,5,2)),HEX(MID$(c1$,7,2)),1 ELSE GR.COLOR HEX(MID$(c1$,1,2)),HEX(MID$(c1$,3,2)),HEX(MID$(c1$,5,2)),HEX(MID$(c1$,7,2)),0 ENDIF GR.ROTATE.START acor,mmx,mmy GR.POLY vd,lpl GR.ROTATE.END GR.BITMAP.DRAWINTO.END LIST.CLEAR lpl %save some memory IF fill=-1 THEN !on request negative filling GR.BITMAP.FILL bmp,mmx,3 ENDIF GR.PAINT.COPY paint FN.END !test ARRAY.LOAD ap[],0,50 GR.OPEN 255,0,0,0,0,1 GR.SCREEN sx,sy DO GR.COLOR 255,0,63,0,1 GR.RECT gore1,0,sy/10*9,sx,sy GR.COLOR 255,0,0,0,1 GR.TEXT.SIZE sy/20 GR.TEXT.ALIGN 2 GR.TEXT.DRAW vd,sx/2,sy/40*39,"NEW" GR.BITMAP.CREATE bmp,sx,sx GR.BITMAP.CREATE bmp2,sx,sx n=2+INT(RND()*10) turns=(0.5+RND()*5)* SGN(INT(RND()*2)*2-1) fill=INT(RND()*3)-1 c1$="ff" FOR i=1 TO 6 c1$+=HEX$(INT(RND()*16)) NEXT i GR.COLOR 255 GR.BITMAP.DRAW gobm1,bmp,0,(sy-sx)/2 GR.ROTATE.START 0,sx/2,sy/2,prot GR.BITMAP.DRAW gobm2,bmp2,0,(sy-sx)/2 GR.ROTATE.END GR.HIDE gobm1 GR.HIDE gore1 triskelPar(sx,n,turns,c1$,fill,bmp) GR.COLOR 255,127,127,127,1 GR.SET.STROKE 10 GR.LINE vd,0,sy/20,sx/20*9,sy/20 GR.RENDER IF RND()>0.9 THEN n=2+INT(RND()*10) turns=(0.5+RND()*5)* SGN(INT(RND()*2)*2-1) fill=INT(RND()*3)-1 c2$="ff" FOR i=1 TO 6 c2$+=HEX$(INT(RND()*16)) NEXT i ELSEIF RND()>0.3 THEN n+=INT(RND()*3-1) turns=(turns+(RND()*1-0.5))* SGN(INT(RND()*2)*2-1) fill*=-1 c2$=c1$ ELSE n+=INT(RND()*3-1) turns=(turns+(RND()*1-0.5))* SGN(INT(RND()*2)*2-1) fill*=-1 c2$="ff" FOR i=1 TO 6 c2$+=HEX$(INT(RND()*16)) NEXT i ENDIF triskelPar(sx,n,turns,c2$,fill, bmp2) GR.COLOR 255,127,127,127,1 GR.SET.STROKE 10 GR.LINE vd,sx/20*11,sy/20,sx,sy/20 GR.SET.STROKE 2 GR.LINE vd,sx/20*9,sy/20,sx/20*11,sy/20 GR.COLOR 255,191,63,31,1 GR.CIRCLE goc,sx/20*11,sy/20,sx/50 GR.SHOW gobm1 GR.RENDER PAUSE 500 an=0 av=0.05+RND()*0.95 FOR avi=0 TO av STEP av/50 GR.MODIFY prot,"angle",an GR.MODIFY goc,"x",sx/20*11+avi/2*(sx/10*4) an+=avi IF an>360 THEN an-=360 ENDIF GR.RENDER NEXT avi GR.SHOW gore1 DO GR.TOUCH tt,tx,ty PAUSE 10 UNTIL !tt oav=av DO GR.TOUCH tt,tx,ty IF tt&!ott THEN % --- down --- IF ty<(sy/10) THEN modecontrol=1 ENDIF ELSEIF tt&ott THEN % --- move --- IF modecontrol THEN av=tx-sx/2 IF ABS(av)<(sx/20) THEN IF oav<>0 THEN oav=0 VIBRATE ap[],-1 ENDIF av=0 ELSE av=(av-sx/20*SGN(av))/(sx/10*2) IF oav=0 THEN oav=av VIBRATE ap[],-1 ENDIF ENDIF GR.MODIFY goc,"x",tx ren=1 ENDIF ELSEIF !tt&ott THEN % --- up --- modecontrol=0 ENDIF % --- down - move - up --- IF av<>0 THEN GR.MODIFY prot,"angle",an ren=1 an+=av IF an>360 THEN an-=360 ELSEIF an<0 THEN an+=360 ENDIF ENDIF IF ren=1 THEN GR.RENDER ren=0 ENDIF ott=tt UNTIL tt&(ty>(sy/10*9))&!modecontrol GR.BITMAP.DELETE bmp GR.BITMAP.DELETE bmp2 GR.CLS GR.RENDER UNTIL 0