home *** CD-ROM | disk | FTP | other *** search
/ FreeWare Collection 2 / FreeSoftwareCollection2pd199x-jp.img / fbasic / prelude / pds0a / fractal / frademo1.bas next >
Encoding:
BASIC Source File  |  1990-06-14  |  14.2 KB  |  431 lines
  1. 100 ' F-BASIC386 SAMPLE PROGRAM % COPYRIGHT FUJITSU LIMITED 19900506
  2. 110 ' PUBLIC DOMAIN SOFTWARE by PRELUDE FMC(Fujitsuﾏｲｺﾝｸﾗﾌﾞ)
  3. 120 ' ★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★
  4. 130 ' ★　ソフト名：ﾌﾗｸﾀﾙ･ﾃﾞﾓ PART1 V4                              ★
  5. 140 ' ★　登録名　：FRADEMO01.BAS                                   ★
  6. 150 ' ★　登録者　：PRELUDE(Yuuichi Sasaki)         　　　　　      ★
  7. 160 ' ★  動作確認：FM-TOWNS 2 F-BASIC386 V1.1L20           　　　  ★
  8. 170 ' ★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★
  9. 180 '
  10. 190 *環境 ' *** 環境設定 ***
  11. 200 CLEAR,,1024:WIDTH 80,25:CONSOLE 0,24,1
  12. 210 COLOR 5,1,0,4:CLS:SCREEN@ 1:PASTEL:S=1
  13. 220 WINDOW (0,0)-(319,239):VIEW (0,0)-(319,239)
  14. 230 ON ERROR GOTO *異常
  15. 240 INTERVAL 2:ON INTERVAL GOSUB *時計:INTERVAL ON
  16. 250 ON KEY(1) GOSUB *PF1:KEY(1) ON
  17. 260 ON KEY(2) GOSUB *PF2:KEY(2) ON
  18. 270 ON KEY(3) GOSUB *PF3:KEY(3) ON
  19. 280 ON KEY(4) GOSUB *PF4:KEY(4) ON
  20. 290 ON KEY(5) GOSUB *PF5:KEY(5) ON
  21. 300 ON KEY(6) GOSUB *PF6:KEY(6) OFF
  22. 310 KEY 1," 終了":KEY 2,"SIMPOSE"
  23. 320 KEY 3," 書庫":KEY 4," MENU"
  24. 330 KEY 5," LOAD":KEY 6," 初期"
  25. 340 KEY 7," PF7":KEY 8," PF8"
  26. 350 KEY 9," PF9":KEY 10," PF10"
  27. 360 MOUSE 0
  28. 370 ON MOUSE(2) GOSUB *左押す:MOUSE(2) ON
  29. 380 ON MOUSE(4) GOSUB *右押す:MOUSE(4) ON
  30. 390 MOUSE 1,319,239,0
  31. 400 GOTO *MENU
  32. 410 '
  33. 420 *時計 ' *** 時計割込み処理 ***
  34. 430 INTERVAL OFF
  35. 440 TDT$=DATE$:TTM$=TIME$:TXX=POS(0):TYY=CSRLIN
  36. 450 LOCATE 10,1:PRINT TDT$;"†";TTM$;"†"
  37. 460 LOCATE TXX,TYY:INTERVAL ON:RETURN
  38. 470 '
  39. 480 *右押す ' *** ﾏｳｽ割込(終了) ***
  40. 490 MOUSE(2) OFF:MOUSE(4) OFF:INTERVAL OFF:RETURN *PF1
  41. 500 'MOUSE(2) ON:MOUSE(4) ON:INTERVAL ON:RETURN *PF1
  42. 510 '
  43. 520 *左押す ' *** ﾏｳｽ割込(ﾒﾆｭｰ) ***
  44. 530 MOUSE(2) OFF:MOUSE(4) OFF:INTERVAL OFF
  45. 540 MOUSE(2) ON:MOUSE(4) ON:INTERVAL ON:GOTO *PF4
  46. 550 '
  47. 560 *PF1 ' *** 終了処理 ***
  48. 570 INTERVAL OFF:MOUSE 5:WIDTH 80,25:CONSOLE 0,25,0:END
  49. 580 '
  50. 590 *PF2 ' *** ＴＶ(ｽｰﾊﾟｰｲﾝﾎﾟｰｽﾞ) ***
  51. 600 IF S<>1 THEN RETURN
  52. 610 IF SW=0 THEN SW=1:SIMPOSE ON ELSE SW=0:SIMPOSE OFF
  53. 620 RETURN
  54. 630 '
  55. 640 *PF3 ' *** FRA32A.TIF/FRA16A.TIFで保存 ***
  56. 650 LOCATE 0,0
  57. 660 PRINT"ｸﾞﾗﾌｨｯｸ画面を書庫(FRAxxA.TIF)に保存? Y で実行します。　"
  58. 670 IK$=INKEY$:IF IK$="Y" THEN GOTO 690 ELSE IF IK$="" THEN GOTO 670
  59. 680 GOTO 730
  60. 690 IF S=1 THEN KILL "\FILE\FRA32A.TIF"
  61. 700 IF S=1 THEN SAVE@ "\FILE\FRA32A.TIF",(0,0)-(319,239)
  62. 710 IF S=2 THEN KILL "\FILE\FRA16A.TIF"
  63. 720 IF S=2 THEN SAVE@ "\FILE\FRA16A.TIF",(0,0)-(639,479)
  64. 730 LOCATE 0,0
  65. 740 PRINT"                                                     　"
  66. 750 RETURN
  67. 760 '
  68. 770 *PF4 ' *** ﾒﾆｭｰ表示 ***
  69. 780 SCREEN@ 1:S=1:WINDOW (0,0)-(319*S,239*S)
  70. 790 VIEW (0,0)-(319*S,239*S):COLOR 5,1,0,4:CLS:RUN':RETURN *MENU
  71. 800 '
  72. 810 *PF5 ' *** LOAD ***
  73. 820 LOCATE 0,0
  74. 830 PRINT"ｸﾞﾗﾌｨｯｸ画面を書庫(FRAxxA.TIF)から読む? Y で実行します。"
  75. 840 IK$=INKEY$:IF IK$="Y" THEN GOTO 860 ELSE IF IK$="" THEN GOTO 840
  76. 850 GOTO 880
  77. 860 IF S=1 THEN LOAD@ "\FILE\FRA32A.TIF"
  78. 870 IF S=2 THEN LOAD@ "\FILE\FRA16A.TIF"
  79. 880 LOCATE 0,0
  80. 890 PRINT"                                                       "
  81. 900 RETURN
  82. 910 '
  83. 920 *PF6 ' *** 初期 ***
  84. 930 TXY=POS(0):TYX=CSRLIN:GOSUB *読む:LOCATE 0,0
  85. 940 IF D$="X" THEN INPUT" X=";X
  86. 950 IF D$="Y" THEN INPUT" Y=";Y
  87. 960 IF D$="Z" THEN INPUT" Z=";Z
  88. 970 IF D$="R" THEN INPUT" R=";R
  89. 980 IF D$="D" THEN INPUT" DT=";DT
  90. 990 IF D$="T" THEN INPUT" T=";T
  91. 1000 IF D$="A" THEN INPUT" A=";A
  92. 1010 IF D$="B" THEN INPUT" B,B0=";B,B0
  93. 1020 IF D$="C" THEN INPUT" C=";C
  94. 1030 IF D$="K" THEN INPUT" K1,K2=";K1,K2
  95. 1040 LOCATE 0,0:PRINT"                  ":LOCATE TXY,TYX:RETURN
  96. 1050 '
  97. 1060 *異常 ' 異常処理。
  98. 1070 OPEN"A",#1,"\FILE\ERROR.BAS"
  99. 1080 PRINT#1,ERL,"Error number=";ERR,"Error line=";ERL
  100. 1090 CLOSE#1
  101. 1100 BEEP:RESUME NEXT
  102. 1110 '
  103. 1120 *MENU
  104. 1130 LOCATE 0,0:PRINT:PRINT
  105. 1140 PRINT "◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆"
  106. 1150 PRINT "1: VON KOCH CURVE"
  107. 1160 PRINT "2: FRACTAL BRANCH"
  108. 1170 PRINT "3: LEVY FLIGHT 2D"
  109. 1180 PRINT "4: AGGREGATION ON 2D LATTICE"
  110. 1190 PRINT "5: LORENZ MODEL"
  111. 1200 PRINT "6: ROSSLER MODEL"
  112. 1210 PRINT "7: DUFFING MODEL"
  113. 1220 PRINT "8: NONLINEAR OSILLATIONS"
  114. 1230 PRINT "◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆"
  115. 1240 GOSUB *読む:KY=VAL(D$):IF KY<1 OR KY>9 THEN KY=0
  116. 1250 ON KY GOSUB *PRO1,*PRO2,*PRO3,*PRO4,*PRO5,*PRO6,*PRO7,*PRO8
  117. 1260 GOTO *MENU
  118. 1270 '
  119. 1280 *読む ' 文字読み
  120. 1290 MOUSE(2) OFF:MOUSE 1,100,100,1
  121. 1300 MO=MOUSE (2,0):IF MO<>0 GOTO 1290
  122. 1310 MOX=MOUSE (0):' X 座標
  123. 1320 MOY=MOUSE (1):' Y 座標
  124. 1330 D$=CHR$(SCREEN (MOX/(4*S),MOY/(9.5!*S)))
  125. 1340 LOCATE 0,0:PRINT"選択=>";D$;"  ﾏｳｽ左ｸﾘｯｸで選択。　　"
  126. 1350 MO=MOUSE (2,0):IF MO=0 GOTO 1310
  127. 1360 MO=MOUSE (2,0):IF MO<>0 GOTO 1360
  128. 1370 MOUSE 1,100,100,0::MOUSE(2) ON
  129. 1380 LOCATE 0,0:PRINT"                                   ":RETURN
  130. 1390 '
  131. 1400 *PRO1
  132. 1410 COLOR 2,7,0,0:CLS:LINE(0,0)-(319,239),PASTEL,1,BF:KEY(6) OFF
  133. 1420 '
  134. 1430 '  % % % % %  VON KOCH CURVE  % % % % %
  135. 1440 '
  136. 1450 N=12:PI=3.14159!
  137. 1460 DIM X(2^(N+1)-2),Y(2^(N+1)-2)
  138. 1470 WINDOW(0,-2/3)-(1,0)
  139. 1480 VIEW(0,0)-(319,199)
  140. 1490 '
  141. 1500 A=SQR(1/3)*COS(PI/6)
  142. 1510 B=SQR(1/3)*SIN(PI/6)
  143. 1520 A1=A:A2=B:A3=B:A4=-A
  144. 1530 B1=A:B2=-B:B3=-B:B4=-A
  145. 1540 '
  146. 1550 X(0)=0:Y(0)=0
  147. 1560 FOR M=1 TO N
  148. 1570  L2=2^(M-1)-1:L1=L2*2+1:L3=L1*2
  149. 1580  FOR K=0 TO L2
  150. 1590  XX=X(L2+K):YY=Y(L2+K)
  151. 1600  X(L1+K)=A1*XX+A2*YY
  152. 1610  Y(L1+K)=A3*XX+A4*YY
  153. 1620  X(L3-K)=B1*XX+B2*YY+1-B1
  154. 1630  Y(L3-K)=B3*XX+B4*YY-B3
  155. 1640  PSET(X(L1+K),-Y(L1+K)),2
  156. 1650  PSET(X(L3-K),-Y(L3-K)),1
  157. 1660  NEXT K
  158. 1670 NEXT M:BEEP:BEEP:GOTO 1550
  159. 1680 '
  160. 1690 *PRO2
  161. 1700 COLOR 2,7,0,0:CLS:LINE(0,0)-(319,239),PASTEL,1,BF:KEY(6) OFF
  162. 1710 '
  163. 1720 '  % % % % %  FRACTAL BRANCH  % % % % %
  164. 1730 '
  165. 1740 N=12:PI=3.14159!
  166. 1750 DIM X(2^(N+1)-2),Y(2^(N+1)-2)
  167. 1760 WINDOW(0,-1/3)-(1,1/3)
  168. 1770 VIEW(0,0)-(319,199)
  169. 1780 '
  170. 1790 A=SQR(1/3)*COS(PI/6)
  171. 1800 B=SQR(1/3)*SIN(PI/6)
  172. 1810 A1=A:A2=B:A3=B:A4=-A
  173. 1820 D=2/3:B1=D:B2=0:B3=0:B4=-D
  174. 1830 '
  175. 1840 X(0)=0:Y(0)=0
  176. 1850 FOR M=1 TO N
  177. 1860  L2=2^(M-1)-1:L1=L2*2+1:L3=L1*2
  178. 1870  FOR K=0 TO L2
  179. 1880  XX=X(L2+K):YY=Y(L2+K)
  180. 1890  X(L1+K)=A1*XX+A2*YY
  181. 1900  Y(L1+K)=A3*XX+A4*YY
  182. 1910  X(L3-K)=B1*XX+B2*YY+1-B1
  183. 1920  Y(L3-K)=B3*XX+B4*YY-B3
  184. 1930  PSET(X(L1+K),-Y(L1+K)),2
  185. 1940  PSET(X(L3-K),-Y(L3-K)),1
  186. 1950  NEXT K
  187. 1960 NEXT M:BEEP:BEEP:GOTO 1840
  188. 1970 '
  189. 1980 *PRO3
  190. 1990 COLOR 6,7,0,0:CLS:LINE(0,0)-(319,239),PASTEL,1,BF:KEY(6) OFF
  191. 2000 '
  192. 2010 '  % % % % %  LEVY FLIGHT 2-D  % % % % %
  193. 2020 '
  194. 2030 D=1.8!
  195. 2040 DD=-1/D:P2=3.14159!*2
  196. 2050 XL=50+10^(-DD*3.5!):YL=XL
  197. 2060 WINDOW(-XL,-YL)-(XL,YL)
  198. 2070 VIEW(0,0)-(319,239)
  199. 2080 '
  200. 2090 *LEVY2
  201. 2100 X=0:Y=0:N=1:RANDOMIZE TIME:BEEP
  202. 2110 '
  203. 2120 *LEVY
  204. 2130 Z=(1-RND)^DD:W=RND*P2
  205. 2140 XX=X+Z*COS(W):YY=Y+Z*SIN(W)
  206. 2150 X=XX:Y=YY:PSET(X,Y),N/100 MOD 8:N=N+1
  207. 2160 IF YL<ABS(X) OR XL<ABS(X) GOTO *LEVY2 ELSE *LEVY
  208. 2170 '
  209. 2180 *PRO4
  210. 2190 COLOR 6,0,0,0:CLS:KEY(6) OFF
  211. 2200 '
  212. 2210 '  % % % % %  Aggregation on 2D Lattice (10H/RUN)  % % % % %
  213. 2220 '
  214. 2230 P=160:Q=120 ' Location of the seed
  215. 2240 R0=2 ' Initial value of R0
  216. 2250 PSET(P,Q),2:N=1
  217. 2260 FOR I=-20 TO 20:PSET(P+I,Q),2:PSET(P,Q+I),2
  218. 2270 NEXT I
  219. 2280 '
  220. 2290 *MAIN4
  221. 2300 R=R0*2 ' Particles appear at R
  222. 2310 RMAX=R0*4 ' Limit of moving area
  223. 2320 RX=INT((2*R+1)*RND)-R
  224. 2330 RV=R-ABS(RX)
  225. 2340 RY=RV*SGN(RND-.5!)
  226. 2350 X=RX+P:Y=RY+Q:BEEP
  227. 2360 '
  228. 2370 *LOOP4
  229. 2380 XB=X:YB=Y
  230. 2390 DISTR=ABS(X-P)+ABS(Y-Q)
  231. 2400 IF POINT(X,Y-1)=-1 OR POINT(X,Y+1)=-1 THEN GOTO *AGGR
  232. 2410 IF POINT(X-1,Y)=-1 OR POINT(X+1,Y)=-1 THEN GOTO *AGGR
  233. 2420 IF DISTR > RMAX THEN PRESET(X,Y):GOTO *MAIN4
  234. 2430 TWD(1)=0:TWD(2)=0 
  235. 2440 TWD(INT(2*RND)+1)=SGN(RND-.5!)
  236. 2450 X=X+TWD(1):Y=Y+TWD(2):N=N+1:IF N=8 THEN N=1
  237. 2460 PRESET(XB,YB):PSET(X,Y),N
  238. 2470 GOTO *LOOP4
  239. 2480 '
  240. 2490 *AGGR
  241. 2500 PSET(X,Y),N
  242. 2510 IF DISTR > R0 THEN R0=DISTR
  243. 2520 GOTO *MAIN4
  244. 2530 '
  245. 2540 *PRO5
  246. 2550 SCREEN@ 0:S=2:COLOR 6,2,0,4:CLS:KEY(6) ON
  247. 2560 WINDOW(0,0)-(639,479):VIEW(0,0)-(639,479)
  248. 2570 '
  249. 2580 '  % % % % %  LORENZ MODEL  % % % % %
  250. 2590 '
  251. 2600 LOCATE 0,0:PRINT"初期:変数変更"
  252. 2610 X=10:Y=12:Z=15:R=50:DT=.002!:A=10:B=2.66667!
  253. 2620 DIM V(1,3),W(1,3),U(1):RESTORE 2950
  254. 2630 FOR I=0 TO 1
  255. 2640 FOR J=0 TO 3:READ W(I,J):NEXT J
  256. 2650 FOR J=0 TO 3:READ V(I,J):NEXT J
  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 LINE(-200,-200)-(200,200),PSET,1,BF
  260. 2690 LINE(-200,0)-(200,0),PSET,4:LINE(0,-200)-(0,200),PSET,4
  261. 2700 NEXT I
  262. 2710 LOCATE 37,16:PRINT"X",:LOCATE 19,3:PRINT"Z",
  263. 2720 LOCATE 77,16:PRINT"Y",:LOCATE 60,3:PRINT"Z",
  264. 2730 DEF FNX(X,Y,Z,A,B,DT)=X+(-A*(X-Y))*DT
  265. 2740 DEF FNY(X,Y,Z,A,B,DT)=Y+(-X*Z+R*X-Y)*DT
  266. 2750 DEF FNZ(X,Y,Z,A,B,DT)=Z+(X*Y-B*Z)*DT
  267. 2760 '
  268. 2770 LOCATE 1,20
  269. 2780 PRINT"初期 X=";X;" Y=";Y;" Z=";Z;" R=";R;" DT=";DT;" A=";A;" B=";B
  270. 2790 WHILE 1
  271. 2800 LOCATE 1,21:PRINT"現在 X=";X;"       "
  272. 2810 LOCATE 20,21:PRINT" Y=";Y;"       "
  273. 2820 LOCATE 35,21:PRINT" Z=";Z;"       "
  274. 2830 LOCATE 1,22:PRINT"     R=";R;" DT=";DT;" A=";A;" B=";B;"      "
  275. 2840 U(0)=X:U(1)=Y
  276. 2850 FOR I=0 TO 1
  277. 2860 WINDOW(W(I,0),W(I,1))-(W(I,2),W(I,3))
  278. 2870 VIEW(V(I,0),V(I,1))-(V(I,2),V(I,3))
  279. 2880 PSET(U(I),-Z),2
  280. 2890 NEXT I
  281. 2900 XX=FNX(X,Y,Z,A,B,DT)
  282. 2910 YY=FNY(X,Y,Z,A,B,DT)
  283. 2920 ZZ=FNZ(X,Y,Z,A,B,DT)
  284. 2930 X=XX:Y=YY:Z=ZZ
  285. 2940 WEND
  286. 2950 DATA -30,-100,40,5,10,50,309,349
  287. 2960 DATA -40,-100,50,5,330,50,629,349
  288. 2970 '
  289. 2980 *PRO6
  290. 2990 SCREEN@ 0:S=2:COLOR 6,2,0,4:CLS:KEY(6) ON
  291. 3000 WINDOW(0,0)-(639,479):VIEW(0,0)-(639,479)
  292. 3010 '
  293. 3020 '  % % % % %  ROSSLER MODEL  % % % % %
  294. 3030 '
  295. 3040 LOCATE 0,0:PRINT"初期:変数変更"
  296. 3050 X=0:Y=3:Z=0:DT=.006!:A=.5!:B=.4!:C=4.5!
  297. 3060 DIM V(1,3),W(1,3),U(1):RESTORE 3390
  298. 3070 FOR I=0 TO 1
  299. 3080 FOR J=0 TO 3:READ W(I,J):NEXT J
  300. 3090 FOR J=0 TO 3:READ V(I,J):NEXT J
  301. 3100 WINDOW(W(I,0),W(I,1))-(W(I,2),W(I,3))
  302. 3110 VIEW(V(I,0),V(I,1))-(V(I,2),V(I,3))
  303. 3120 LINE(-200,-200)-(200,200),PSET,1,BF
  304. 3130 LINE(-200,0)-(200,0),PSET,4:LINE(0,-200)-(0,200),PSET,4
  305. 3140 NEXT I
  306. 3150 LOCATE 37,11:PRINT"Y",:LOCATE 20,3:PRINT"X",
  307. 3160 LOCATE 77,11:PRINT"Z",:LOCATE 47,3:PRINT"X",
  308. 3170 DEF FNX(X,Y,Z,A,B,C,DT)=X+(-Y-Z)*DT
  309. 3180 DEF FNY(X,Y,Z,A,B,C,DT)=Y+(X+A*Y)*DT
  310. 3190 DEF FNZ(X,Y,Z,A,B,C,DT)=Z+(B*X-C*Z+X*Z)*DT
  311. 3200 '
  312. 3210 LOCATE 1,20
  313. 3220 PRINT"初期 X=";X;" Y=";Y;" Z=";Z;" DT=";DT;" A=";A;" B=";B;" C=";C
  314. 3230 WHILE 1
  315. 3240 LOCATE 1,21:PRINT"現在 X=";X;"       "
  316. 3250 LOCATE 20,21:PRINT" Y=";Y;"       "
  317. 3260 LOCATE 35,21:PRINT" Z=";Z;"       "
  318. 3270 LOCATE 1,22:PRINT"     DT=";DT;" A=";A;" B=";B;" C=";C;"     "
  319. 3280 U(0)=Y:U(1)=Z:T=T+1
  320. 3290 FOR I=0 TO 1
  321. 3300 WINDOW(W(I,0),W(I,1))-(W(I,2),W(I,3))
  322. 3310 VIEW(V(I,0),V(I,1))-(V(I,2),V(I,3))
  323. 3320 IF Z<30 THEN PSET(U(I),-X),2 ELSE BEEP:ERASE U,V,W:GOTO 3040
  324. 3330 NEXT I
  325. 3340 XX=FNX(X,Y,Z,A,B,C,DT)
  326. 3350 YY=FNY(X,Y,Z,A,B,C,DT)
  327. 3360 ZZ=FNZ(X,Y,Z,A,B,C,DT)
  328. 3370 X=XX:Y=YY:Z=ZZ
  329. 3380 WEND
  330. 3390 DATA -15,-15,15,15,10,50,309,349
  331. 3400 DATA -5,-15,30,15,330,50,629,349
  332. 3410 '
  333. 3420 *PRO7
  334. 3430 SCREEN@ 0:S=2:COLOR 6,2,0,4:CLS:KEY(6) ON
  335. 3440 WINDOW(0,0)-(639,479):VIEW(0,0)-(639,479)
  336. 3450 '
  337. 3460 '  % % % % %  DUFFING MODEL  % % % % %
  338. 3470 '
  339. 3480 LOCATE 0,0:PRINT"初期:変数変更"
  340. 3490 X=-.682!:Y=.747!:Z=1.362!:DT=.01!:T=0:B=.25!:B0=.03!:K1=.05!:K2=.05!
  341. 3500 P=3.14159!
  342. 3510 DIM V(1,3),W(1,3),U(1):RESTORE 3880
  343. 3520 FOR I=0 TO 1
  344. 3530 FOR J=0 TO 3:READ W(I,J):NEXT J
  345. 3540 FOR J=0 TO 3:READ V(I,J):NEXT J
  346. 3550 WINDOW(W(I,0),W(I,1))-(W(I,2),W(I,3))
  347. 3560 VIEW(V(I,0),V(I,1))-(V(I,2),V(I,3))
  348. 3570 LINE(-200,-200)-(200,200),PSET,1,BF
  349. 3580 LINE(-200,0)-(200,0),PSET,4:LINE(1,-200)-(1,200),PSET,4
  350. 3590 NEXT I
  351. 3600 LOCATE 37,10:PRINT"X",:LOCATE 29,3:PRINT"Y",
  352. 3610 LOCATE 77,10:PRINT"Z",:LOCATE 50,3:PRINT"Y",
  353. 3620 DEF FNX(X,Y,Z,B,B0,K1,K2,DT,TA)=X+Y*DT
  354. 3630 DEF FNY(X,Y,Z,B,K1,DT,TA)=Y+(-K1*Y-(X*X+3*Z*Z)*X/8+B*COS(TA))*DT
  355. 3640 DEF FNZ(X,Y,Z,B,B0,K1,K2,DT,TA)=Z+(-K2*(3*X*X+Z*Z)*Z/8+B0)*DT
  356. 3650 '
  357. 3660 LOCATE 1,20
  358. 3670 PRINT"初期 X=";X;" Y=";Y;" Z=";Z;" DT=";DT;
  359. 3680 PRINT" B=";B;" B0=";B0;" K1=";K1;" K2=";K2
  360. 3690 WHILE 1
  361. 3700 LOCATE 1,21:PRINT"現在 X=";X;"       "
  362. 3710 LOCATE 20,21:PRINT" Y=";Y;"       "
  363. 3720 LOCATE 35,21:PRINT" Z=";Z;"       "
  364. 3730 LOCATE 1,22:PRINT"     DT=";DT;" B=";B;" B0=";B0;
  365. 3740 PRINT" K1=";K1;" K2=";K2;" T=";T;"          "
  366. 3750 U(0)=X:U(1)=Z
  367. 3760 FOR I=0 TO 1
  368. 3770 WINDOW(W(I,0),W(I,1))-(W(I,2),W(I,3))
  369. 3780 VIEW(V(I,0),V(I,1))-(V(I,2),V(I,3))
  370. 3790 IF Z<.5! THEN BEEP:ERASE U,V,W:GOTO 3490
  371. 3800 'IF TA=0 OR TA=.5!*P OR TA=P OR TA=1.5!*P ELSE GOTO 3850
  372. 3810 PSET(U(I),Y),2+T/90 MOD 4
  373. 3820 NEXT I
  374. 3830 XX=FNX(X,Y,Z,B,B0,K1,K2,DT,TA)
  375. 3840 YY=FNY(X,Y,Z,B,K1,DT,TA)
  376. 3850 ZZ=FNZ(X,Y,Z,B,B0,K1,K2,DT,TA)
  377. 3860 X=XX:Y=YY:Z=ZZ:TA=P*T/180:T=T+1:T=T MOD 360
  378. 3870 WEND
  379. 3880 DATA -3,-1.5,2,1.5,10,50,309,349
  380. 3890 DATA .8,-1.5,2,1.5,330,50,629,349
  381. 3900 '
  382. 3910 *PRO8
  383. 3920 SCREEN@ 0:S=2:COLOR 6,2,0,4:CLS:KEY(6) ON
  384. 3930 WINDOW(0,0)-(639,479):VIEW(0,0)-(639,479)
  385. 3940 '
  386. 3950 '  % % % % %  Nonlinear Oscillations  % % % % %
  387. 3960 '
  388. 3970 LOCATE 0,0:PRINT"初期:変数変更"
  389. 3980 X=0:Y=-.1!:Z=.25!:DT=.02!:T=360:B=.25!:B0=.24!:K1=.05!:K2=.05!
  390. 3990 P=3.14159!
  391. 4000 DIM V(1,3),W(1,3),U(1):RESTORE 4370
  392. 4010 FOR I=0 TO 1
  393. 4020 FOR J=0 TO 3:READ W(I,J):NEXT J
  394. 4030 FOR J=0 TO 3:READ V(I,J):NEXT J
  395. 4040 WINDOW(W(I,0),W(I,1))-(W(I,2),W(I,3))
  396. 4050 VIEW(V(I,0),V(I,1))-(V(I,2),V(I,3))
  397. 4060 LINE(-200,-200)-(200,200),PSET,1,BF
  398. 4070 LINE(-200,0)-(200,0),PSET,4:LINE(0,-200)-(0,200),PSET,4
  399. 4080 NEXT I
  400. 4090 LOCATE 37,10:PRINT"X",:LOCATE 21,3:PRINT"Y",
  401. 4100 LOCATE 77,10:PRINT"Z",:LOCATE 45,3:PRINT"Y",
  402. 4110 DEF FNX(X,Y,Z,B,B0,K1,K2,DT,TA)=X+Y*DT
  403. 4120 DEF FNY(X,Y,Z,B,B0,K1,K2,DT,TA)=Y+(-K2*Y-(X*X+3*Z*Z)*X)*DT
  404. 4130 DEF FNZ(X,Y,Z,B,B0,K1,DT,TA)=Z+(-K1*((3*X*X+Z*Z)*Z-B0)+B*SIN(TA))*DT
  405. 4140 '
  406. 4150 LOCATE 1,20
  407. 4160 PRINT"初期 X=";X;" Y=";Y;" Z=";Z;" DT=";DT;
  408. 4170 PRINT" B=";B;" B0=";B0;" K1=";K1;" K2=";K2
  409. 4180 WHILE 1
  410. 4190 LOCATE 1,21:PRINT"現在 X=";X;"       "
  411. 4200 LOCATE 20,21:PRINT" Y=";Y;"       "
  412. 4210 LOCATE 35,21:PRINT" Z=";Z;"       "
  413. 4220 LOCATE 1,22:PRINT"     DT=";DT;" B=";B;" B0=";B0;
  414. 4230 PRINT" K1=";K1;" K2=";K2;" T=";T;"          "
  415. 4240 U(0)=X:U(1)=Z
  416. 4250 FOR I=0 TO 1
  417. 4260 WINDOW(W(I,0),W(I,1))-(W(I,2),W(I,3))
  418. 4270 VIEW(V(I,0),V(I,1))-(V(I,2),V(I,3))
  419. 4280 IF Y>.8!THEN BEEP:ERASE U,V,W:GOTO 3980
  420. 4290 'IF TA=0 OR TA=.5!*P OR TA=P OR TA=1.5!*P ELSE GOTO 4340
  421. 4300 PSET(U(I),Y),2+T/90 MOD 4
  422. 4310 NEXT I
  423. 4320 XX=FNX(X,Y,Z,B,B0,K1,K2,DT,TA)
  424. 4330 YY=FNY(X,Y,Z,B,B0,K1,K2,DT,TA)
  425. 4340 ZZ=FNZ(X,Y,Z,B,B0,K1,DT,TA)
  426. 4350 X=XX:Y=YY:Z=ZZ:TA=P*T/180:T=T+1:T=T MOD 360
  427. 4360 WEND
  428. 4370 DATA -.9,-.6,.6,.8,10,50,309,349
  429. 4380 DATA -.1,-.6,1,.8,330,50,629,349
  430. 4390 '
  431.