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