home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
FM Towns: Free Software Collection 1
/
FREEWARE.BIN
/
basic
/
fractal
/
frademo6.bas
< prev
Wrap
BASIC Source File
|
1989-10-17
|
6KB
|
156 lines
100 '
110 ' F-BASIC386 SAMPLE PROGRAM % COPYRIGHT FUJITSU LIMITED 19890831
120 '
130 ' PUBLIC DOMAIN SOFTWARE by PRELUDE FMC(富士通マイコンクラブ)
140 '
150 ' ★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★
160 ' ★ ソフト名:フラクタル・デモ PART6 V1 ★
170 ' ★ 登録名 :FRADEMO6.BAS ★
180 ' ★ 登録者 :PRELUDE(佐々木裕一) ★
190 ' ★ 動作確認:FM-TOWNS F-BASIC386 ★
200 ' ★ 備考 :このプログラムはビデオカード対応です。 ★
210 ' ★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★
220 '
230 ' マウス割り込みルーチンの定義
240 CLEAR,,4096:MOUSE 0:MOUSE 4,0,0,319,239:MOUSE 1,,,0
250 ON MOUSE (5) GOSUB *マウス:MOUSE (5) OFF
260 ' 音楽設定
270 BGM 1:PART 0,0:PLAY "@3V15T280L4O5CDEFGABO6CCO5BAGFEDC"
280 ' Henon-Mira 関数の定義
290 DEF FNA(X)=-1+A*X+4*X*X/(1+X*X)
300 ' 3万2千色モード
310 SCREEN@ 1:COLOR 6,0,0,4
320 ' 宣伝表示
330 WINDOW (0,0)-(319,239)
340 VIEW (0,0)-(319,239)
350 CLS:LOCATE 0,10
360 PRINT"..... The VP series expands the range of supercomputing applications."
370 PRINT" "
380 PRINT" Supercomputers ・・・・"
390 SYMBOL (0,50),"VP2000",3,7,2,0,PSET,3,0
400 PRINT" "
410 PRINT" "
420 PRINT" "
430 PRINT" マウスの右ボタンを押して下さい。"
440 PRINT" "
450 PRINT" アーノルド拡散によるカオスを計算表示します。"
460 PRINT" "
470 PRINT" マウスの右ボタンを押すとメニューを表示します。"
480 MO=MOUSE (2,1):IF MO=0 GOTO 480 ELSE CLS:MOUSE 1,,,0
490 MOUSE (5) ON:COLOR 6,2,0,4:GOTO *STEP1
500 '
510 ' 終了をします。
520 *END
530 WINDOW (0,0)-(319,239)
540 VIEW (0,0)-(319,239)
550 MOUSE 5:END
560 '
570 ' フラクタル音楽をします。
580 *MUS
590 DS=T MOD 8
600 IF DS=0 THEN PLAY "C" ELSE IF DS=1 THEN PLAY "D"
610 IF DS=2 THEN PLAY "E" ELSE IF DS=3 THEN PLAY "F"
620 IF DS=4 THEN PLAY "G" ELSE IF DS=5 THEN PLAY "A"
630 IF DS=6 THEN PLAY "B" ELSE IF DS=7 THEN PLAY ">C<"
640 RETURN
650 '
660 ' 表示中の絵を録画します。
670 *VIDEO
680 SIMPOSE ON 0:MOUSE 1,,,0
690 MO=MOUSE (2,0):IF MO=0 GOTO 690 ELSE SIMPOSE OFF:RETURN
700 '
710 *STEP1:CLS
720 '
730 ' % % % % % Henon-Mira map % % % % %
740 '
750 ' パラメータ初期値
760 R=50:TM=80:DD=5:MD=0:AR=-1.54!:AI=-1:ZX0=.02!:ZY0=0
770 XL=-20:XU=20:YL=-20:YU=20
780 ' 枠作り
790 ' 複素数平面サイズ Xmin(XL),Ymin(YL),Xmax(XU),Ymax(YU)
800 WINDOW (XL,YL)-(XU,YU)
810 ' 表示画面サイズ Xmin(40),Ymin(10),Xmax(309),Ymax(229)
820 VIEW (40,10)-(309,229)
830 LINE (XL,YL)-(XU,YU),PSET,0,BF:GOSUB *JURES
840 DX=DD*(XU-XL)/270:DY=DD*(YU-YL)/220
850 '
860 FOR I=XL TO XU STEP DX
870 FOR J=YL TO YU STEP DY
880 T=0:IF MD=0 THEN A=I:B=J:X0=ZX0:Y0=ZY0 ELSE A=AR:B=AI:X0=I:Y0=J
890 X=Y0-FNA(X0):Y=B*X0
900 X0=X:Y0=Y:GOSUB *JULIA
910 IF ABS(X)+ABS(Y)>R GOTO 930
920 T=T+1:IF T<TM GOTO 890
930 PSET (I,J),T MOD 8:GOSUB *JURES:IF SW=0 ELSE GOSUB *MUS
940 NEXT J,I:GOTO 860
950 '
960 *マウス:' マウス割り込み処理
970 MOUSE 1,,,1:GOSUB *JURES
980 CLS 4:LOCATE 0,1
990 IF MD=0 THEN PRINT"1:初期値ZX=";ZX0 ELSE PRINT"1:実定数AR=";AR
1000 IF MD=0 THEN PRINT"2:初期値ZY=";ZY0 ELSE PRINT"2:虚定数AI=";AI
1010 PRINT"3:吸引境界値R=";R
1020 PRINT"4:繰返し数TM=";TM
1030 PRINT"C:画面消去"
1040 PRINT"D:密度DD=";DD
1050 PRINT"E:終了"
1060 PRINT"I:初期状態に戻す"
1070 IF MD=0 THEN PRINT"M:C平面" ELSE PRINT"M:Z平面"
1080 PRINT"R:メニュー消去"
1090 PRINT"V:録画:マウス左で戻る"
1100 PRINT"W:拡大(左上隅XL)";WINDOW(0)
1110 PRINT" (左上隅YL)";WINDOW(1)
1120 PRINT" (右下隅XU)";WINDOW(2)
1130 PRINT" (右下隅YU)";WINDOW(3)
1140 GOSUB *SER
1150 LOCATE 0,17
1160 IF D$="1:" THEN IF MD=0 THEN INPUT"実部初期値ZX";ZX0 ELSE INPUT"実定数AR";AR
1170 IF D$="2:" THEN IF MD=0 THEN INPUT"虚部初期値ZY";ZY0 ELSE INPUT"虚定数AI";AI
1180 IF D$="3:" THEN INPUT"吸引境界値R";R
1190 IF D$="4:" THEN INPUT"繰返し数TM";TM
1200 IF D$="C:" THEN CLS:MOUSE 1,,,0:RETURN 830
1210 IF D$="D:" THEN IF DD=1 THEN DD=5:MOUSE 1,,,0:CLS 4:RETURN 840 ELSE DD=1:MOUSE 1,,,0:CLS 4:RETURN 840
1220 IF D$="E:" THEN PRINT"終了? Y: ":GOSUB *SER:IF D$="Y:" GOTO *END
1230 IF D$="I:" THEN PRINT"初期値に戻します。Y: ":GOSUB *SER:IF D$="Y:" THEN MOUSE 1,,,0:CLS:RETURN *STEP1
1240 IF D$="M:" THEN IF MD=0 THEN MD=1:MOUSE 1,,,0:CLS 4:RETURN 860 ELSE MD=0:MOUSE 1,,,0:CLS 4:RETURN 860
1250 IF D$="R:" THEN CLS 4:MOUSE 1,,,0:RETURN
1260 IF D$="V:" THEN GOSUB *VIDEO:MOUSE 1,,,1
1270 IF D$="W:" THEN GOSUB *WIN:D$="":MOUSE 1,,,0:CLS 4:RETURN 800
1280 PRINT"左ボタンで、音を出すなら Y: を入れて下さい。":GOSUB *SER:IF D$="Y:" THEN SW=1 ELSE SW=0
1290 GOTO 980
1300 ' 文字読み込み
1310 *SER
1320 MO=MOUSE (2,0):IF MO<>0 GOTO 1320
1330 MOX=MOUSE (0):' X 座標
1340 MOY=MOUSE (1):' Y 座標
1350 D$=CHR$(SCREEN (MOX/4,MOY/10))+CHR$(SCREEN (1+MOX/4,MOY/10))
1360 LOCATE 0,16:PRINT"選択=>";D$;" 良ければマウスの左ボタンを押して下さい。 "
1370 MO=MOUSE (2,0):IF MO=0 GOTO 1330
1380 MO=MOUSE (2,0):IF MO<>0 GOTO 1380
1390 RETURN
1400 ' 図形拡大
1410 *WIN
1420 LOCATE 0,17:PRINT"左上の座標を選択し、マウスの左ボタンを押して下さい。"
1430 GOSUB *SER:XLL=MOX:YLL=MOY
1440 LOCATE 0,17:PRINT"右下の座標を選択し、マウスの左ボタンを押して下さい。"
1450 GOSUB *SER:XUU=MOX:YUU=MOY
1460 DX=(XU-XL)/270:DY=(YU-YL)/220
1470 XLLL=XL+DX*(XLL-40)
1480 YLLL=YL+DY*(YLL-10)
1490 XUUU=XL+DX*(XUU-40)
1500 YUUU=YL+DY*(YUU-10)
1510 XL=XLLL:YL=YLLL:XU=XUUU:YU=YUUU
1520 RETURN
1530 ' Julia set
1540 *JULIA
1550 WINDOW (-30,-30)-(30,30):VIEW (0,190)-(39,229)
1560 PSET (X,Y),T MOD 8
1570 WINDOW (XL,YL)-(XU,YU):VIEW (40,10)-(309,229)
1580 RETURN
1590 ' Julia reset
1600 *JURES
1610 WINDOW (-30,-30)-(30,30):VIEW (0,190)-(39,229)
1620 LINE (-30,-30)-(30,30),PSET,7,BF
1630 WINDOW (XL,YL)-(XU,YU):VIEW (40,10)-(309,229)
1640 RETURN