home *** CD-ROM | disk | FTP | other *** search
/ FreeWare Collection 2 / FreeSoftwareCollection2pd199x-jp.img / fbasic / prelude / pds0a / fractal / frademo5.bas < prev    next >
Encoding:
BASIC Source File  |  1990-06-14  |  8.3 KB  |  242 lines
  1. 100 ' F-BASIC386 SAMPLE PROGRAM % COPYRIGHT FUJITSU LIMITED 19900502
  2. 110 ' PUBLIC DOMAIN SOFTWARE by PRELUDE FMC(Fujitsuﾏｲｺﾝｸﾗﾌﾞ)
  3. 120 ' ★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★
  4. 130 ' ★　ソフト名：ﾌﾗｸﾀﾙ･ﾃﾞﾓ PART5 V10                             ★
  5. 140 ' ★　登録名　：FRADEMO05.BAS                                   ★
  6. 150 ' ★　登録者　：PRELUDE(Yuuichi Sasaki)         　　　　　      ★
  7. 160 ' ★  動作確認：FM-TOWNS 2 F-BASIC386 V1.1L20           　　　  ★
  8. 170 ' ★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★
  9. 180 ' マウス割り込みルーチンの定義
  10. 190 CLEAR,,4096:MOUSE 0:MOUSE 4,0,0,319,239:MOUSE 1,,,0
  11. 200 ON MOUSE (5) GOSUB *マウス:MOUSE (5) OFF
  12. 210 ' タイマ割り込みルーチンの定義
  13. 220 INTERVAL 2:ON INTERVAL GOSUB *時計:INTERVAL OFF
  14. 230 ' 異常時処理定義
  15. 240 ON ERROR GOTO *異常
  16. 250 ' 音楽設定
  17. 260 BGM 1:PLAY "%C@63T280V15"
  18. 270 ' 32K色ﾓｰﾄﾞ
  19. 280 SC=1:S=1:SW=0:SCREEN@ 1
  20. 290 WINDOW (0,0)-(319,239)
  21. 300 VIEW (0,0)-(319,239)
  22. 310 '
  23. 320 INTERVAL ON:COLOR 6,0,0,4:CLS
  24. 330 P=3.14159!/180:A=89:B=91:WINDOW (-1.6!,-1.2!)-(1.59!,1.19!)
  25. 340 X=SIN(P*T*A):Y=COS(P*T*B):LINE(X,Y)-(X,Y),PSET,0
  26. 350 T=T+1:IF T>360 THEN T=1
  27. 360 X=SIN(P*T*A):Y=COS(P*T*B):IF T=1 THEN LINE-(X,Y),PSET,0
  28. 370 LINE-(X,Y),PASTEL,GCOL
  29. 380 MO=MOUSE (2,1):IF MO=0 GOTO 350 ELSE CLS:MOUSE 1,,,0
  30. 390 COLOR 6,3,0,4:INTERVAL OFF:GOTO *MAIN5
  31. 400 '
  32. 410 *時計 ' タイマ割込み処理
  33. 420 INTERVAL OFF
  34. 430 COLOR COL:IF COL=2 THEN COL=10 ELSE COL=2
  35. 440 GCOL=GCOL+1:IF GCOL=8 THEN GOSUB *消去:GCOL=0:A=A+1:B=B+1
  36. 450 LOCATE 1,1:PRINT "Pattern=";A
  37. 460 LOCATE 15,12
  38. 470 PRINT"マンデルブロ集合 ｆ(ｚ)＝ｚ^2+ｃを計算表示します。"
  39. 480 LOCATE 15,14
  40. 490 PRINT"マウスの右ボタンを押すとメニューを表示します。"
  41. 500 INTERVAL ON
  42. 510 RETURN
  43. 520 '
  44. 530 *消去
  45. 540 FOR T=1 TO 360
  46. 550 X=SIN(P*T*A):Y=COS(P*T*B):LINE-(X,Y),PSET,0
  47. 560 NEXT:CLS 5
  48. 570 RETURN
  49. 580 '
  50. 590 *END ' 終了します。
  51. 600 GOSUB *座標:X=MOX/(4*S):Y=MOY/(10*S)
  52. 610 LOCATE X,Y:PRINT"Y: 終了？！？"
  53. 620 GOSUB *座標:IF D$<>"Y:" GOTO 1500
  54. 630 WINDOW (0,0)-(319,239)
  55. 640 VIEW (0,0)-(319,239)
  56. 650 MOUSE 5:CLS 4:END
  57. 660 '
  58. 670 *音楽 ' フラクタル音楽のつもり。
  59. 680 IF SEL=0 THEN SEL=1 ELSE IF SEL=1 THEN SEL=2 ELSE SEL=0
  60. 690 ON SEL GOTO 710,720
  61. 700 PLAY "%L":GOTO 730
  62. 710 PLAY "%C":GOTO 730
  63. 720 PLAY "%R":GOTO 730
  64. 730 DS=T MOD 8:ON DS GOTO 750,760,770,780,790,800,810
  65. 740 PLAY "C":RETURN
  66. 750 PLAY "D":RETURN
  67. 760 PLAY "E":RETURN
  68. 770 PLAY "F":RETURN
  69. 780 PLAY "G":RETURN
  70. 790 PLAY "A":RETURN
  71. 800 PLAY "B":RETURN
  72. 810 PLAY ">C<":RETURN
  73. 820 '
  74. 830 *VIDEO ' 表示中の絵を録画します。
  75. 840 IF SC=0 THEN RETURN ELSE SIMPOSE ON 0:MOUSE 1,,,0
  76. 850 MO=MOUSE (2,0):IF MO=0 GOTO 850 ELSE SIMPOSE OFF:RETURN
  77. 860 '
  78. 870 *MAIN5:CLS
  79. 880 '
  80. 890 ' % % % % %  Mandelbrot set of f(z)=z^2+c  % % % % %
  81. 900 '
  82. 910 ' パラメータ初期値
  83. 920 R=5:TM=16:ZX0=0:ZY0=0:DD=5:MD=0:AR=-.74543!:AI=.11301!
  84. 930 XL=-2.2!:XU=1.6!:YL=-1.4!:YU=1.4!:MOUSE (5) ON
  85. 940 ' 枠作り
  86. 950 ' 複素数平面サイズ Xmin(XL),Ymin(YL),Xmax(XU),Ymax(YU)
  87. 960 WINDOW (XL,YL)-(XU,YU)
  88. 970 ' 表示画面サイズ Xmin(40),Ymin(10),Xmax(309),Ymax(229)
  89. 980 VIEW (40*S,10*S)-(309*S,229*S)
  90. 990 LINE (XL,YL)-(XU,YU),PSET,0,BF:GOSUB *白窓
  91. 1000 DX=DD*(XU-XL)/(270*S):DY=DD*(YU-YL)/(220*S)
  92. 1010 '
  93. 1020 FOR I=XL TO XU STEP DX
  94. 1030 FOR J=YL TO YU STEP DY
  95. 1040 T=0:ZX=ZX0:ZY=ZY0:A=I:B=J
  96. 1050 ON MD GOSUB *設定
  97. 1060 ZX2=ZX*ZX:ZY2=ZY*ZY
  98. 1070 ZXN=ZX2-ZY2+A:ZYN=2*ZX*ZY+B
  99. 1080 ZX=ZXN:ZY=ZYN
  100. 1090 ZX2=ZX*ZX:ZY2=ZY*ZY:GOSUB *窓
  101. 1100 IF ZX2+ZY2>R GOTO 1120
  102. 1110 T=T+1:IF T<TM GOTO 1070
  103. 1120 PSET (I,J),T MOD 8:GOSUB *白窓:ON SW GOSUB *音楽
  104. 1130 NEXT J
  105. 1140 NEXT I:GOTO 1020
  106. 1150 '
  107. 1160 *設定
  108. 1170 ZX=I:ZY=J:A=AR:B=AI:RETURN
  109. 1180 '
  110. 1190 *マウス ' マウス割り込み処理
  111. 1200 MOUSE 1,,,1:GOSUB *白窓
  112. 1210 CLS 4:LOCATE 0,1
  113. 1220 IF MD=0 THEN PRINT"1:初期値ZX=";ZX0 ELSE PRINT"1:実定数AR=";AR
  114. 1230 IF MD=0 THEN PRINT"2:初期値ZY=";ZY0 ELSE PRINT"2:虚定数AI=";AI
  115. 1240 PRINT"3:吸引境界値R=";R
  116. 1250 PRINT"4:繰返し数TM=";TM
  117. 1260 PRINT"C:画面消去"
  118. 1270 PRINT"D:密度DD=";DD
  119. 1280 PRINT"E:終了"
  120. 1290 PRINT"I:初期状態に戻す"
  121. 1300 IF MD=0 THEN PRINT"M:Ｃ平面" ELSE PRINT"M:Ｚ平面"
  122. 1310 PRINT"N:音楽";SW
  123. 1320 PRINT"R:メニュー消去"
  124. 1330 PRINT"S:画面モード";SC
  125. 1340 PRINT"T:.TIF保存"
  126. 1350 PRINT"V:録画:左ボタンで戻る"
  127. 1360 PRINT"W:拡大↓"
  128. 1370 PRINT"左上XL";WINDOW(0)
  129. 1380 PRINT"左上YL";WINDOW(1)
  130. 1390 PRINT"右下XU";WINDOW(2)
  131. 1400 PRINT"右下YU";WINDOW(3)
  132. 1410 GOSUB *座標
  133. 1420 LOCATE 30,0
  134. 1430 IF D$="1:" THEN IF MD=0 THEN INPUT"実部初期値ZX";ZX0 ELSE INPUT"実定数AR";AR
  135. 1440 IF D$="2:" THEN IF MD=0 THEN INPUT"虚部初期値ZY";ZY0 ELSE INPUT"虚定数AI";AI
  136. 1450 IF D$="3:" THEN INPUT"吸引境界値R";R
  137. 1460 IF D$="4:" THEN INPUT"繰返し数TM";TM
  138. 1470 IF D$="C:" THEN MOUSE 1,,,0:LINE (XL,YL)-(XU,YU),PSET,0,BF:CLS 4:RETURN
  139. 1480 IF D$="D:" THEN IF DD=1 THEN DD=5:MOUSE 1,,,0:CLS 4:RETURN 1000 ELSE DD=1:MOUSE 1,,,0:CLS 4:RETURN 1000
  140. 1490 IF D$="E:" GOTO *END
  141. 1500 IF D$="I:" GOTO *初期化
  142. 1510 IF D$="M:" THEN IF MD=0 THEN MD=1:MOUSE 1,,,0:CLS 4:RETURN 1020 ELSE MD=0:MOUSE 1,,,0:CLS 4:RETURN 1020
  143. 1520 IF D$="N:" THEN IF SW=0 THEN SW=1 ELSE SW=0
  144. 1530 IF D$="R:" THEN CLS 4:MOUSE 1,,,0:RETURN
  145. 1540 IF D$="S:" THEN CLS 4:MOUSE 1,,,0:IF SC=0 THEN SC=1:S=1:SCREEN@ 1:RETURN 940 ELSE SC=0:S=2:SCREEN@ 0:RETURN 940
  146. 1550 IF D$="T:" THEN GOSUB *保存
  147. 1560 IF D$="V:" THEN GOSUB *VIDEO:MOUSE 1,,,1
  148. 1570 IF D$="W:" THEN GOSUB *窓変更:D$="":MOUSE 1,,,0:CLS 4:RETURN 960
  149. 1580 GOTO 1210
  150. 1590 '
  151. 1600 *初期化
  152. 1610 GOSUB *座標:X=MOX/(4*S):Y=MOY/(10*S)
  153. 1620 LOCATE X,Y:PRINT"Y:初期化。H:高速表示。L:ロード。":GOSUB *座標
  154. 1630 IF D$="H:" AND MD=0 THEN MOUSE 1,,,0:CLS 4:RETURN *高速
  155. 1640 IF D$="L:" THEN GOSUB *書庫:MOUSE 1,,,0:CLS 4:RETURN *高速
  156. 1650 IF D$="Y:" THEN MOUSE 1,,,0:CLS:RETURN *MAIN5 ELSE GOTO 1510
  157. 1660 '
  158. 1670 *書庫 ' 保存値設定
  159. 1680 ON SC GOTO 1710
  160. 1690 OPEN"I",#1,"\FILE\FR16.DOC"
  161. 1700 LOAD@ "\FILE\FRA16.TIF":GOTO 1730
  162. 1710 OPEN"I",#1,"\FILE\FR32.DOC"
  163. 1720 LOAD@ "\FILE\FRA32.TIF"
  164. 1730 INPUT#1,R,TM,ZX0,ZY0,DD,MD,AR,AI,XL,XU,YL,YU
  165. 1740 CLOSE#1:RETURN
  166. 1750 '
  167. 1760 *座標 ' 文字読み込み
  168. 1770 MO=MOUSE (2,0):IF MO<>0 GOTO 1770
  169. 1780 IF SC=1 THEN S=1 ELSE S=2
  170. 1790 MOX=MOUSE (0):' X 座標
  171. 1800 MOY=MOUSE (1):' Y 座標
  172. 1810 D$=CHR$(SCREEN (MOX/(4*S),MOY/(10*S)))
  173. 1820 D$=D$+CHR$(SCREEN (1+MOX/(4*S),MOY/(10*S)))
  174. 1830 LOCATE 0,0:PRINT"選択=>";D$;" 左ボタンを押す。　"
  175. 1840 MO=MOUSE (2,0):IF MO=0 GOTO 1790
  176. 1850 MO=MOUSE (2,0):IF MO<>0 GOTO 1850
  177. 1860 RETURN
  178. 1870 '
  179. 1880 *窓変更 ' 図形拡大
  180. 1890 CLS 4
  181. 1900 LOCATE 30,0:PRINT"左上の座標で左ボタンを押す。"
  182. 1910 GOSUB *座標:XLL=MOX:YLL=MOY
  183. 1920 LOCATE 30,0:PRINT"右下の座標で左ボタンを押す。"
  184. 1930 GOSUB *座標:XUU=MOX:YUU=MOY
  185. 1940 DX=(XU-XL)/(270*S):DY=(YU-YL)/(220*S)
  186. 1950 XLLL=XL+DX*(XLL-40*S)
  187. 1960 YLLL=YL+DY*(YLL-10*S)
  188. 1970 XUUU=XL+DX*(XUU-40*S)
  189. 1980 YUUU=YL+DY*(YUU-10*S)
  190. 1990 XL=XLLL:YL=YLLL:XU=XUUU:YU=YUUU
  191. 2000 RETURN
  192. 2010 '
  193. 2020 *窓 ' Attractors set
  194. 2030 WINDOW (-5,-5)-(5,5):VIEW (0,190*S)-(39*S,229*S)
  195. 2040 PSET (ZX,ZY),7
  196. 2050 WINDOW (XL,YL)-(XU,YU):VIEW (40*S,10*S)-(309*S,229*S)
  197. 2060 RETURN
  198. 2070 '
  199. 2080 *白窓 ' reset
  200. 2090 WINDOW (-5,-5)-(5,5):VIEW (0,190*S)-(39*S,229*S)
  201. 2100 LINE (-5,-5)-(5,5),PSET,1,BF
  202. 2110 WINDOW (XL,YL)-(XU,YU):VIEW (40*S,10*S)-(309*S,229*S)
  203. 2120 RETURN
  204. 2130 '
  205. 2140 *保存 ' .TIF形式で保存。
  206. 2150 ON SC GOTO 2200
  207. 2160 KILL "\FILE\FRA16.TIF":KILL "\FILE\FR16.BAS":KILL "\FILE\FR16.DOC"
  208. 2170 SAVE@ "\FILE\FRA16.TIF",(0,0)-(639,479)
  209. 2180 OPEN"A",#1,"\FILE\FR16.BAS":OPEN"A",#2,"\FILE\FR16.DOC"
  210. 2190 GOTO 2230
  211. 2200 KILL "\FILE\FRA32.TIF":KILL "\FILE\FR32.BAS":KILL "\FILE\FR32.DOC"
  212. 2210 SAVE@ "\FILE\FRA32.TIF",(0,0)-(319,239)
  213. 2220 OPEN"A",#1,"\FILE\FR32.BAS":OPEN"A",#2,"\FILE\FR32.DOC"
  214. 2230 PRINT#1,10;"R";R;"TM";TM;"ZX0";ZX0;"ZY0";ZY0;
  215. 2240 PRINT#1,"DD";DD;"MD";MD;"AR";AR;"AI";AI
  216. 2250 PRINT#1,20;"XL";XL;"XU";XU;"YL";YL;"YU";YU
  217. 2260 WRITE#2,R;TM;ZX0;ZY0;DD;MD;AR;AI;XL;XU;YL;YU
  218. 2270 CLOSE#1,#2
  219. 2280 RETURN
  220. 2290 '
  221. 2300 *異常 ' 異常処理。
  222. 2310 OPEN"A",#1,"\FILE\ERROR.BAS"
  223. 2320 PRINT#1,ERL,"Error number=";ERR,"Error line=";ERL
  224. 2330 CLOSE#1
  225. 2340 RESUME NEXT
  226. 2350 '
  227. 2360 *高速 ' 高速 Mandelbrot set of f(z)=z^2+c
  228. 2370 WINDOW (XL,YL)-(XU,YU):VIEW (40*S,10*S)-(309*S,229*S)
  229. 2380 DX=DD*(XU-XL)/(270*S):DY=DD*(YU-YL)/(220*S)
  230. 2390 FOR I=XL TO XU STEP DX
  231. 2400 FOR J=YL TO YU STEP DY
  232. 2410 T=0:ZX=ZX0:ZY=ZY0
  233. 2420 ZX2=ZX*ZX:ZY2=ZY*ZY
  234. 2430 ZXN=ZX2-ZY2+I:ZYN=2*ZX*ZY+J
  235. 2440 ZX=ZXN:ZY=ZYN
  236. 2450 ZX2=ZX*ZX:ZY2=ZY*ZY
  237. 2460 IF ZX2+ZY2>R GOTO 2480
  238. 2470 T=T+1:IF T<TM GOTO 2430
  239. 2480 PSET (I,J),T MOD 8
  240. 2490 NEXT J
  241. 2500 NEXT I:GOTO 2390
  242.