home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 1 / FREEWARE.BIN / basic / fractal / frademo2.bas < prev    next >
BASIC Source File  |  1989-10-17  |  5KB  |  167 lines
  1. 100 '
  2. 110 ' F-BASIC386 SAMPLE PROGRAM % COPYRIGHT FUJITSU LIMITED 19890911
  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 VIEW (0,0)-(319,239)
  15. 240 WINDOW (0,0)-(319,239)
  16. 250 SCREEN@ 1:SIMPOSE OFF
  17. 260 COLOR 6,0,0,4:CLS
  18. 270 '
  19. 280 PRINT"　１：Ｈｅｎｏｎ－Ｍｉｒａ　ｍａｐ"
  20. 290 PRINT"　２：Ｊｕｌｉａ　ｓｅｔ　ｏｆ　ｆ（ｚ）＝ｚ＾２＋ａ"
  21. 300 PRINT"　３：Ｈｅｎｏｎ　ｍａｐ"
  22. 310 PRINT"　４：終了します｡"
  23. 320 INPUT"　選択=> ";KY:ON KY GOSUB 380,940,1330,330:GOTO 230
  24. 330 *END
  25. 340 VIEW (0,0)-(319,239)
  26. 350 WINDOW (0,0)-(319,239)
  27. 360 END
  28. 370 '
  29. 380 *MIRA:CLS
  30. 390 '
  31. 400 '  % % % % %   Henon-Mira map   % % % % %
  32. 410 '
  33. 420 WI=35:R=56:COL=2
  34. 430 X0=0:Y0=.4!:A=-1.54!:B=-1
  35. 440 VIEW (40,0)-(319,239)
  36. 450 WINDOW (-WI,-WI)-(WI,WI)
  37. 460 ' LINE (-WI,-WI)-(WI,WI),PSET,7,B
  38. 470 DEF FNH(X)=-1+A*X+4*X*X/(1+X*X)
  39. 480 GOSUB *OPE
  40. 490 '
  41. 500 WHILE 1
  42. 510 X=Y0-FNH(X0):Y=B*X0
  43. 520 PSET(X,-Y),COL:X0=X:Y0=Y
  44. 530 IF ABS(X)+ABS(Y) > R THEN GOSUB *OVR
  45. 540 D$=INKEY$:IF D$<>"" THEN GOSUB *OPE
  46. 550 WEND 
  47. 560 '
  48. 570 *OPE
  49. 580 IF D$="0" THEN COL=COL+1:IF COL=8 THEN COL=1
  50. 590 IF D$="1" THEN A=A+.001!
  51. 600 IF D$="2" THEN A=A-.001!
  52. 610 IF D$="A" THEN INPUT" A";A
  53. 620 IF D$="B" THEN INPUT" B";B
  54. 630 IF D$="X" THEN INPUT" X0";X0
  55. 640 IF D$="Y" THEN INPUT" Y0";Y0
  56. 650 IF D$="C" THEN CLS 5 'LINE (-WI,-WI)-(WI,WI),PSET,7,B
  57. 660 IF D$="E" THEN RUN 230
  58. 670 IF D$="R" THEN INPUT" R";R
  59. 680 IF D$="V" THEN GOSUB *VIDEO
  60. 690 IF D$="W" THEN INPUT" WI";WI:D$="":RETURN 450
  61. 700 CLS 4:COLOR 6:LOCATE 0,1
  62. 710 PRINT" 0:色COL=";COL;"+1"
  63. 720 PRINT" 1:定数A+=";A+.001!
  64. 730 PRINT" 2:定数A-=";A-.001!
  65. 740 PRINT" A:定数A=";A
  66. 750 PRINT" B:定数B=";B
  67. 760 PRINT" X:変数X=";X0
  68. 770 PRINT" Y:変数Y=";Y0
  69. 780 PRINT" C:画面消去"
  70. 790 PRINT" E:終了"
  71. 800 PRINT" R:発散値R=";R
  72. 810 PRINT" V:録画:空白で戻る"
  73. 820 PRINT" W:窓WI=";WI
  74. 830 RETURN 
  75. 840 '
  76. 850 *OVR:CLS 4:LOCATE 0,6:COLOR 2:PRINT" 発散！"
  77. 860 PRINT" 空白キーを押して下さい！"
  78. 870 A=-1.54!:B=-1:X0=0:Y0=.4!:COL=COL+1:COL=COL MOD 8:CLS 5
  79. 880 RETURN 
  80. 890 '
  81. 900 *VIDEO
  82. 910 SIMPOSE ON 0
  83. 920 D$=INKEY$:IF D$="" GOTO 920 ELSE SIMPOSE OFF:RETURN
  84. 930 '
  85. 940 *JULIA:CLS
  86. 950 '
  87. 960 '  % % % % %   julia set of f(z)=z^2+a    % % % % %
  88. 970 '
  89. 980 AR=-.74543!:AI=-.11301!:COL=2
  90. 990 RX=319:RY=239
  91. 1000 XS=-2:XE=2:YS=-1.4!:YE=1.4!
  92. 1010 XD=RX/(XE-XS):YD=RY/(YE-YS)
  93. 1020 ZX=.25!-AR:ZY=-AI
  94. 1030 R=.5!*(SQR(ZX*ZX+ZY*ZY)+ZX)
  95. 1040 ZY=SGN(ZY)*SQR(ABS(R-ZX)):ZX=SQR(ABS(R))
  96. 1050 ZX=ZX+.5!:GOSUB *OPE2
  97. 1060 ' LINE (0,0)-(319,239),PSET,7,B
  98. 1070 '
  99. 1080 WHILE 1
  100. 1090 ZX=ZX-AR:ZY=ZY-AI
  101. 1100 R=.5!*(SQR(ZX*ZX+ZY*ZY)+ZX)
  102. 1110 ZY=SGN(ZY)*SQR(ABS(R-ZX)):ZX=SQR(ABS(R))
  103. 1120 IF RND>.5! THEN ZX=-ZX:ZY=-ZY
  104. 1130 PSET (INT((ZX-XS)*XD),INT((YE-ZY)*YD)),COL
  105. 1140 D$=INKEY$:IF D$<>"" THEN GOSUB *OPE2
  106. 1150 WEND
  107. 1160 '
  108. 1170 *OPE2
  109. 1180 IF D$="0" THEN COL=COL+1:COL=COL MOD 8
  110. 1190 IF D$="1" THEN INPUT" AR";AR
  111. 1200 IF D$="2" THEN INPUT" AI";AI
  112. 1210 IF D$="C" THEN CLS 5 ' LINE (0,0)-(319,239),PSET,7,B
  113. 1220 IF D$="E" THEN RUN 220
  114. 1230 IF D$="V" THEN GOSUB *VIDEO
  115. 1240 CLS 4:COLOR 6:LOCATE 0,1
  116. 1250 PRINT" 0:色COL=";COL;"+1"
  117. 1260 PRINT" 1:定数AR=";AR
  118. 1270 PRINT" 2:定数AI=";AI
  119. 1280 PRINT" C:画面消去"
  120. 1290 PRINT" E:終了"
  121. 1300 PRINT" V:録画:空白で戻る"
  122. 1310 RETURN 
  123. 1320 '
  124. 1330 *HENON1
  125. 1340 SCREEN@ 0:COLOR 6,0,0,0:CLS
  126. 1350 LOCATE 1,22:PRINT" E:終了"
  127. 1360 WINDOW (0,0)-(639,479):VIEW (0,0)-(639,479)
  128. 1370 '
  129. 1380 '  % % % % %  HENON MAP  % % % % %
  130. 1390 '
  131. 1400 A=1.4!:B=.3!:XC=.83!:YC=.15!:VC=99.5!
  132. 1410 DIM C(3),D(3),W(3,3),V(3,3)
  133. 1420 D(0)=2.5!:D(1)=.4!:D(2)=.08!:D(3)=.0125!
  134. 1430 C(0)=XC:C(1)=YC:C(2)=XC:C(3)=YC
  135. 1440 FOR I=0 TO 3:FOR J=0 TO 3
  136. 1450 W(I,J)=C(J)+(2*INT(J/2)-1)*D(I)
  137. 1460 READ V(I,J)
  138. 1470 NEXT J:NEXT I
  139. 1480 '
  140. 1490 FOR I=0 TO 2
  141. 1500 WINDOW(W(I,0),W(I,1))-(W(I,2),W(I,3))
  142. 1510 VIEW(V(I,0),V(I,1))-(V(I,2),V(I,3))
  143. 1520 LINE(W(I,0),W(I,1))-(W(I,2),W(I,3)),PSET,1,B
  144. 1530 LINE(W(I+1,0),W(I+1,1))-(W(I+1,2),W(I+1,3)),PSET,1,BF
  145. 1540 NEXT I
  146. 1550 WINDOW(W(3,0),W(3,1))-(W(3,2),W(3,3))
  147. 1560 VIEW(V(3,0),V(3,1))-(V(3,2),V(3,3))
  148. 1570 LINE(W(3,0),W(3,1))-(W(3,2),W(3,3)),PSET,1,BF
  149. 1580 '
  150. 1590 X=1:Y=1
  151. 1600 FOR K=0 TO 20
  152. 1610 XX=1+Y-A*X*X:YY=B*X:X=XX:Y=YY
  153. 1620 NEXT K
  154. 1630 '
  155. 1640 *HENON
  156. 1650 XX=1+Y-A*X*X:YY=B*X
  157. 1660 FOR I=0 TO 3
  158. 1670 WINDOW(W(I,0),W(I,1))-(W(I,2),W(I,3))
  159. 1680 VIEW(V(I,0),V(I,1))-(V(I,2),V(I,3))
  160. 1690 PSET(XX,YY),2:D$=INKEY$:IF D$="E" THEN RETURN
  161. 1700 NEXT I
  162. 1710 X=XX:Y=YY:K=K+1
  163. 1720 GOTO *HENON
  164. 1730 DATA 0,0,199,199,200,0,399,199
  165. 1740 DATA 0,200,199,399,200,200,399,399
  166. 1750 '
  167.