home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
FreeWare Collection 2
/
FreeSoftwareCollection2pd199x-jp.img
/
fbasic
/
prelude
/
pds0a
/
fractal
/
frademo4.bas
< prev
next >
Wrap
BASIC Source File
|
1990-06-14
|
9KB
|
242 lines
100 ' F-BASIC386 SAMPLE PROGRAM % COPYRIGHT FUJITSU LIMITED 19900429
110 ' PUBLIC DOMAIN SOFTWARE by PRELUDE FMC(Fujitsuマイコンクラブ)
120 ' ★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★
130 ' ★ ソフト名:フラクタル・デモ PART4 V5 ★
140 ' ★ 登録名 :FRADEMO04.BAS ★
150 ' ★ 登録者 :PRELUDE(Yuuichi Sasaki) ★
160 ' ★ 動作確認:FM-TOWNS 2 F-BASIC386 V1.1L20 ★
170 ' ★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★
180 ' マウス割り込みルーチンの定義
190 CLEAR,,4096:MOUSE 0:MOUSE 4,0,0,319,239:MOUSE 1,,,0
200 ON MOUSE (5) GOSUB *マウス:MOUSE (5) OFF
210 ' タイマ割り込みルーチンの定義
220 INTERVAL 2:ON INTERVAL GOSUB *時計:INTERVAL OFF
230 ' 異常時処理定義
240 ON ERROR GOTO *異常
250 ' 音楽設定
260 BGM 1:PLAY "%C@63T280V15"
270 ' 32K色モード
280 SC=1:S=1:SW=0:SCREEN@ 1
290 WINDOW (0,0)-(319,239)
300 VIEW (0,0)-(319,239)
310 '
320 INTERVAL ON:COLOR 6,0,0,4:CLS
330 P=3.14159!/180:A=89:B=91:WINDOW (-1.6!,-1.2!)-(1.59!,1.19!)
340 X=SIN(P*T*A):Y=COS(P*T*B):LINE(X,Y)-(X,Y),PSET,0
350 T=T+1:IF T>360 THEN T=1
360 X=SIN(P*T*A):Y=COS(P*T*B):IF T=1 THEN LINE-(X,Y),PSET,0
370 LINE-(X,Y),PASTEL,GCOL
380 MO=MOUSE (2,1):IF MO=0 GOTO 350 ELSE CLS:MOUSE 1,,,0
390 COLOR 6,3,0,4:INTERVAL OFF:GOTO *MAIN5
400 '
410 *時計 ' タイマ割込み処理
420 INTERVAL OFF
430 COLOR COL:IF COL=2 THEN COL=10 ELSE COL=2
440 GCOL=GCOL+1:IF GCOL=8 THEN GOSUB *消去:GCOL=0:A=A+1:B=B+1
450 LOCATE 1,1:PRINT "Pattern=";A
460 LOCATE 15,12
470 PRINT"ジュリア集合 f(z)=a*z*(1-z)を計算表示します。"
480 LOCATE 15,14
490 PRINT"マウスの右ボタンを押すとメニューを表示します。"
500 INTERVAL ON
510 RETURN
520 '
530 *消去
540 FOR T=1 TO 360
550 X=SIN(P*T*A):Y=COS(P*T*B):LINE-(X,Y),PSET,0
560 NEXT:CLS 5
570 RETURN
580 '
590 *END ' 終了します。
600 GOSUB *座標:X=MOX/(4*S):Y=MOY/(10*S)
610 LOCATE X,Y:PRINT"Y: 終了?!?"
620 GOSUB *座標:IF D$<>"Y:" GOTO 1500
630 WINDOW (0,0)-(319,239)
640 VIEW (0,0)-(319,239)
650 MOUSE 5:CLS 4:END
660 '
670 *音楽 ' フラクタル音楽のつもり。
680 IF SEL=0 THEN SEL=1 ELSE IF SEL=1 THEN SEL=2 ELSE SEL=0
690 ON SEL GOTO 710,720
700 PLAY "%L":GOTO 730
710 PLAY "%C":GOTO 730
720 PLAY "%R":GOTO 730
730 DS=T MOD 8:ON DS GOTO 750,760,770,780,790,800,810
740 PLAY "C":RETURN
750 PLAY "D":RETURN
760 PLAY "E":RETURN
770 PLAY "F":RETURN
780 PLAY "G":RETURN
790 PLAY "A":RETURN
800 PLAY "B":RETURN
810 PLAY ">C<":RETURN
820 '
830 *VIDEO ' 表示中の絵を録画します。
840 IF SC=0 THEN RETURN ELSE SIMPOSE ON 0:MOUSE 1,,,0
850 MO=MOUSE (2,0):IF MO=0 GOTO 850 ELSE SIMPOSE OFF:RETURN
860 '
870 *MAIN5:CLS
880 '
890 ' % % % % % Julia set of f(z)=a*z*(1-z) % % % % %
900 '
910 ' パラメータ初期値
920 R=5:TM=64:ZX0=1.8!:ZY0=0:DD=5:MD=1:AR=3:AI=.22!
930 XL=-.5!:XU=1.4!:YL=-.7!:YU=.7!:MOUSE (5) ON
940 ' 枠作り
950 ' 複素数平面サイズ Xmin(XL),Ymin(YL),Xmax(XU),Ymax(YU)
960 WINDOW (XL,YL)-(XU,YU)
970 ' 表示画面サイズ Xmin(40),Ymin(10),Xmax(309),Ymax(229)
980 VIEW (40*S,10*S)-(309*S,229*S)
990 LINE (XL,YL)-(XU,YU),PSET,0,BF:GOSUB *白窓
1000 DX=DD*(XU-XL)/(270*S):DY=DD*(YU-YL)/(220*S)
1010 '
1020 FOR I=XL TO XU STEP DX
1030 FOR J=YL TO YU STEP DY
1040 T=0:ZX=I:ZY=J:A=AR:B=AI
1050 IF MD=0 THEN GOSUB *設定
1060 ZX2=ZX*ZX:ZY2=ZY*ZY
1070 ZXN=ZX-ZX2+ZY2:ZYN=ZY-2*ZX*ZY
1080 ZX=A*ZXN-B*ZYN:ZY=A*ZYN+B*ZXN
1090 ZX2=ZX*ZX:ZY2=ZY*ZY:GOSUB *窓
1100 IF ZX2+ZY2>R GOTO 1120
1110 T=T+1:IF T<TM GOTO 1070
1120 PSET (I,J),T MOD 8:GOSUB *白窓:ON SW GOSUB *音楽
1130 NEXT J
1140 NEXT I:GOTO 1020
1150 '
1160 *設定
1170 ZX=ZX0:ZY=ZY0:A=I:B=J:RETURN
1180 '
1190 *マウス ' マウス割り込み処理
1200 MOUSE 1,,,1:GOSUB *白窓
1210 CLS 4:LOCATE 0,1
1220 IF MD=0 THEN PRINT"1:初期値ZX=";ZX0 ELSE PRINT"1:実定数AR=";AR
1230 IF MD=0 THEN PRINT"2:初期値ZY=";ZY0 ELSE PRINT"2:虚定数AI=";AI
1240 PRINT"3:吸引境界値R=";R
1250 PRINT"4:繰返し数TM=";TM
1260 PRINT"C:画面消去"
1270 PRINT"D:密度DD=";DD
1280 PRINT"E:終了"
1290 PRINT"I:初期状態に戻す"
1300 IF MD=0 THEN PRINT"M:C平面" ELSE PRINT"M:Z平面"
1310 PRINT"N:音楽";SW
1320 PRINT"R:メニュー消去"
1330 PRINT"S:画面モード";SC
1340 PRINT"T:.TIF保存"
1350 PRINT"V:録画:左ボタンで戻る"
1360 PRINT"W:拡大↓"
1370 PRINT"左上XL";WINDOW(0)
1380 PRINT"左上YL";WINDOW(1)
1390 PRINT"右下XU";WINDOW(2)
1400 PRINT"右下YU";WINDOW(3)
1410 GOSUB *座標
1420 LOCATE 30,0
1430 IF D$="1:" THEN IF MD=0 THEN INPUT"実部初期値ZX";ZX0 ELSE INPUT"実定数AR";AR
1440 IF D$="2:" THEN IF MD=0 THEN INPUT"虚部初期値ZY";ZY0 ELSE INPUT"虚定数AI";AI
1450 IF D$="3:" THEN INPUT"吸引境界値R";R
1460 IF D$="4:" THEN INPUT"繰返し数TM";TM
1470 IF D$="C:" THEN MOUSE 1,,,0:LINE (XL,YL)-(XU,YU),PSET,0,BF:CLS 4:RETURN
1480 IF D$="D:" THEN IF DD=1 THEN DD=5:MOUSE 1,,,0:CLS 4:RETURN 1000 ELSE DD=1:MOUSE 1,,,0:CLS 4:RETURN 1000
1490 IF D$="E:" GOTO *END
1500 IF D$="I:" GOTO *初期化
1510 IF D$="M:" THEN IF MD=0 THEN MD=1:MOUSE 1,,,0:CLS 4:RETURN 1020 ELSE MD=0:MOUSE 1,,,0:CLS 4:RETURN 1020
1520 IF D$="N:" THEN IF SW=0 THEN SW=1 ELSE SW=0
1530 IF D$="R:" THEN CLS 4:MOUSE 1,,,0:RETURN
1540 IF D$="S:" THEN CLS 4:MOUSE 1,,,0:IF SC=0 THEN SC=1:S=1:SCREEN@ 1:RETURN 940 ELSE SC=0:S=2:SCREEN@ 0:RETURN 940
1550 IF D$="T:" THEN GOSUB *保存
1560 IF D$="V:" THEN GOSUB *VIDEO:MOUSE 1,,,1
1570 IF D$="W:" THEN GOSUB *窓変更:D$="":MOUSE 1,,,0:CLS 4:RETURN 960
1580 GOTO 1210
1590 '
1600 *初期化
1610 GOSUB *座標:X=MOX/(4*S):Y=MOY/(10*S)
1620 LOCATE X,Y:PRINT"Y:初期化。H:高速表示。L:ロード。":GOSUB *座標
1630 IF D$="H:" AND MD=1 THEN MOUSE 1,,,0:CLS 4:RETURN *高速
1640 IF D$="L:" THEN GOSUB *書庫:MOUSE 1,,,0:CLS 4:RETURN *高速
1650 IF D$="Y:" THEN MOUSE 1,,,0:CLS:RETURN *MAIN5 ELSE GOTO 1510
1660 '
1670 *書庫 ' 保存値設定
1680 ON SC GOTO 1710
1690 OPEN"I",#1,"\FILE\FR16.DOC"
1700 LOAD@ "\FILE\FRA16.TIF":GOTO 1730
1710 OPEN"I",#1,"\FILE\FR32.DOC"
1720 LOAD@ "\FILE\FRA32.TIF"
1730 INPUT#1,R,TM,ZX0,ZY0,DD,MD,AR,AI,XL,XU,YL,YU
1740 CLOSE#1:RETURN
1750 '
1760 *座標 ' 文字読み込み
1770 MO=MOUSE (2,0):IF MO<>0 GOTO 1770
1780 IF SC=1 THEN S=1 ELSE S=2
1790 MOX=MOUSE (0):' X 座標
1800 MOY=MOUSE (1):' Y 座標
1810 D$=CHR$(SCREEN (MOX/(4*S),MOY/(10*S)))
1820 D$=D$+CHR$(SCREEN (1+MOX/(4*S),MOY/(10*S)))
1830 LOCATE 0,0:PRINT"選択=>";D$;" 左ボタンを押す。 "
1840 MO=MOUSE (2,0):IF MO=0 GOTO 1790
1850 MO=MOUSE (2,0):IF MO<>0 GOTO 1850
1860 RETURN
1870 '
1880 *窓変更 ' 図形拡大
1890 CLS 4
1900 LOCATE 30,0:PRINT"左上の座標で左ボタンを押す。"
1910 GOSUB *座標:XLL=MOX:YLL=MOY
1920 LOCATE 30,0:PRINT"右下の座標で左ボタンを押す。"
1930 GOSUB *座標:XUU=MOX:YUU=MOY
1940 DX=(XU-XL)/(270*S):DY=(YU-YL)/(220*S)
1950 XLLL=XL+DX*(XLL-40*S)
1960 YLLL=YL+DY*(YLL-10*S)
1970 XUUU=XL+DX*(XUU-40*S)
1980 YUUU=YL+DY*(YUU-10*S)
1990 XL=XLLL:YL=YLLL:XU=XUUU:YU=YUUU
2000 RETURN
2010 '
2020 *窓 ' Attractors set
2030 WINDOW (-5,-5)-(5,5):VIEW (0,190*S)-(39*S,229*S)
2040 PSET (ZX,ZY),7
2050 WINDOW (XL,YL)-(XU,YU):VIEW (40*S,10*S)-(309*S,229*S)
2060 RETURN
2070 '
2080 *白窓 ' reset
2090 WINDOW (-5,-5)-(5,5):VIEW (0,190*S)-(39*S,229*S)
2100 LINE (-5,-5)-(5,5),PSET,1,BF
2110 WINDOW (XL,YL)-(XU,YU):VIEW (40*S,10*S)-(309*S,229*S)
2120 RETURN
2130 '
2140 *保存 ' .TIF形式で保存。
2150 ON SC GOTO 2200
2160 KILL "\FILE\FRA16.TIF":KILL "\FILE\FR16.BAS":KILL "\FILE\FR16.DOC"
2170 SAVE@ "\FILE\FRA16.TIF",(0,0)-(639,479)
2180 OPEN"A",#1,"\FILE\FR16.BAS":OPEN"A",#2,"\FILE\FR16.DOC"
2190 GOTO 2230
2200 KILL "\FILE\FRA32.TIF":KILL "\FILE\FR32.BAS":KILL "\FILE\FR32.DOC"
2210 SAVE@ "\FILE\FRA32.TIF",(0,0)-(319,239)
2220 OPEN"A",#1,"\FILE\FR32.BAS":OPEN"A",#2,"\FILE\FR32.DOC"
2230 PRINT#1,10;"R";R;"TM";TM;"ZX0";ZX0;"ZY0";ZY0;
2240 PRINT#1,"DD";DD;"MD";MD;"AR";AR;"AI";AI
2250 PRINT#1,20;"XL";XL;"XU";XU;"YL";YL;"YU";YU
2260 WRITE#2,R;TM;ZX0;ZY0;DD;MD;AR;AI;XL;XU;YL;YU
2270 CLOSE#1,#2
2280 RETURN
2290 '
2300 *異常 ' 異常処理。
2310 OPEN"A",#1,"\FILE\ERROR.BAS"
2320 PRINT#1,ERL,"Error number=";ERR,"Error line=";ERL
2330 CLOSE#1
2340 RESUME NEXT
2350 '
2360 *高速 ' 高速 Julia set of f(z)=a*z*(1-z)
2370 WINDOW (XL,YL)-(XU,YU):VIEW (40*S,10*S)-(309*S,229*S)
2380 DX=DD*(XU-XL)/(270*S):DY=DD*(YU-YL)/(220*S)
2390 FOR I=XL TO XU STEP DX
2400 FOR J=YL TO YU STEP DY
2410 T=0:ZX=I:ZY=J:A=AR:B=AI
2420 ZX2=ZX*ZX:ZY2=ZY*ZY
2430 ZXN=ZX-ZX2+ZY2:ZYN=ZY-2*ZX*ZY
2440 ZX=A*ZXN-B*ZYN:ZY=A*ZYN+B*ZXN
2450 ZX2=ZX*ZX:ZY2=ZY*ZY
2460 IF ZX2+ZY2>R GOTO 2480
2470 T=T+1:IF T<TM GOTO 2430
2480 PSET (I,J),T MOD 8
2490 NEXT J
2500 NEXT I:GOTO 2390