home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
FM Towns: Free Software Collection 1
/
FREEWARE.BIN
/
basic
/
fractal
/
frademo1.bas
next >
Wrap
BASIC Source File
|
1989-10-17
|
9KB
|
309 lines
100 '
110 ' F-BASIC386 SAMPLE PROGRAM % COPYRIGHT FUJITSU LIMITED 19890918
120 '
130 ' PUBLIC DOMAIN SOFTWARE by PRELUDE FMC(富士通マイコンクラブ)
140 '
150 ' ★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★
160 ' ★ ソフト名:フラクタル・デモ PART1 V3 ★
170 ' ★ 登録名 :FRADEMO1.BAS ★
180 ' ★ 登録者 :PRELUDE(佐々木裕一) ★
190 ' ★ 動作確認:FM-TOWNS F-BASIC386 ★
200 ' ★ 備考 :このプログラムはビデオカード対応です。 ★
210 ' ★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★
220 '
230 CLEAR,,1024
240 SCREEN@ 1:WINDOW (0,0)-(319,239):VIEW (0,0)-(319,239)
250 MOUSE 0:MOUSE 1,,,0:ON MOUSE(3) GOSUB *MO:MOUSE(3) ON
260 ON KEY(1) GOSUB *VIDEO:KEY (1) ON
270 COLOR 6,0,0,4:CLS
280 '
290 PRINT " マウス左をクリックすればメニューに戻ります。"
300 PRINT " PF1を押せばスーパーインポーズします。"
310 PRINT " 1:VON KOCH CURVE (PF1)"
320 PRINT " 2:FRACTAL BRANCH (PF1)"
330 PRINT " 3:LEVY FLIGHT 2D (PF1)"
340 PRINT " 4:Aggregation on 2D Lattice (10H/RUN PF1)"
350 PRINT " 5:LORENZ MODEL"
360 PRINT " 6:ROSSLER MODEL"
370 PRINT " 7:DUFFING MODEL"
380 PRINT " 8:Nonlinear Osillations"
390 PRINT " 9:終了"
400 INPUT " 選択=>";KY
410 ON KY GOSUB *PRO1,*PRO2,*PRO3,*PRO4,*PRO5,*PRO6,*PRO7,*PRO8,*END:GOTO 270
420 '
430 *MO
440 MOUSE 5:RUN
450 *VIDEO
460 IF SW=0 THEN SW=1:SIMPOSE ON ELSE SW=0:SIMPOSE OFF
470 RETURN
480 *END
490 MOUSE 5:KEY (1) OFF:END
500 '
510 *PRO1
520 COLOR 2,7,0,0:CLS
530 '
540 ' % % % % % VON KOCH CURVE % % % % %
550 '
560 N=12:PI=3.14159!
570 DIM X(2^(N+1)-2),Y(2^(N+1)-2)
580 WINDOW(0,-2/3)-(1,0)
590 VIEW(0,0)-(319,199)
600 '
610 A=SQR(1/3)*COS(PI/6)
620 B=SQR(1/3)*SIN(PI/6)
630 A1=A:A2=B:A3=B:A4=-A
640 B1=A:B2=-B:B3=-B:B4=-A
650 '
660 X(0)=0:Y(0)=0
670 FOR M=1 TO N
680 L2=2^(M-1)-1:L1=L2*2+1:L3=L1*2
690 FOR K=0 TO L2
700 XX=X(L2+K):YY=Y(L2+K)
710 X(L1+K)=A1*XX+A2*YY
720 Y(L1+K)=A3*XX+A4*YY
730 X(L3-K)=B1*XX+B2*YY+1-B1
740 Y(L3-K)=B3*XX+B4*YY-B3
750 PSET(X(L1+K),-Y(L1+K)),2
760 PSET(X(L3-K),-Y(L3-K)),1
770 NEXT K
780 NEXT M:GOTO 660
790 '
800 *PRO2
810 COLOR 2,7,0,0:CLS
820 '
830 ' % % % % % FRACTAL BRANCH % % % % %
840 '
850 N=12:PI=3.14159!
860 DIM X(2^(N+1)-2),Y(2^(N+1)-2)
870 WINDOW(0,-1/3)-(1,1/3)
880 VIEW(0,0)-(319,199)
890 '
900 A=SQR(1/3)*COS(PI/6)
910 B=SQR(1/3)*SIN(PI/6)
920 A1=A:A2=B:A3=B:A4=-A
930 D=2/3:B1=D:B2=0:B3=0:B4=-D
940 '
950 X(0)=0:Y(0)=0
960 FOR M=1 TO N
970 L2=2^(M-1)-1:L1=L2*2+1:L3=L1*2
980 FOR K=0 TO L2
990 XX=X(L2+K):YY=Y(L2+K)
1000 X(L1+K)=A1*XX+A2*YY
1010 Y(L1+K)=A3*XX+A4*YY
1020 X(L3-K)=B1*XX+B2*YY+1-B1
1030 Y(L3-K)=B3*XX+B4*YY-B3
1040 PSET(X(L1+K),-Y(L1+K)),2
1050 PSET(X(L3-K),-Y(L3-K)),1
1060 NEXT K
1070 NEXT M:GOTO 950
1080 '
1090 *PRO3
1100 COLOR 6,7,0,0:CLS
1110 '
1120 ' % % % % % LEVY FLIGHT 2-D % % % % %
1130 '
1140 D=1.8!
1150 DD=-1/D:P2=3.14159!*2
1160 XL=50+10^(-DD*3.5!):YL=XL
1170 WINDOW(-XL,-YL)-(XL,YL)
1180 VIEW(0,0)-(319,239)
1190 '
1200 *LEVY2
1210 X=0:Y=0:N=1:RANDOMIZE TIME
1220 '
1230 *LEVY
1240 Z=(1-RND)^DD:W=RND*P2
1250 XX=X+Z*COS(W):YY=Y+Z*SIN(W)
1260 X=XX:Y=YY:PSET(X,Y),N/100 MOD 8:N=N+1
1270 IF YL<ABS(X) OR XL<ABS(X) GOTO *LEVY2 ELSE *LEVY
1280 '
1290 *PRO4
1300 COLOR 6,0,0,0:CLS
1310 '
1320 ' % % % % % Aggregation on 2D Lattice (10H/RUN) % % % % %
1330 '
1340 P=160:Q=120 ' Location of the seed
1350 R0=2 ' Initial value of R0
1360 PSET(P,Q),2:N=1
1370 FOR I=-20 TO 20:PSET(P+I,Q),2:PSET(P,Q+I),2
1380 NEXT I
1390 '
1400 *MAIN4
1410 R=R0*2 ' Particles appear at R
1420 RMAX=R0*3 ' Limit of moving area
1430 RX=INT((2*R+1)*RND)-R
1440 RV=R-ABS(RX)
1450 RY=RV*SGN(RND-.5!)
1460 X=RX+P:Y=RY+Q
1470 '
1480 *LOOP4
1490 XB=X:YB=Y
1500 DISTR=ABS(X-P)+ABS(Y-Q)
1510 IF POINT(X,Y-1)=-1 OR POINT(X,Y+1)=-1 OR POINT(X-1,Y)=-1 OR POINT(X+1,Y)=-1 THEN *AGGR
1520 '
1530 IF DISTR > RMAX THEN PRESET(X,Y):GOTO *MAIN4
1540 TWD(1)=0:TWD(2)=0
1550 TWD(INT(2*RND)+1)=SGN(RND-.5!)
1560 X=X+TWD(1):Y=Y+TWD(2):N=N+1:IF N=8 THEN N=1
1570 PRESET(XB,YB):PSET(X,Y),N
1580 GOTO *LOOP4
1590 '
1600 *AGGR
1610 PSET(X,Y),N
1620 IF DISTR > R0 THEN R0=DISTR
1630 GOTO *MAIN4
1640 '
1650 *PRO5
1660 SCREEN@ 0:COLOR 6,5,0,0:CLS:KEY (1) OFF
1670 WINDOW(0,0)-(639,479):VIEW(0,0)-(639,479)
1680 '
1690 ' % % % % % LORENZ MODEL % % % % %
1700 '
1710 X=10:Y=12:Z=15:R=50:DT=.002!
1720 DIM V(1,3),W(1,3),U(1):RESTORE 1990
1730 FOR I=0 TO 1
1740 FOR J=0 TO 3:READ W(I,J):NEXT J
1750 FOR J=0 TO 3:READ V(I,J):NEXT J
1760 WINDOW(W(I,0),W(I,1))-(W(I,2),W(I,3))
1770 VIEW(V(I,0),V(I,1))-(V(I,2),V(I,3))
1780 LINE(-200,-200)-(200,200),PSET,1,BF
1790 LINE(-200,0)-(200,0),PSET,4:LINE(0,-200)-(0,200),PSET,4
1800 NEXT I
1810 LOCATE 37,16:PRINT"X",:LOCATE 19,3:PRINT"Z",
1820 LOCATE 77,16:PRINT"Y",:LOCATE 60,3:PRINT"Z",
1830 DEF FNX(X,Y,Z)=X+(-10*(X-Y))*DT
1840 DEF FNY(X,Y,Z)=Y+(-X*Z+R*X-Y)*DT
1850 DEF FNZ(X,Y,Z)=Z+(X*Y-2.66667!*Z)*DT
1860 '
1870 WHILE 1
1880 U(0)=X:U(1)=Y
1890 FOR I=0 TO 1
1900 WINDOW(W(I,0),W(I,1))-(W(I,2),W(I,3))
1910 VIEW(V(I,0),V(I,1))-(V(I,2),V(I,3))
1920 PSET(U(I),-Z),2
1930 NEXT I
1940 XX=FNX(X,Y,Z)
1950 YY=FNY(X,Y,Z)
1960 ZZ=FNZ(X,Y,Z)
1970 X=XX:Y=YY:Z=ZZ
1980 WEND
1990 DATA -30,-100,40,5,10,50,309,349
2000 DATA -40,-100,50,5,330,50,629,349
2010 '
2020 *PRO6
2030 SCREEN@ 0:COLOR 6,5,0,0:CLS:KEY (1) OFF
2040 WINDOW(0,0)-(639,479):VIEW(0,0)-(639,479)
2050 '
2060 ' % % % % % ROSSLER MODEL % % % % %
2070 '
2080 X=0:Y=3:Z=0:DT=.005!
2090 DIM V(1,3),W(1,3),U(1):RESTORE 2360
2100 FOR I=0 TO 1
2110 FOR J=0 TO 3:READ W(I,J):NEXT J
2120 FOR J=0 TO 3:READ V(I,J):NEXT J
2130 WINDOW(W(I,0),W(I,1))-(W(I,2),W(I,3))
2140 VIEW(V(I,0),V(I,1))-(V(I,2),V(I,3))
2150 LINE(-200,-200)-(200,200),PSET,1,BF
2160 LINE(-200,0)-(200,0),PSET,4:LINE(0,-200)-(0,200),PSET,4
2170 NEXT I
2180 LOCATE 37,16:PRINT"X",:LOCATE 19,3:PRINT"Z",
2190 LOCATE 77,16:PRINT"Y",:LOCATE 60,3:PRINT"Z",
2200 DEF FNX(X,Y,Z)=X+(-Y-Z)*DT
2210 DEF FNY(X,Y,Z)=Y+(X+.5!*Y)*DT
2220 DEF FNZ(X,Y,Z)=Z+(.4!*X-4.5!*Z+X*Z)*DT
2230 '
2240 WHILE 1
2250 U(0)=X:U(1)=Y:T=T+1
2260 FOR I=0 TO 1
2270 WINDOW(W(I,0),W(I,1))-(W(I,2),W(I,3))
2280 VIEW(V(I,0),V(I,1))-(V(I,2),V(I,3))
2290 IF Z<30 THEN PSET(U(I),-Z),2 ELSE ERASE U,V,W:GOTO 2080
2300 NEXT I
2310 XX=FNX(X,Y,Z)
2320 YY=FNY(X,Y,Z)
2330 ZZ=FNZ(X,Y,Z)
2340 X=XX:Y=YY:Z=ZZ
2350 WEND
2360 DATA -15,-30,15,5,10,50,309,349
2370 DATA -15,-30,15,5,330,50,629,349
2380 '
2390 '
2400 *PRO7
2410 SCREEN@ 0:COLOR 6,5,0,0:CLS:KEY (1) OFF
2420 WINDOW(0,0)-(639,479):VIEW(0,0)-(639,479)
2430 '
2440 ' % % % % % DUFFING MODEL % % % % %
2450 '
2460 X=-.682!:Y=.747!:Z=1.362!:DT=.07!:T=0:B=.25!:B0=.03!:K1=.04!:K2=.06!
2470 P=3.14159!
2480 DIM V(1,3),W(1,3),U(1):RESTORE 2760
2490 FOR I=0 TO 1
2500 FOR J=0 TO 3:READ W(I,J):NEXT J
2510 FOR J=0 TO 3:READ V(I,J):NEXT J
2520 WINDOW(W(I,0),W(I,1))-(W(I,2),W(I,3))
2530 VIEW(V(I,0),V(I,1))-(V(I,2),V(I,3))
2540 LINE(-200,-200)-(200,200),PSET,1,BF
2550 LINE(-200,-1)-(200,-1),PSET,4:LINE(0,-200)-(0,200),PSET,4
2560 NEXT I
2570 LOCATE 37,16:PRINT"X",:LOCATE 19,3:PRINT"Z",
2580 LOCATE 77,16:PRINT"Y",:LOCATE 60,3:PRINT"Z",
2590 DEF FNX(X,Y,Z)=X+Y*DT
2600 DEF FNY(X,Y,Z)=Y+(-K1*Y-(X*X+3*Z*Z)*X/8+B*COS(TA))*DT
2610 DEF FNZ(X,Y,Z)=Z+(-K2*(3*X*X+Z*Z)*Z/8+B0)*DT
2620 '
2630 WHILE 1
2640 U(0)=X:U(1)=Y
2650 FOR I=0 TO 1
2660 WINDOW(W(I,0),W(I,1))-(W(I,2),W(I,3))
2670 VIEW(V(I,0),V(I,1))-(V(I,2),V(I,3))
2680 IF Y>3 THEN ERASE U,V,W:GOTO 2460
2690 PSET(U(I),-Z),2+T/90 MOD 4
2700 NEXT I
2710 XX=FNX(X,Y,Z)
2720 YY=FNY(X,Y,Z)
2730 ZZ=FNZ(X,Y,Z)
2740 X=XX:Y=YY:Z=ZZ:TA=P*T/180:T=T+1:T=T MOD 361
2750 WEND
2760 DATA -2.2,-1.6,2.2,-.95,10,50,309,349
2770 DATA -2,-1.6,2,-.95,330,50,629,349
2780 '
2790 *PRO8
2800 SCREEN@ 0:COLOR 6,5,0,0:CLS:KEY (1) OFF
2810 WINDOW(0,0)-(639,479):VIEW(0,0)-(639,479)
2820 '
2830 ' % % % % % Nonlinear Oscillations % % % % %
2840 '
2850 X=0:Y=-.1!:Z=.25!:DT=.023!:T=0:B=.28!:B0=.24!:K1=.02!:K2=.02!
2860 P=3.14159!
2870 DIM V(1,3),W(1,3),U(1):RESTORE 3150
2880 FOR I=0 TO 1
2890 FOR J=0 TO 3:READ W(I,J):NEXT J
2900 FOR J=0 TO 3:READ V(I,J):NEXT J
2910 WINDOW(W(I,0),W(I,1))-(W(I,2),W(I,3))
2920 VIEW(V(I,0),V(I,1))-(V(I,2),V(I,3))
2930 LINE(-200,-200)-(200,200),PSET,1,BF
2940 LINE(-200,0)-(200,0),PSET,4:LINE(0,-200)-(0,200),PSET,4
2950 NEXT I
2960 LOCATE 37,16:PRINT"X",:LOCATE 19,3:PRINT"Z",
2970 LOCATE 77,16:PRINT"Y",:LOCATE 60,3:PRINT"Z",
2980 DEF FNX(X,Y,Z)=X+Y*DT
2990 DEF FNY(X,Y,Z)=Y+(-K2*Y-(X*X+3*Z*Z)*X)*DT
3000 DEF FNZ(X,Y,Z)=Z+(-K1*((3*X*X+Z*Z)*Z-B0)+B*SIN(TA))*DT
3010 '
3020 WHILE 1
3030 U(0)=X:U(1)=Y
3040 FOR I=0 TO 1
3050 WINDOW(W(I,0),W(I,1))-(W(I,2),W(I,3))
3060 VIEW(V(I,0),V(I,1))-(V(I,2),V(I,3))
3070 IF Y>.6!THEN ERASE U,V,W:GOTO 2850
3080 PSET(U(I),-Z),2+T/90 MOD 4
3090 NEXT I
3100 XX=FNX(X,Y,Z)
3110 YY=FNY(X,Y,Z)
3120 ZZ=FNZ(X,Y,Z)
3130 X=XX:Y=YY:Z=ZZ:TA=P*T/180:T=T+1:T=T MOD 361
3140 WEND
3150 DATA -.6,-1.4,.6,.1,10,50,309,349
3160 DATA -.6,-1.4,.6,.1,330,50,629,349
3170 '