1 REM **************************›2 REM *        ΒΟΞΣΑΙ          *›3 REM *          BY            *›4 REM *    R.I.MACDONALD       *›5 REM **************************›9 WRITE=2310:GO=58:DIM DRIVE$(3),FILE$(12),P$(1),F$(10),F1$(20):? "AUTORUN?":INPUT P$:IF P$="Y" THEN 20000›10 TRAP 20:? :? :? "NUMBER OF LEVELS":INPUT L:DIM R(L,1),H(L,1)›24 TRAP 25:? :? "INITIAL DIAMETER":INPUT WID›25 TRAP 30:? :? " CONTRACTION RATIO OF DIAMETER":INPUT DIAM›30 TRAP 40:? :? :? "LEFT ANGLE":INPUT H1:? :? :? "LEFT ANGLE DECREMENT"›40 TRAP 45:? :? :? "RIGHT ANGLE":INPUT H2:H2=H2:? :? :? "RIGHT ANGLE DECREMENT":INPUT DR›45 TRAP 46:? :? :? "LEFT RATIO":INPUT R1:? :? :? "RATIO INCREMENT (DECREMENT)":INPUT RD1›46 TRAP 47:? :? :? "RIGHT RATIO":INPUT R2:? :? :? "RATIO INCREMENT (DECREMENT)":INPUT RD2›47 TRAP 48:? :? :? "DIVERGENCE ANGLE?":INPUT DIV:IF (DIV<>0) AND ABS(H2)<ABS(H1) THEN GOSUB 400›48 TRAP 54:? :? :? "DEVIATIONS":? "UNIFORM:DX,DY,DZ":INPUT UDX,UDY,UDZ›49 TRAP 54:? :? :? "CONTROLLED:HOW MANY CONTROLLERS?":INPUT MM:IF MM=0 THEN 54›50 TRAP 49:? :? :? "GIVE STRENGTH AND X,Y,Z CO-ORDINATE FOR EACH":DIM FACTOR(MM),QX(MM),QY(MM),QZ(MM)›52 FOR M=1 TO MM:INPUT S,X,Y,Z:FACTOR(M)=S:QX(M)=X:QY(M)=Y:QZ(M)=Z:NEXT M›54 ? "DRIVE?":INPUT DRIVE$:? "ENTER FILENAME TO SAVE":INPUT FILE$›55 REM ***********************›56 REM *   MAIN PROGRAMME    *›57 REM ***********************›58 F=2:POKE 559,0:TRAP 59:DIM R(L,1),H(L,1)›59 TRAP 3000›60 H2=-H2:DEG :FOR J=1 TO L:H(J,0)=H1+(J-1)*DL:H(J,1)=H2-(J-1)*DR:R(J,0)=R1+(J-1)*RD1:R(J,1)=R2+(J-1)*RD2:NEXT J›100 TRAP 40000:PS=2^L:LS=PS-1›110 TRAP 120:DIM X(PS),Y(PS),Z(PS),LN(PS,2)›120 X(1)=0:X(2)=0:Y(1)=0:Y(2)=0:Z(1)=0:Z(2)=1:J=2:GOSUB 245›122 W=1:T=1:Q=2:H4=1:JP=2:JG=1:C=0:J=3:GOSUB 300:C=1:J=4:DIVFLG=1:GOSUB 300›123 LN(0,0)=0:LN(0,1)=0:LN(1,0)=0:LN(1,1)=0:LN(2,0)=1:LN(2,1)=2›124 GOSUB 300:LN(0,2)=WID:LN(1,2)=WID:LN(2,2)=WID:WID=WID*DIAM:LN(3,2)=WID:LN(4,2)=WID›125 OLDIV=0:FOR Q=3 TO L:H4=(-1)^Q›126 WID=WID*DIAM:IF (DIV>0) THEN DIVFLG=1›130 H3=0:FOR JG=INT(F^(Q-3)+1.001) TO INT(F^(Q-2)+1.0E-03):GP=JG-(F^(Q-3)+1)›136 FOR P=0 TO 1:FOR C=0 TO 1›140 J=INT(F^(Q-1)+1.001+C+2*P+4*GP):JP=INT(F^(Q-2)+1.001+P+2*GP)›145 LN(J,0)=JP:LN(J,1)=J:LN(J,2)=WID›150 U=X(JP)-X(JG):V=Y(JP)-Y(JG):W=Z(JP)-Z(JG):T=(U*U+V*V+W*W)^0.5›160 S=(U*U+V*V)^0.5:IF S=0 THEN GOSUB 305:GOTO 215›180 S=1/S›181 HHH=H(Q,C):IF (C<>1) OR (DIV=0) THEN 190›182 HHH=HHH*H4:IF H3=0 THEN HHH=ABS(HHH)›190 X(J)=UDX+X(JP)+R(Q,C)*(U*COS(HHH)-S*T*V*SIN(HHH))›200 Y(J)=UDY+Y(JP)+R(Q,C)*(V*COS(HHH)+S*T*U*SIN(HHH))›210 Z(J)=UDZ+Z(JP)+R(Q,C)*W*COS(HHH):GOSUB 220›215 NEXT C:H3=1:NEXT P:NEXT JG:NEXT Q:GOTO 2310›219 REM ****DIVERGENCE›220 IF (DIVFLG=0) OR (C=0) THEN 245›225 OLDIV=OLDIV+DIV›232 DEG :PH=180:DX=X(J)-X(JP):DY=Y(J)-Y(JP):R=(DX*DX+DY*DY)^0.5›234 IF DX=0 THEN PHI=PH/2+(SGN(DY)<>1)*PH:GOTO 240›236 PHI=ATN(DY/DX):IF SGN(DX)=1 THEN PHI=2*PH*(SGN(DY)=-1)+PHI:GOTO 240›238 PHI=PH+PHI›240 X(J)=X(JP)+R*COS(OLDIV+PHI):Y(J)=Y(JP)+R*SIN(OLDIV+PHI):DIVFLG=0›241 REM ****C0NTROLLERS›245 IF MM=0 THEN 280›246 FOR M=1 TO MM:QX=QX(M)-X(J):QY=QY(M)-Y(J):QZ=QZ(M)-Z(J):FX=FACTOR(M)›247 LK=(QX*QX+QY*QY+QZ*QZ)^0.5:X(J)=FX*(QX/LK)+X(J):Y(J)=FX*(QY/LK)+Y(J):Z(J)=FX*(QZ/LK)+Z(J)›248 NEXT M›280 RETURN ›300 REM ***** VERTICAL BRANCH *****›302 LN(J,0)=JP:LN(J,1)=J:LN(J,2)=WID›305 HHH=H(Q,C):IF (C<>1) OR (DIV=0) THEN 310›306 HHH=HHH*H4:IF H3=0 THEN HHH=ABS(HHH)›310 Y(J)=UDY+Y(JP)+R(Q,C)*T*SIN(HHH):X(J)=UDX+X(JP):Z(J)=UDZ+Z(JP)+R(Q,C)*W*COS(HHH)›320 GOSUB 220:RETURN ›400 REM *** EXCHANGE VALUES›401 TT=H2:H2=H1:H1=TT:TT=DL:DL=DR:DR=TT:RETURN ›2270 REM **********************›2280 REM *    CHAIN WRITE     *›2290 REM **********************›2310 F$=DRIVE$:F$(LEN(F$)+1)=FILE$:CLOSE #1:F1$=F$:F1$(LEN(F$)+1)=".PNT":OPEN #1,8,0,F1$›2320 ? #1;PS›2330 FOR X=1 TO PS:? #1;X(X):NEXT X›2340 FOR X=1 TO PS:? #1;Y(X):NEXT X›2350 FOR X=1 TO PS:? #1;Z(X):NEXT X›2360 CLOSE #1:TRAP 1210:F1$=F$:F1$(LEN(F$)+1)=".LIN":OPEN #1,8,0,F1$:TRAP 1190›2370 ? #1;LS:FOR X=1 TO LS:? #1;LN(X,0):? #1;LN(X,1):? #1;LN(X,2):NEXT X›2380 GRAPHICS 0:IF AUTFLG THEN RETURN ›2390 STOP ›3000 ? "MATRICES DIMENSIONED TOO SMALL.":? "RERUN PROGRAMME-WAIT":FOR J=1 TO 500:NEXT J:STOP ›19995 REM **********************›19996 REM * YOUR TREE-MAKING   *›19997 REM *  PROGRAMME GOES    *›19998 REM *      HERE          *›19999 REM **********************›20000 AUTFLG=1›