A.N.A.L.O.G. Magazine 1986 May/86_may.atr/bonsai1.lst

File List | 2023-02-26 | 4KB | 1 lines

1 REM **************************¢2 REM *        אנמצIJח          *¢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¢