home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 1 / FREEWARE.BIN / basic / fractal / frademo5.bas < prev    next >
BASIC Source File  |  1989-10-17  |  6KB  |  159 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 ' マウス割り込みルーチンの定義
  15. 240 CLEAR,,4096:MOUSE 0:MOUSE 4,0,0,319,239:MOUSE 1,,,0
  16. 250 ON MOUSE (5) GOSUB *マウス:MOUSE (5) OFF
  17. 260 ' 音楽設定
  18. 270 BGM 1:PART 0,0:PLAY "@3V15T280L4O5CDEFGABO6CCO5BAGFEDC"
  19. 280 ' ３万２千色モード
  20. 290 SC=1:S=1:SW=0:SCREEN@ 1:COLOR 6,0,0,4
  21. 300 ' 宣伝表示
  22. 310 WINDOW (0,0)-(319,239)
  23. 320 VIEW (0,0)-(319,239)
  24. 330 CLS:LOCATE 0,10
  25. 340 PRINT"..... The VP series expands the range of supercomputing applications." 
  26. 350 PRINT" "
  27. 360 PRINT"    　Ｓｕｐｅｒｃｏｍｐｕｔｅｒｓ　・・・・"
  28. 370 SYMBOL (0,50),"ＶＰ２０００",3,7,2,0,PSET,3,0
  29. 380 PRINT" "
  30. 390 PRINT" "
  31. 400 PRINT" "
  32. 410 PRINT"      マウスの右ボタンを押して下さい。"
  33. 420 PRINT" "
  34. 430 PRINT"    マンデルブロート集合ｆ（ｚ）＝ｚ＾２＋ｃを計算表示します。"
  35. 440 PRINT" "
  36. 450 PRINT"      マウスの右ボタンを押すとメニューを表示します。"
  37. 460 MO=MOUSE (2,1):IF MO=0 GOTO 460 ELSE CLS:MOUSE 1,,,0
  38. 470 MOUSE (5) ON:COLOR 6,2,0,4:GOTO *PROC1
  39. 480 '
  40. 490 ' 終了をします。
  41. 500 *END
  42. 510 WINDOW (0,0)-(319,239)
  43. 520 VIEW (0,0)-(319,239)
  44. 530 MOUSE 5:END
  45. 540 '
  46. 550 ' フラクタル音楽をします。
  47. 560 *MUS
  48. 570 DS=T MOD 8
  49. 580 IF DS=0 THEN PLAY "C" ELSE IF DS=1 THEN PLAY "D"
  50. 590 IF DS=2 THEN PLAY "E" ELSE IF DS=3 THEN PLAY "F"
  51. 600 IF DS=4 THEN PLAY "G" ELSE IF DS=5 THEN PLAY "A"
  52. 610 IF DS=6 THEN PLAY "B" ELSE IF DS=7 THEN PLAY ">C<"
  53. 620 RETURN
  54. 630 '
  55. 640 ' 表示中の絵を録画します。
  56. 650 *VIDEO
  57. 660 IF SC=0 THEN RETURN ELSE SIMPOSE ON 0:MOUSE 1,,,0
  58. 670 MO=MOUSE (2,0):IF MO=0 GOTO 670 ELSE SIMPOSE OFF:RETURN
  59. 680 '
  60. 690 *PROC1:CLS
  61. 700 '
  62. 710 ' % % % % %  Mandelbrot set of f(z)=z^2+c  % % % % %
  63. 720 '
  64. 730 ' パラメータ初期値
  65. 740 R=5:TM=16:ZX0=0:ZY0=0:DD=5:MD=0:AR=-.74543!:AI=.11301!
  66. 750 XL=-2.2!:XU=1.6!:YL=-1.4!:YU=1.4!
  67. 760 ' 枠作り
  68. 770 ' 複素数平面サイズ Xmin(XL),Ymin(YL),Xmax(XU),Ymax(YU)
  69. 780 WINDOW (XL,YL)-(XU,YU)
  70. 790 ' 表示画面サイズ Xmin(40),Ymin(10),Xmax(309),Ymax(229)
  71. 800 VIEW (40*S,10*S)-(309*S,229*S)
  72. 810 LINE (XL,YL)-(XU,YU),PSET,0,BF:GOSUB *JURES
  73. 820 DX=DD*(XU-XL)/(270*S):DY=DD*(YU-YL)/(220*S)
  74. 830 '
  75. 840 FOR I=XL TO XU STEP DX
  76. 850 FOR J=YL TO YU STEP DY
  77. 860 T=0:IF MD=0 THEN ZX=ZX0:ZY=ZY0:A=I:B=J ELSE ZX=I:ZY=J:A=AR:B=AI
  78. 870 ZX2=ZX*ZX:ZY2=ZY*ZY
  79. 880 ZXN=ZX2-ZY2+A:ZYN=2*ZX*ZY+B
  80. 890 ZX=ZXN:ZY=ZYN
  81. 900 ZX2=ZX*ZX:ZY2=ZY*ZY:GOSUB *JULIA
  82. 910 IF ZX2+ZY2>R GOTO 930
  83. 920 T=T+1:IF T<TM GOTO 880
  84. 930 PSET (I,J),T MOD 8:GOSUB *JURES:IF SW=1 THEN GOSUB *MUS
  85. 940 NEXT J,I:GOTO 840
  86. 950 '
  87. 960 *マウス:' マウス割り込み処理
  88. 970 MOUSE 1,,,1:GOSUB *JURES
  89. 980 CLS 4:LOCATE 0,1
  90. 990 IF MD=0 THEN PRINT"1:初期値ZX=";ZX0 ELSE PRINT"1:実定数AR=";AR
  91. 1000 IF MD=0 THEN PRINT"2:初期値ZY=";ZY0 ELSE PRINT"2:虚定数AI=";AI
  92. 1010 PRINT"3:吸引境界値R=";R
  93. 1020 PRINT"4:繰返し数TM=";TM
  94. 1030 PRINT"C:画面消去"
  95. 1040 PRINT"D:密度DD=";DD
  96. 1050 PRINT"E:終了"
  97. 1060 PRINT"I:初期状態に戻す"
  98. 1070 IF MD=0 THEN PRINT"M:Ｃ平面" ELSE PRINT"M:Ｚ平面"
  99. 1080 PRINT"R:メニュー消去"
  100. 1090 PRINT"S:画面モード";SC
  101. 1100 PRINT"V:録画:マウス左で戻る"
  102. 1110 PRINT"W:拡大(左上隅XL)";WINDOW(0)
  103. 1120 PRINT"      (左上隅YL)";WINDOW(1)
  104. 1130 PRINT"      (右下隅XU)";WINDOW(2)
  105. 1140 PRINT"      (右下隅YU)";WINDOW(3)
  106. 1150 GOSUB *SER
  107. 1160 LOCATE 0,18
  108. 1170 IF D$="1:" THEN IF MD=0 THEN INPUT"実部初期値ZX";ZX0 ELSE INPUT"実定数AR";AR
  109. 1180 IF D$="2:" THEN IF MD=0 THEN INPUT"虚部初期値ZY";ZY0 ELSE INPUT"虚定数AI";AI
  110. 1190 IF D$="3:" THEN INPUT"吸引境界値R";R
  111. 1200 IF D$="4:" THEN INPUT"繰返し数TM";TM
  112. 1210 IF D$="C:" THEN CLS:MOUSE 1,,,0:RETURN 810
  113. 1220 IF D$="D:" THEN IF DD=1 THEN DD=5:MOUSE 1,,,0:CLS 4:RETURN 820 ELSE DD=1:MOUSE 1,,,0:CLS 4:RETURN 820
  114. 1230 IF D$="E:" THEN PRINT"終了？ Y: ":GOSUB *SER:IF D$="Y:" GOTO *END
  115. 1240 IF D$="I:" THEN PRINT"初期値に戻します。Y: ":GOSUB *SER:IF D$="Y:" THEN MOUSE 1,,,0:CLS:RETURN *PROC1
  116. 1250 IF D$="M:" THEN IF MD=0 THEN MD=1:MOUSE 1,,,0:CLS 4:RETURN 840 ELSE MD=0:MOUSE 1,,,0:CLS 4:RETURN 840
  117. 1260 IF D$="R:" THEN CLS 4:MOUSE 1,,,0:RETURN
  118. 1270 IF D$="S:" THEN MOUSE 1,,,0:IF SC=0 THEN SC=1:S=1:SCREEN@ 1:RETURN ELSE SC=0:S=2:SCREEN@ 0:RETURN
  119. 1280 IF D$="V:" THEN GOSUB *VIDEO:MOUSE 1,,,1
  120. 1290 IF D$="W:" THEN GOSUB *WIN:D$="":MOUSE 1,,,0:CLS 4:RETURN 780
  121. 1300 PRINT"左ボタンで､音を出すなら Y: を入れて下さい。":GOSUB *SER:IF D$="Y:" THEN SW=1 ELSE SW=0
  122. 1310 GOTO 980
  123. 1320 ' 文字読み込み
  124. 1330 *SER
  125. 1340 MO=MOUSE (2,0):IF MO<>0 GOTO 1340
  126. 1350 IF SC=1 THEN S=1 ELSE S=2
  127. 1360 MOX=MOUSE (0):' X 座標
  128. 1370 MOY=MOUSE (1):' Y 座標
  129. 1380 D$=CHR$(SCREEN (MOX/(4*S),MOY/(10*S)))+CHR$(SCREEN (1+MOX/(4*S),MOY/(10*S)))
  130. 1390 LOCATE 0,17:PRINT"選択=>";D$;" 良ければマウスの左ボタンを押して下さい。　"
  131. 1400 MO=MOUSE (2,0):IF MO=0 GOTO 1360
  132. 1410 MO=MOUSE (2,0):IF MO<>0 GOTO 1410
  133. 1420 RETURN
  134. 1430 ' 図形拡大
  135. 1440 *WIN
  136. 1450 LOCATE 0,18:PRINT"左上の座標を選択し､マウスの左ボタンを押して下さい。"
  137. 1460 GOSUB *SER:XLL=MOX:YLL=MOY
  138. 1470 LOCATE 0,17:PRINT"右下の座標を選択し､マウスの左ボタンを押して下さい。"
  139. 1480 GOSUB *SER:XUU=MOX:YUU=MOY
  140. 1490 DX=(XU-XL)/(270*S):DY=(YU-YL)/(220*S)
  141. 1500 XLLL=XL+DX*(XLL-40*S)
  142. 1510 YLLL=YL+DY*(YLL-10*S)
  143. 1520 XUUU=XL+DX*(XUU-40*S)
  144. 1530 YUUU=YL+DY*(YUU-10*S)
  145. 1540 XL=XLLL:YL=YLLL:XU=XUUU:YU=YUUU
  146. 1550 RETURN
  147. 1560 ' Attractors set
  148. 1570 *JULIA
  149. 1580 WINDOW (-5,-5)-(5,5):VIEW (0,190*S)-(39*S,229*S)
  150. 1590 PSET (ZX,ZY),7
  151. 1600 WINDOW (XL,YL)-(XU,YU):VIEW (40*S,10*S)-(309*S,229*S)
  152. 1610 RETURN
  153. 1620 ' reset
  154. 1630 *JURES
  155. 1640 WINDOW (-5,-5)-(5,5):VIEW (0,190*S)-(39*S,229*S)
  156. 1650 LINE (-5,-5)-(5,5),PSET,1,BF
  157. 1660 WINDOW (XL,YL)-(XU,YU):VIEW (40*S,10*S)-(309*S,229*S)
  158. 1670 RETURN
  159.