home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 1 / FREEWARE.BIN / basic / fractal / frademo1.bas next >
BASIC Source File  |  1989-10-17  |  9KB  |  309 lines
  1. 100 '
  2. 110 ' F-BASIC386 SAMPLE PROGRAM % COPYRIGHT FUJITSU LIMITED 19890918
  3. 120 '
  4. 130 ' PUBLIC DOMAIN SOFTWARE by PRELUDE FMC(富士通マイコンクラブ)
  5. 140 '
  6. 150 ' ★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★
  7. 160 ' ★　ソフト名：フラクタル・デモ  ＰＡＲＴ１　Ｖ３              ★
  8. 170 ' ★　登録名　：ＦＲＡＤＥＭＯ１．ＢＡＳ　　　　　　　　　　　　★
  9. 180 ' ★　登録者　：ＰＲＥＬＵＤＥ（佐々木裕一）　　　　　　　      ★
  10. 190 ' ★  動作確認：ＦＭ－ＴＯＷＮＳ　Ｆ－ＢＡＳＩＣ３８６　　　　  ★
  11. 200 ' ★  備考　　：このプログラムはビデオカード対応です。     　   ★
  12. 210 ' ★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★
  13. 220 '
  14. 230 CLEAR,,1024
  15. 240 SCREEN@ 1:WINDOW (0,0)-(319,239):VIEW (0,0)-(319,239)
  16. 250 MOUSE 0:MOUSE 1,,,0:ON MOUSE(3) GOSUB *MO:MOUSE(3) ON
  17. 260 ON KEY(1) GOSUB *VIDEO:KEY (1) ON
  18. 270 COLOR 6,0,0,4:CLS
  19. 280 '
  20. 290 PRINT " マウス左をクリックすればメニューに戻ります。"
  21. 300 PRINT " ＰＦ１を押せばスーパーインポーズします。"
  22. 310 PRINT " １：ＶＯＮ　ＫＯＣＨ　ＣＵＲＶＥ (PF1)"
  23. 320 PRINT " ２：ＦＲＡＣＴＡＬ　ＢＲＡＮＣＨ (PF1)"
  24. 330 PRINT " ３：ＬＥＶＹ　ＦＬＩＧＨＴ　２Ｄ (PF1)"
  25. 340 PRINT " ４：Aggregation on 2D Lattice (10H/RUN PF1)"
  26. 350 PRINT " ５：ＬＯＲＥＮＺ　ＭＯＤＥＬ"
  27. 360 PRINT " ６：ＲＯＳＳＬＥＲ　ＭＯＤＥＬ"
  28. 370 PRINT " ７：ＤＵＦＦＩＮＧ　ＭＯＤＥＬ"
  29. 380 PRINT " ８：Nonlinear Osillations"
  30. 390 PRINT " ９：終了"
  31. 400 INPUT " 選択=>";KY
  32. 410 ON KY GOSUB *PRO1,*PRO2,*PRO3,*PRO4,*PRO5,*PRO6,*PRO7,*PRO8,*END:GOTO 270
  33. 420 '
  34. 430 *MO
  35. 440 MOUSE 5:RUN
  36. 450 *VIDEO
  37. 460 IF SW=0 THEN SW=1:SIMPOSE ON ELSE SW=0:SIMPOSE OFF
  38. 470 RETURN
  39. 480 *END
  40. 490 MOUSE 5:KEY (1) OFF:END
  41. 500 '
  42. 510 *PRO1
  43. 520 COLOR 2,7,0,0:CLS
  44. 530 '
  45. 540 '  % % % % %  VON KOCH CURVE  % % % % %
  46. 550 '
  47. 560 N=12:PI=3.14159!
  48. 570 DIM X(2^(N+1)-2),Y(2^(N+1)-2)
  49. 580 WINDOW(0,-2/3)-(1,0)
  50. 590 VIEW(0,0)-(319,199)
  51. 600 '
  52. 610 A=SQR(1/3)*COS(PI/6)
  53. 620 B=SQR(1/3)*SIN(PI/6)
  54. 630 A1=A:A2=B:A3=B:A4=-A
  55. 640 B1=A:B2=-B:B3=-B:B4=-A
  56. 650 '
  57. 660 X(0)=0:Y(0)=0
  58. 670 FOR M=1 TO N
  59. 680  L2=2^(M-1)-1:L1=L2*2+1:L3=L1*2
  60. 690  FOR K=0 TO L2
  61. 700  XX=X(L2+K):YY=Y(L2+K)
  62. 710  X(L1+K)=A1*XX+A2*YY
  63. 720  Y(L1+K)=A3*XX+A4*YY
  64. 730  X(L3-K)=B1*XX+B2*YY+1-B1
  65. 740  Y(L3-K)=B3*XX+B4*YY-B3
  66. 750  PSET(X(L1+K),-Y(L1+K)),2
  67. 760  PSET(X(L3-K),-Y(L3-K)),1
  68. 770  NEXT K
  69. 780 NEXT M:GOTO 660
  70. 790 '
  71. 800 *PRO2
  72. 810 COLOR 2,7,0,0:CLS
  73. 820 '
  74. 830 '  % % % % %  FRACTAL BRANCH  % % % % %
  75. 840 '
  76. 850 N=12:PI=3.14159!
  77. 860 DIM X(2^(N+1)-2),Y(2^(N+1)-2)
  78. 870 WINDOW(0,-1/3)-(1,1/3)
  79. 880 VIEW(0,0)-(319,199)
  80. 890 '
  81. 900 A=SQR(1/3)*COS(PI/6)
  82. 910 B=SQR(1/3)*SIN(PI/6)
  83. 920 A1=A:A2=B:A3=B:A4=-A
  84. 930 D=2/3:B1=D:B2=0:B3=0:B4=-D
  85. 940 '
  86. 950 X(0)=0:Y(0)=0
  87. 960 FOR M=1 TO N
  88. 970  L2=2^(M-1)-1:L1=L2*2+1:L3=L1*2
  89. 980  FOR K=0 TO L2
  90. 990  XX=X(L2+K):YY=Y(L2+K)
  91. 1000  X(L1+K)=A1*XX+A2*YY
  92. 1010  Y(L1+K)=A3*XX+A4*YY
  93. 1020  X(L3-K)=B1*XX+B2*YY+1-B1
  94. 1030  Y(L3-K)=B3*XX+B4*YY-B3
  95. 1040  PSET(X(L1+K),-Y(L1+K)),2
  96. 1050  PSET(X(L3-K),-Y(L3-K)),1
  97. 1060  NEXT K
  98. 1070 NEXT M:GOTO 950
  99. 1080 '
  100. 1090 *PRO3
  101. 1100 COLOR 6,7,0,0:CLS
  102. 1110 '
  103. 1120 '  % % % % %  LEVY FLIGHT 2-D  % % % % %
  104. 1130 '
  105. 1140 D=1.8!
  106. 1150 DD=-1/D:P2=3.14159!*2
  107. 1160 XL=50+10^(-DD*3.5!):YL=XL
  108. 1170 WINDOW(-XL,-YL)-(XL,YL)
  109. 1180 VIEW(0,0)-(319,239)
  110. 1190 '
  111. 1200 *LEVY2
  112. 1210 X=0:Y=0:N=1:RANDOMIZE TIME
  113. 1220 '
  114. 1230 *LEVY
  115. 1240 Z=(1-RND)^DD:W=RND*P2
  116. 1250 XX=X+Z*COS(W):YY=Y+Z*SIN(W)
  117. 1260 X=XX:Y=YY:PSET(X,Y),N/100 MOD 8:N=N+1
  118. 1270 IF YL<ABS(X) OR XL<ABS(X) GOTO *LEVY2 ELSE *LEVY
  119. 1280 '
  120. 1290 *PRO4
  121. 1300 COLOR 6,0,0,0:CLS
  122. 1310 '
  123. 1320 '  % % % % %  Aggregation on 2D Lattice (10H/RUN)  % % % % %
  124. 1330 '
  125. 1340 P=160:Q=120 ' Location of the seed
  126. 1350 R0=2 ' Initial value of R0
  127. 1360 PSET(P,Q),2:N=1
  128. 1370 FOR I=-20 TO 20:PSET(P+I,Q),2:PSET(P,Q+I),2
  129. 1380 NEXT I
  130. 1390 '
  131. 1400 *MAIN4
  132. 1410 R=R0*2 ' Particles appear at R
  133. 1420 RMAX=R0*3 ' Limit of moving area
  134. 1430 RX=INT((2*R+1)*RND)-R
  135. 1440 RV=R-ABS(RX)
  136. 1450 RY=RV*SGN(RND-.5!)
  137. 1460 X=RX+P:Y=RY+Q
  138. 1470 '
  139. 1480 *LOOP4
  140. 1490 XB=X:YB=Y
  141. 1500 DISTR=ABS(X-P)+ABS(Y-Q)
  142. 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
  143. 1520 '
  144. 1530 IF DISTR > RMAX THEN PRESET(X,Y):GOTO *MAIN4
  145. 1540 TWD(1)=0:TWD(2)=0 
  146. 1550 TWD(INT(2*RND)+1)=SGN(RND-.5!)
  147. 1560 X=X+TWD(1):Y=Y+TWD(2):N=N+1:IF N=8 THEN N=1
  148. 1570 PRESET(XB,YB):PSET(X,Y),N
  149. 1580 GOTO *LOOP4
  150. 1590 '
  151. 1600 *AGGR
  152. 1610 PSET(X,Y),N
  153. 1620 IF DISTR > R0 THEN R0=DISTR
  154. 1630 GOTO *MAIN4
  155. 1640 '
  156. 1650 *PRO5
  157. 1660 SCREEN@ 0:COLOR 6,5,0,0:CLS:KEY (1) OFF
  158. 1670 WINDOW(0,0)-(639,479):VIEW(0,0)-(639,479)
  159. 1680 '
  160. 1690 '  % % % % %  LORENZ MODEL  % % % % %
  161. 1700 '
  162. 1710 X=10:Y=12:Z=15:R=50:DT=.002!
  163. 1720 DIM V(1,3),W(1,3),U(1):RESTORE 1990
  164. 1730 FOR I=0 TO 1
  165. 1740 FOR J=0 TO 3:READ W(I,J):NEXT J
  166. 1750 FOR J=0 TO 3:READ V(I,J):NEXT J
  167. 1760 WINDOW(W(I,0),W(I,1))-(W(I,2),W(I,3))
  168. 1770 VIEW(V(I,0),V(I,1))-(V(I,2),V(I,3))
  169. 1780 LINE(-200,-200)-(200,200),PSET,1,BF
  170. 1790 LINE(-200,0)-(200,0),PSET,4:LINE(0,-200)-(0,200),PSET,4
  171. 1800 NEXT I
  172. 1810 LOCATE 37,16:PRINT"X",:LOCATE 19,3:PRINT"Z",
  173. 1820 LOCATE 77,16:PRINT"Y",:LOCATE 60,3:PRINT"Z",
  174. 1830 DEF FNX(X,Y,Z)=X+(-10*(X-Y))*DT
  175. 1840 DEF FNY(X,Y,Z)=Y+(-X*Z+R*X-Y)*DT
  176. 1850 DEF FNZ(X,Y,Z)=Z+(X*Y-2.66667!*Z)*DT
  177. 1860 '
  178. 1870 WHILE 1
  179. 1880 U(0)=X:U(1)=Y
  180. 1890 FOR I=0 TO 1
  181. 1900 WINDOW(W(I,0),W(I,1))-(W(I,2),W(I,3))
  182. 1910 VIEW(V(I,0),V(I,1))-(V(I,2),V(I,3))
  183. 1920 PSET(U(I),-Z),2
  184. 1930 NEXT I
  185. 1940 XX=FNX(X,Y,Z)
  186. 1950 YY=FNY(X,Y,Z)
  187. 1960 ZZ=FNZ(X,Y,Z)
  188. 1970 X=XX:Y=YY:Z=ZZ
  189. 1980 WEND
  190. 1990 DATA -30,-100,40,5,10,50,309,349
  191. 2000 DATA -40,-100,50,5,330,50,629,349
  192. 2010 '
  193. 2020 *PRO6
  194. 2030 SCREEN@ 0:COLOR 6,5,0,0:CLS:KEY (1) OFF
  195. 2040 WINDOW(0,0)-(639,479):VIEW(0,0)-(639,479)
  196. 2050 '
  197. 2060 '  % % % % %  ROSSLER MODEL  % % % % %
  198. 2070 '
  199. 2080 X=0:Y=3:Z=0:DT=.005!
  200. 2090 DIM V(1,3),W(1,3),U(1):RESTORE 2360
  201. 2100 FOR I=0 TO 1
  202. 2110 FOR J=0 TO 3:READ W(I,J):NEXT J
  203. 2120 FOR J=0 TO 3:READ V(I,J):NEXT J
  204. 2130 WINDOW(W(I,0),W(I,1))-(W(I,2),W(I,3))
  205. 2140 VIEW(V(I,0),V(I,1))-(V(I,2),V(I,3))
  206. 2150 LINE(-200,-200)-(200,200),PSET,1,BF
  207. 2160 LINE(-200,0)-(200,0),PSET,4:LINE(0,-200)-(0,200),PSET,4
  208. 2170 NEXT I
  209. 2180 LOCATE 37,16:PRINT"X",:LOCATE 19,3:PRINT"Z",
  210. 2190 LOCATE 77,16:PRINT"Y",:LOCATE 60,3:PRINT"Z",
  211. 2200 DEF FNX(X,Y,Z)=X+(-Y-Z)*DT
  212. 2210 DEF FNY(X,Y,Z)=Y+(X+.5!*Y)*DT
  213. 2220 DEF FNZ(X,Y,Z)=Z+(.4!*X-4.5!*Z+X*Z)*DT
  214. 2230 '
  215. 2240 WHILE 1
  216. 2250 U(0)=X:U(1)=Y:T=T+1
  217. 2260 FOR I=0 TO 1
  218. 2270 WINDOW(W(I,0),W(I,1))-(W(I,2),W(I,3))
  219. 2280 VIEW(V(I,0),V(I,1))-(V(I,2),V(I,3))
  220. 2290 IF Z<30 THEN PSET(U(I),-Z),2 ELSE ERASE U,V,W:GOTO 2080
  221. 2300 NEXT I
  222. 2310 XX=FNX(X,Y,Z)
  223. 2320 YY=FNY(X,Y,Z)
  224. 2330 ZZ=FNZ(X,Y,Z)
  225. 2340 X=XX:Y=YY:Z=ZZ
  226. 2350 WEND
  227. 2360 DATA -15,-30,15,5,10,50,309,349
  228. 2370 DATA -15,-30,15,5,330,50,629,349
  229. 2380 '
  230. 2390 '
  231. 2400 *PRO7
  232. 2410 SCREEN@ 0:COLOR 6,5,0,0:CLS:KEY (1) OFF
  233. 2420 WINDOW(0,0)-(639,479):VIEW(0,0)-(639,479)
  234. 2430 '
  235. 2440 '  % % % % %  DUFFING MODEL  % % % % %
  236. 2450 '
  237. 2460 X=-.682!:Y=.747!:Z=1.362!:DT=.07!:T=0:B=.25!:B0=.03!:K1=.04!:K2=.06!
  238. 2470 P=3.14159!
  239. 2480 DIM V(1,3),W(1,3),U(1):RESTORE 2760
  240. 2490 FOR I=0 TO 1
  241. 2500 FOR J=0 TO 3:READ W(I,J):NEXT J
  242. 2510 FOR J=0 TO 3:READ V(I,J):NEXT J
  243. 2520 WINDOW(W(I,0),W(I,1))-(W(I,2),W(I,3))
  244. 2530 VIEW(V(I,0),V(I,1))-(V(I,2),V(I,3))
  245. 2540 LINE(-200,-200)-(200,200),PSET,1,BF
  246. 2550 LINE(-200,-1)-(200,-1),PSET,4:LINE(0,-200)-(0,200),PSET,4
  247. 2560 NEXT I
  248. 2570 LOCATE 37,16:PRINT"X",:LOCATE 19,3:PRINT"Z",
  249. 2580 LOCATE 77,16:PRINT"Y",:LOCATE 60,3:PRINT"Z",
  250. 2590 DEF FNX(X,Y,Z)=X+Y*DT
  251. 2600 DEF FNY(X,Y,Z)=Y+(-K1*Y-(X*X+3*Z*Z)*X/8+B*COS(TA))*DT
  252. 2610 DEF FNZ(X,Y,Z)=Z+(-K2*(3*X*X+Z*Z)*Z/8+B0)*DT
  253. 2620 '
  254. 2630 WHILE 1
  255. 2640 U(0)=X:U(1)=Y
  256. 2650 FOR I=0 TO 1
  257. 2660 WINDOW(W(I,0),W(I,1))-(W(I,2),W(I,3))
  258. 2670 VIEW(V(I,0),V(I,1))-(V(I,2),V(I,3))
  259. 2680 IF Y>3 THEN ERASE U,V,W:GOTO 2460
  260. 2690 PSET(U(I),-Z),2+T/90 MOD 4
  261. 2700 NEXT I
  262. 2710 XX=FNX(X,Y,Z)
  263. 2720 YY=FNY(X,Y,Z)
  264. 2730 ZZ=FNZ(X,Y,Z)
  265. 2740 X=XX:Y=YY:Z=ZZ:TA=P*T/180:T=T+1:T=T MOD 361
  266. 2750 WEND
  267. 2760 DATA -2.2,-1.6,2.2,-.95,10,50,309,349
  268. 2770 DATA -2,-1.6,2,-.95,330,50,629,349
  269. 2780 '
  270. 2790 *PRO8
  271. 2800 SCREEN@ 0:COLOR 6,5,0,0:CLS:KEY (1) OFF
  272. 2810 WINDOW(0,0)-(639,479):VIEW(0,0)-(639,479)
  273. 2820 '
  274. 2830 '  % % % % %  Nonlinear Oscillations  % % % % %
  275. 2840 '
  276. 2850 X=0:Y=-.1!:Z=.25!:DT=.023!:T=0:B=.28!:B0=.24!:K1=.02!:K2=.02!
  277. 2860 P=3.14159!
  278. 2870 DIM V(1,3),W(1,3),U(1):RESTORE 3150
  279. 2880 FOR I=0 TO 1
  280. 2890 FOR J=0 TO 3:READ W(I,J):NEXT J
  281. 2900 FOR J=0 TO 3:READ V(I,J):NEXT J
  282. 2910 WINDOW(W(I,0),W(I,1))-(W(I,2),W(I,3))
  283. 2920 VIEW(V(I,0),V(I,1))-(V(I,2),V(I,3))
  284. 2930 LINE(-200,-200)-(200,200),PSET,1,BF
  285. 2940 LINE(-200,0)-(200,0),PSET,4:LINE(0,-200)-(0,200),PSET,4
  286. 2950 NEXT I
  287. 2960 LOCATE 37,16:PRINT"X",:LOCATE 19,3:PRINT"Z",
  288. 2970 LOCATE 77,16:PRINT"Y",:LOCATE 60,3:PRINT"Z",
  289. 2980 DEF FNX(X,Y,Z)=X+Y*DT
  290. 2990 DEF FNY(X,Y,Z)=Y+(-K2*Y-(X*X+3*Z*Z)*X)*DT
  291. 3000 DEF FNZ(X,Y,Z)=Z+(-K1*((3*X*X+Z*Z)*Z-B0)+B*SIN(TA))*DT
  292. 3010 '
  293. 3020 WHILE 1
  294. 3030 U(0)=X:U(1)=Y
  295. 3040 FOR I=0 TO 1
  296. 3050 WINDOW(W(I,0),W(I,1))-(W(I,2),W(I,3))
  297. 3060 VIEW(V(I,0),V(I,1))-(V(I,2),V(I,3))
  298. 3070 IF Y>.6!THEN ERASE U,V,W:GOTO 2850
  299. 3080 PSET(U(I),-Z),2+T/90 MOD 4
  300. 3090 NEXT I
  301. 3100 XX=FNX(X,Y,Z)
  302. 3110 YY=FNY(X,Y,Z)
  303. 3120 ZZ=FNZ(X,Y,Z)
  304. 3130 X=XX:Y=YY:Z=ZZ:TA=P*T/180:T=T+1:T=T MOD 361
  305. 3140 WEND
  306. 3150 DATA -.6,-1.4,.6,.1,10,50,309,349
  307. 3160 DATA -.6,-1.4,.6,.1,330,50,629,349
  308. 3170 '
  309.