home *** CD-ROM | disk | FTP | other *** search
/ FreeWare Collection 2 / FreeSoftwareCollection2pd199x-jp.img / fbasic / prelude / pds0a / fractal / frademo2.bas < prev    next >
Encoding:
BASIC Source File  |  1990-06-14  |  9.1 KB  |  297 lines
  1. 100 ' F-BASIC386 SAMPLE PROGRAM % COPYRIGHT FUJITSU LIMITED 19900511
  2. 110 ' PUBLIC DOMAIN SOFTWARE by PRELUDE FMC(Fujitsuﾏｲｺﾝｸﾗﾌﾞ)
  3. 120 ' ★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★
  4. 130 ' ★　ソフト名：ﾌﾗｸﾀﾙ･ﾃﾞﾓ PART2 V4                              ★
  5. 140 ' ★　登録名　：FRADEMO02.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:PR=0:T=0
  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) ON
  22. 310 KEY 1," 終了":KEY 2," ﾎﾟｰｽﾞ"
  23. 320 KEY 3," 書庫":KEY 4," ﾒﾆｭｰ"
  24. 330 KEY 5," ﾛｰﾄﾞ":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 2,1:PRINT TDT$;"†";TTM$;"†"
  37. 460 T=T+1:IF T=10 THEN COL=COL+1:COL=COL MOD 8:T=0
  38. 470 LOCATE TXX,TYY:INTERVAL ON:RETURN
  39. 480 '
  40. 490 *右押す ' *** ﾏｳｽ割込(終了) ***
  41. 500 MOUSE(2) OFF:MOUSE(4) OFF:INTERVAL OFF:RETURN *PF1
  42. 510 'MOUSE(2) ON:MOUSE(4) ON:INTERVAL ON:RETURN *PF1
  43. 520 '
  44. 530 *左押す ' *** ﾏｳｽ割込(ﾒﾆｭｰ) ***
  45. 540 MOUSE(2) OFF
  46. 550 IF PR=1 THEN MOUSE(2) ON:GOTO *OPE1
  47. 560 IF PR=2 THEN MOUSE(2) ON:GOTO *OPE2
  48. 570 IF PR=3 THEN MOUSE(2) ON:GOTO *OPE3
  49. 580 RUN
  50. 590 '
  51. 600 *PF1 ' *** 終了処理 ***
  52. 610 INTERVAL OFF:MOUSE 5:WIDTH 80,25:CONSOLE 0,25,0:END
  53. 620 '
  54. 630 *PF2 ' *** ＴＶ(ｽｰﾊﾟｰｲﾝﾎﾟｰｽﾞ) ***
  55. 640 IF S<>1 THEN RETURN
  56. 650 IF SW=0 THEN SW=1:SIMPOSE ON ELSE SW=0:SIMPOSE OFF
  57. 660 RETURN
  58. 670 '
  59. 680 *PF3 ' *** FRA32A.TIF/FRA16A.TIFで保存 ***
  60. 690 LOCATE 0,0
  61. 700 PRINT"ｸﾞﾗﾌｨｯｸ画面を書庫(FRAxxA.TIF)に保存? Y で実行します。　"
  62. 710 IK$=INKEY$:IF IK$="Y" THEN GOTO 730 ELSE IF IK$="" THEN GOTO 710
  63. 720 GOTO 770
  64. 730 IF S=1 THEN KILL "\FILE\FRA32A.TIF"
  65. 740 IF S=1 THEN SAVE@ "\FILE\FRA32A.TIF",(0,0)-(319,239)
  66. 750 IF S=2 THEN KILL "\FILE\FRA16A.TIF"
  67. 760 IF S=2 THEN SAVE@ "\FILE\FRA16A.TIF",(0,0)-(639,479)
  68. 770 LOCATE 0,0
  69. 780 PRINT"                                                     　"
  70. 790 RETURN
  71. 800 '
  72. 810 *PF4 ' *** ﾒﾆｭｰ表示 ***
  73. 820 SCREEN@ 1:S=1:WINDOW (0,0)-(319*S,239*S)
  74. 830 VIEW (0,0)-(319*S,239*S):COLOR 5,1,0,4:CLS:RUN
  75. 840 '
  76. 850 *PF5 ' *** LOAD ***
  77. 860 LOCATE 0,0
  78. 870 PRINT"ｸﾞﾗﾌｨｯｸ画面を書庫(FRAxxA.TIF)から読む? Y で実行します。"
  79. 880 IK$=INKEY$:IF IK$="Y" THEN GOTO 900 ELSE IF IK$="" THEN GOTO 880
  80. 890 GOTO 920
  81. 900 IF S=1 THEN LOAD@ "\FILE\FRA32A.TIF"
  82. 910 IF S=2 THEN LOAD@ "\FILE\FRA16A.TIF"
  83. 920 LOCATE 0,0
  84. 930 PRINT"                                                       "
  85. 940 RETURN
  86. 950 '
  87. 960 *PF6 ' *** 初期 ***
  88. 970 PXX=POS(0):PYY=CSRLIN
  89. 980 IF PR=1 THEN GOTO *OPE1
  90. 990 IF PR=2 THEN GOTO *OPE2
  91. 1000 LOCATE PXX,PYY:RETURN
  92. 1010 '
  93. 1020 *異常 ' 異常処理。
  94. 1030 OPEN"A",#1,"\FILE\ERROR.BAS"
  95. 1040 PRINT#1,ERL,"Error number=";ERR,"Error line=";ERL
  96. 1050 CLOSE#1
  97. 1060 BEEP:RESUME NEXT
  98. 1070 '
  99. 1080 *MENU
  100. 1090 LOCATE 0,0:PRINT:PRINT
  101. 1100 PRINT "◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆"
  102. 1110 PRINT "1: HENON-MIRA MAP"
  103. 1120 PRINT "2: JULIA SET OF f(z)=z^2+a"
  104. 1130 PRINT "3: HENON MAP"
  105. 1140 PRINT "4: CIRCLE MAP"
  106. 1150 PRINT "◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆"
  107. 1160 GOSUB *読む:KY=VAL(D$):IF KY<1 OR KY>4 THEN KY=0
  108. 1170 ON KY GOSUB *MIRA,*JULIA,*HENON1,*CIRCLE
  109. 1180 GOTO *MENU
  110. 1190 '
  111. 1200 *読む ' 文字読み
  112. 1210 MOUSE(2) OFF:MOUSE 1,100,100,1
  113. 1220 MO=MOUSE (2,0):IF MO<>0 GOTO 1210
  114. 1230 MOX=MOUSE (0):' X 座標
  115. 1240 MOY=MOUSE (1):' Y 座標
  116. 1250 D$=CHR$(SCREEN (MOX/(4*S),MOY/(9.5!*S)))
  117. 1260 LOCATE 0,0:PRINT"選択=>";D$;"  ﾏｳｽ左ｸﾘｯｸで選択。　　"
  118. 1270 MO=MOUSE (2,0):IF MO=0 GOTO 1230
  119. 1280 MO=MOUSE (2,0):IF MO<>0 GOTO 1280
  120. 1290 MOUSE 1,100,100,0::MOUSE(2) ON
  121. 1300 LOCATE 0,0:PRINT"                                   ";:RETURN
  122. 1310 '
  123. 1320 *MIRA
  124. 1330 '
  125. 1340 '  % % % % %   Henon-Mira map   % % % % %
  126. 1350 '
  127. 1360 WI=10:R=20:COL=2:PR=1:S=1
  128. 1370 X0=0:Y0=.4!:A=.97!:B=-.98!
  129. 1380 VIEW (40,0)-(319,239)
  130. 1390 WINDOW (-WI,-WI)-(WI,WI)
  131. 1400 DEF FNH(X)=-1+A*X+4*X*X/(1+X*X)
  132. 1410 GOSUB *OPE1:CLS:LINE (-WI,-WI)-(WI,WI),PASTEL,7,BF
  133. 1420 '
  134. 1430 WHILE 1
  135. 1440 X=Y0-FNH(X0):Y=B*X0
  136. 1450 PSET(X,-Y),COL:X0=X:Y0=Y
  137. 1460 IF ABS(X)+ABS(Y) > R THEN GOSUB *OVR
  138. 1470 WEND 
  139. 1480 '
  140. 1490 *OPE1
  141. 1500 CLS 4:COLOR 6:LOCATE 0,2
  142. 1510 PRINT"0:色COL=";COL;"+1"
  143. 1520 PRINT"1:定数A+=";A+.001!
  144. 1530 PRINT"2:定数A-=";A-.001!
  145. 1540 PRINT"A:定数A=";A
  146. 1550 PRINT"B:定数B=";B
  147. 1560 PRINT"C:画面消去"
  148. 1570 PRINT"E:ﾒﾆｭｰ表示"
  149. 1580 PRINT"R:発散値R=";R
  150. 1590 PRINT"W:窓WI=";WI
  151. 1600 PRINT"X:変数X=";X0
  152. 1610 PRINT"Y:変数Y=";Y0
  153. 1620 GOSUB *読む
  154. 1630 IF D$="0" THEN COL=COL+1:IF COL=8 THEN COL=1
  155. 1640 IF D$="1" THEN A=A+.001!
  156. 1650 IF D$="2" THEN A=A-.001!
  157. 1660 IF D$="A" THEN INPUT" A";A
  158. 1670 IF D$="B" THEN INPUT" B";B
  159. 1680 IF D$="C" THEN CLS 5:LINE (-WI,-WI)-(WI,WI),PASTEL,7,BF
  160. 1690 IF D$="E" THEN RUN
  161. 1700 IF D$="R" THEN INPUT" R";R
  162. 1710 IF D$="W" THEN INPUT" WI";WI:D$="":RETURN 1390
  163. 1720 IF D$="X" THEN INPUT" X0";X0
  164. 1730 IF D$="Y" THEN INPUT" Y0";Y0
  165. 1740 CLS 4
  166. 1750 RETURN 
  167. 1760 '
  168. 1770 *OVR:CLS 4:LOCATE 0,6:COLOR 2:PRINT" 発散！"
  169. 1780 PRINT" *** ﾏｳｽ左を押して下さい！***"
  170. 1790 A=-1.54!:B=-1:X0=0:Y0=.4!:COL=COL+1:COL=COL MOD 8:CLS 5
  171. 1800 WI=50:R=60
  172. 1810 RETURN 1390
  173. 1820 '
  174. 1830 *JULIA
  175. 1840 '
  176. 1850 '  % % % % %   julia set of f(z)=z^2+a    % % % % %
  177. 1860 '
  178. 1870 AR=-.74543!:AI=-.11301!:COL=2:PR=2:S=1
  179. 1880 RX=319:RY=239
  180. 1890 XS=-2:XE=2:YS=-1.4!:YE=1.4!
  181. 1900 XD=RX/(XE-XS):YD=RY/(YE-YS)
  182. 1910 ZX=.25!-AR:ZY=-AI
  183. 1920 R=.5!*(SQR(ZX*ZX+ZY*ZY)+ZX)
  184. 1930 ZY=SGN(ZY)*SQR(ABS(R-ZX)):ZX=SQR(ABS(R))
  185. 1940 ZX=ZX+.5!:GOSUB *OPE2
  186. 1950 LINE (0,0)-(319,239),PASTEL,7,BF
  187. 1960 '
  188. 1970 WHILE 1
  189. 1980 ZX=ZX-AR:ZY=ZY-AI
  190. 1990 R=.5!*(SQR(ZX*ZX+ZY*ZY)+ZX)
  191. 2000 ZY=SGN(ZY)*SQR(ABS(R-ZX)):ZX=SQR(ABS(R))
  192. 2010 IF RND>.5! THEN ZX=-ZX:ZY=-ZY
  193. 2020 PSET (INT((ZX-XS)*XD),INT((YE-ZY)*YD)),COL
  194. 2030 WEND
  195. 2040 '
  196. 2050 *OPE2
  197. 2060 CLS 4:COLOR 6:LOCATE 0,2
  198. 2070 PRINT"0:色COL=";COL;"+1"
  199. 2080 PRINT"1:定数AR=";AR
  200. 2090 PRINT"2:定数AI=";AI
  201. 2100 PRINT"C:画面消去"
  202. 2110 PRINT"E:ﾒﾆｭｰ表示"
  203. 2120 GOSUB *読む
  204. 2130 IF D$="0" THEN COL=COL+1:COL=COL MOD 8
  205. 2140 IF D$="1" THEN INPUT" AR";AR
  206. 2150 IF D$="2" THEN INPUT" AI";AI
  207. 2160 IF D$="C" THEN CLS 5:LINE (0,0)-(319,239),PASTEL,7,BF
  208. 2170 IF D$="E" THEN RUN
  209. 2180 CLS 4
  210. 2190 RETURN 
  211. 2200 '
  212. 2210 *HENON1
  213. 2220 SCREEN@ 0:COLOR 6,0,0,0:CLS:S=2
  214. 2230 WINDOW (0,0)-(639,479):VIEW (0,0)-(639,479)
  215. 2240 '
  216. 2250 '  % % % % %  HENON MAP  % % % % %
  217. 2260 '
  218. 2270 A=1.4!:B=.3!:XC=.83!:YC=.15!:VC=99.5!
  219. 2280 DIM C(3),D(3),W(3,3),V(3,3)
  220. 2290 D(0)=2.5!:D(1)=.4!:D(2)=.08!:D(3)=.0125!
  221. 2300 C(0)=XC:C(1)=YC:C(2)=XC:C(3)=YC
  222. 2310 FOR I=0 TO 3:FOR J=0 TO 3
  223. 2320 W(I,J)=C(J)+(2*INT(J/2)-1)*D(I)
  224. 2330 READ V(I,J)
  225. 2340 NEXT J:NEXT I
  226. 2350 '
  227. 2360 FOR I=0 TO 2
  228. 2370 WINDOW(W(I,0),W(I,1))-(W(I,2),W(I,3))
  229. 2380 VIEW(V(I,0),V(I,1))-(V(I,2),V(I,3))
  230. 2390 LINE(W(I,0),W(I,1))-(W(I,2),W(I,3)),PSET,1,B
  231. 2400 LINE(W(I+1,0),W(I+1,1))-(W(I+1,2),W(I+1,3)),PSET,1,BF
  232. 2410 NEXT I
  233. 2420 WINDOW(W(3,0),W(3,1))-(W(3,2),W(3,3))
  234. 2430 VIEW(V(3,0),V(3,1))-(V(3,2),V(3,3))
  235. 2440 LINE(W(3,0),W(3,1))-(W(3,2),W(3,3)),PSET,1,BF
  236. 2450 '
  237. 2460 X=1:Y=1
  238. 2470 FOR K=0 TO 20
  239. 2480 XX=1+Y-A*X*X:YY=B*X:X=XX:Y=YY
  240. 2490 NEXT K
  241. 2500 '
  242. 2510 *HENON
  243. 2520 XX=1+Y-A*X*X:YY=B*X
  244. 2530 FOR I=0 TO 3
  245. 2540 WINDOW(W(I,0),W(I,1))-(W(I,2),W(I,3))
  246. 2550 VIEW(V(I,0),V(I,1))-(V(I,2),V(I,3))
  247. 2560 PSET(XX,YY),2
  248. 2570 NEXT I
  249. 2580 X=XX:Y=YY:K=K+1
  250. 2590 GOTO *HENON
  251. 2600 DATA 0,0,199,199,200,0,399,199
  252. 2610 DATA 0,200,199,399,200,200,399,399
  253. 2620 '
  254. 2630 *CIRCLE
  255. 2640 '
  256. 2650 ' % % % % %  CIRCLE MAP % % % % %
  257. 2660 '
  258. 2670 R=3:TM=16:DD=2:PI=3.14159!:XO=0:S=1:PR=3:CLS
  259. 2680 XL=-.1!:XU=1.1!:YL=-.1!:YU=4.1!
  260. 2690 WINDOW (XL,YL)-(XU,YU)
  261. 2700 VIEW (40*S,10*S)-(309*S,229*S)
  262. 2710 LINE (XL,YL)-(XU,YU),PSET,0,BF
  263. 2720 DX=DD*(XU-XL)/(270*S):DY=DD*(YU-YL)/(220*S)
  264. 2730 '
  265. 2740 FOR I=XL TO XU STEP DX
  266. 2750 FOR J=YL TO YU STEP DY
  267. 2760 T=0:XO=0
  268. 2770 XN=XO+I-J*SIN(2*PI*XO)/2*PI
  269. 2780 XO=XN:IF XN>R GOTO 2800
  270. 2790 T=T+1:IF T<TM GOTO 2770
  271. 2800 PSET (I,J),T MOD 8
  272. 2810 NEXT J
  273. 2820 NEXT I:BEEP:GOTO 2740
  274. 2830 '
  275. 2840 *OPE3
  276. 2850 CLS 4:COLOR 6:LOCATE 0,2:PRINT"CIRCLE MAP"
  277. 2860 PRINT"I:横":PRINT I;"    "
  278. 2870 PRINT"J:縦":PRINT J;"    "
  279. 2880 PRINT"XN:状態":PRINT XN;"    "
  280. 2890 PRINT"R:境界";R
  281. 2900 PRINT"S:ﾓｰﾄﾞ";S
  282. 2910 PRINT"TM:繰返";TM
  283. 2920 PRINT"DD:密度";DD
  284. 2930 PRINT"C:画面消去"
  285. 2940 PRINT"E:ﾒﾆｭｰ表示"
  286. 2950 GOSUB *読む
  287. 2960 IF D$="S" THEN IF S=1 THEN S=2:SCREEN@ 0 ELSE S=1:SCREEN@ 1
  288. 2970 IF D$="S" THEN RETURN 2690
  289. 2980 IF D$="D" THEN IF DD=1 THEN DD=2 ELSE DD=1
  290. 2990 IF D$="D" THEN CLS 4:RETURN 2720
  291. 3000 IF D$="T" THEN INPUT" TM";TM
  292. 3010 IF D$="R" THEN INPUT" R";R
  293. 3020 IF D$="C" THEN CLS 5:LINE (XL,YL)-(XU,YU),PASTEL,7,BF
  294. 3030 IF D$="E" THEN RUN
  295. 3040 CLS 4
  296. 3050 RETURN 
  297.