home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 1 / FREEWARE.BIN / basic / fractal / frademo4.bas < prev    next >
BASIC Source File  |  1989-10-17  |  6KB  |  159 lines
  1. 100 '
  2. 110 ' F-BASIC386 SAMPLE PROGRAM % COPYRIGHT FUJITSU LIMITED 19890822
  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,,2048: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 SCREEN@ 1:COLOR 6,0,0,4:CLS
  21. 300 ' 宣伝表示
  22. 310 LOCATE 0,10
  23. 320 WINDOW (0,0)-(319,239)
  24. 330 VIEW (0,0)-(319,239)
  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 *STEP1
  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 PSET (I,J),T MOD 8
  54. 630 RETURN
  55. 640 '
  56. 650 ' 表示中の絵を録画します。
  57. 660 *VIDEO
  58. 670 SIMPOSE ON 0:MOUSE 1,,,0
  59. 680 MO=MOUSE (2,0):IF MO=0 GOTO 680 ELSE SIMPOSE OFF:RETURN
  60. 690 '
  61. 700 *STEP1:CLS
  62. 710 '
  63. 720 ' % % % % %  Julia set of f(z)=a*z*(1-z)   % % % % %
  64. 730 '
  65. 740 ' パラメータ初期値
  66. 750 AR=3.2!:AI=0:R=5:TM=32:DD=5
  67. 760 XL=-.4!:XU=1.4!:YL=-.6!:YU=.6!
  68. 770 ' 枠作り
  69. 780 ' 複素数平面サイズ Xmin(XL),Ymin(YL),Xmax(XU),Ymax(YU)
  70. 790 WINDOW (XL,YL)-(XU,YU)
  71. 800 ' 表示画面サイズ Xmin(40),Ymin(10),Xmax(309),Ymax(229)
  72. 810 VIEW (40,10)-(309,229)
  73. 820 LINE (XL,YL)-(XU,YU),PSET,0,BF
  74. 830 DX=DD*(XU-XL)/270:DY=DD*(YU-YL)/220
  75. 840 '
  76. 850 FOR I=XL TO XU STEP DX
  77. 860 FOR J=YL TO YU STEP DY
  78. 870 ZX=I:ZY=J:T=0
  79. 880 ZX2=ZX^2:ZY2=ZY^2
  80. 890 ZXN=ZX-ZX2+ZY2:ZYN=ZY-2*ZX*ZY
  81. 900 ZX=AR*ZXN-AI*ZYN:ZY=AR*ZYN+AI*ZXN
  82. 910 ZX2=ZX^2:ZY2=ZY^2:IF SW=0 ELSE GOSUB *JULIA
  83. 920 IF ZX2+ZY2>R GOTO 940
  84. 930 T=T+1:IF T<TM GOTO 890
  85. 940 IF SW=0 THEN PSET (I,J),T MOD 8 ELSE GOSUB *MUS:GOSUB *JURES
  86. 950 NEXT J,I:GOTO 850
  87. 960 '
  88. 970 *マウス:' マウス割り込み処理
  89. 980 MOUSE 1,,,1:GOSUB *JURES
  90. 990 CLS 4:LOCATE 0,1
  91. 1000 PRINT"1:実定数AR=";AR
  92. 1010 PRINT"2:虚定数AI=";AI
  93. 1020 PRINT"3:吸引境界値R=";R
  94. 1030 PRINT"4:繰返し数TM=";TM
  95. 1040 PRINT"C:画面消去"
  96. 1050 PRINT"D:密度DD=";DD
  97. 1060 PRINT"E:終了"
  98. 1070 PRINT"I:初期状態に戻す"
  99. 1080 PRINT"R:メニュー消去"
  100. 1090 PRINT"V:録画:マウス左で戻る"
  101. 1100 PRINT"W:拡大(左上隅XL)";WINDOW(0)
  102. 1110 PRINT"      (左上隅YL)";WINDOW(1)
  103. 1120 PRINT"      (右下隅XU)";WINDOW(2)
  104. 1130 PRINT"      (右下隅YU)";WINDOW(3)
  105. 1140 GOSUB *SER
  106. 1150 LOCATE 0,16
  107. 1160 IF D$="1:" THEN INPUT"実定数AR";AR
  108. 1170 IF D$="2:" THEN INPUT"虚定数AI";AI
  109. 1180 IF D$="3:" THEN INPUT"吸引境界値R";R
  110. 1190 IF D$="4:" THEN INPUT"繰返し数TM";TM
  111. 1200 IF D$="C:" THEN CLS:MOUSE 1,,,0:RETURN 820
  112. 1210 IF D$="D:" THEN IF DD=1 THEN DD=5:MOUSE 1,,,0:CLS 4:RETURN 830 ELSE DD=1:MOUSE 1,,,0:CLS 4:RETURN 830
  113. 1220 IF D$="E:" THEN PRINT"終了？ Y: ":GOSUB *SER:IF D$="Y:" GOTO *END
  114. 1230 IF D$="I:" THEN PRINT"初期値に戻します。Y: ":GOSUB *SER:IF D$="Y:" THEN MOUSE 1,,,0:CLS:RETURN *STEP1
  115. 1240 IF D$="R:" THEN CLS 4:MOUSE 1,,,0:RETURN 850
  116. 1250 IF D$="V:" THEN GOSUB *VIDEO:MOUSE 1,,,1
  117. 1260 IF D$="W:" THEN GOSUB *WIN:MOUSE 1,,,0:CLS 4:RETURN 790
  118. 1270 PRINT"左ボタンで、音を出すなら Y: を入れて下さい。":GOSUB *SER:IF D$="Y:" THEN SW=1 ELSE SW=0
  119. 1280 GOTO 990
  120. 1290 ' 文字読み込み
  121. 1300 *SER
  122. 1310 MO=MOUSE (2,0):IF MO<>0 GOTO 1310
  123. 1320 MOX=MOUSE (0):' X 座標
  124. 1330 MOY=MOUSE (1):' Y 座標
  125. 1340 D$=CHR$(SCREEN (MOX/4,MOY/10))+CHR$(SCREEN (1+MOX/4,MOY/10))
  126. 1350 LOCATE 0,15:PRINT"選択=>";D$;MOX;MOY;" 良ければマウスの左ボタンを押して下さい。　"
  127. 1360 MO=MOUSE (2,0):IF MO=0 GOTO 1320
  128. 1370 MO=MOUSE (2,0):IF MO<>0 GOTO 1370
  129. 1380 RETURN
  130. 1390 ' 図形拡大
  131. 1400 *WIN
  132. 1410 LOCATE 0,16:PRINT"左上の座標を選択し､マウスの左ボタンを押して下さい。"
  133. 1420 GOSUB *SER:XLL=MOX:YLL=MOY
  134. 1430 LOCATE 0,16:PRINT"右下の座標を選択し､マウスの左ボタンを押して下さい。"
  135. 1440 GOSUB *SER:XUU=MOX:YUU=MOY
  136. 1450 DX=(XU-XL)/270:DY=(YU-YL)/220
  137. 1460 XLLL=XL+DX*(XLL-40)
  138. 1470 YLLL=YL+DY*(YLL-10)
  139. 1480 XUUU=XL+DX*(XUU-40)
  140. 1490 YUUU=YL+DY*(YUU-10)
  141. 1500 XL=XLLL:YL=YLLL:XU=XUUU:YU=YUUU
  142. 1510 RETURN
  143. 1520 ' Julia set
  144. 1530 *JULIA
  145. 1540 WINDOW (-5,-5)-(5,5)
  146. 1550 VIEW (0,190)-(39,229)
  147. 1560 PSET (ZX,ZY),T MOD 8
  148. 1570 WINDOW (XL,YL)-(XU,YU)
  149. 1580 VIEW (40,10)-(309,229)
  150. 1590 RETURN
  151. 1600 ' Julia reset
  152. 1610 *JURES
  153. 1620 WINDOW (-5,-5)-(5,5)
  154. 1630 VIEW (0,190)-(39,229)
  155. 1640 LINE (-5,-5)-(5,5),PSET,7,BF
  156. 1650 WINDOW (XL,YL)-(XU,YU)
  157. 1660 VIEW (40,10)-(309,229)
  158. 1670 RETURN
  159.