BASICで日食(修正版)
2020/6/21(日) 本日部分日食ということで、
VL-BASICのレイトレーシングで
日食を再現してみました。
(以前のプログラムはVL-BASICのMODを整数専用に
修正したことで誤動作します)
地球に見立てた球と同じ位置に、
大気に見立てた同じテクスチャの
少し大きめの半透明な球を表示して、
太陽に見立てた光源の光の拡散光を
表示させて見ました。
観測者は赤道上で真上を見上げ
ています。
(地球に背を向けている)
画面の上が地球の北極側
画面の下が地球の南極側
画面の右が地球の西側
画面の左が地球の東側
です。
(普段、地図などを見るときは
地球に向かって見ているので
東と西が上記の逆になります。)
走らせると、
右(西)側から日食が始まります。
(zキーを2回押して拡大した位が
良いかと思います。)
実際の日食と逆ですが、
このプログラムでは、観測者は
地球と一緒に自転しておらず
空中で静止していますので
このように見えます。
地球と一緒に自転させるのが
面倒だったからです。
実際は月の公転より、地球の
自転のほうが角速度(回転速度)
が速いので、左(東)側から
日食が始まります。
北半球では前が南。後が北
南半球では前が北、後が南
で観測することになると
思いますが、どちらも
東から欠けていき、左右で
言うと逆になると思います。
大気の外側から見ると、
月の陰が薄いところが部分日食、
陰の中心付近の濃いところが
皆既日食になります。
陰の中心付近が通らない地域
では皆既日食を見ることが
できません。
金環日食では陰の中心付近は
皆既日食に比べて薄くなると
思います。たぶん。
カーソルキーとスペースキー
で移動すると、地球上だけでなく
宇宙から日食を見ることが
できます。
操作方法はプログラムの最後の行に
書いてあります。
下記ホームページからVL-BASICと同包のb/g5.bas
をダウンロードできます。
VL-BASIC(N88-BASIC互換?)ホームページへのリンク
Readme.txtを読んで、遊んで見て下さい。
下記リストをマウスで選択しCtrl+cでコピーし、
VL-BASICの画面でAlt+v(Ctrl+vではないので注意)
でプログラムを読込めます。
g5.bas
1000 '----------------------------------------------------------------------
1010 ' BASICで日食 sample program No.5 by ULproject for VL-BASIC 2020/6
1020 '----------------------------------------------------------------------
1030 DEF FNMOD(X, Y) = X - INT(X / Y) * Y
1040 'SCREEN 3,0,0,1
1050 'CLS 3
1060 CMD GPU ON '--- GPU命令を有効にする
1070 GPU SYNC(ON) '--- すべての表示をGPU描画に同期させる
1080 '
1090 GPU TRACE(VIEW.OFFSET,1000)'--- 左右スクリーン間隔(スクリーン長の倍数)
1100 STEREO = 0 '--- 0:Mono 1:Stereo -1:Cross
1110 TI = 0:T0=TIME(1000) '--- 1/1000s単位で経過時間を得る
1120 MS = T0 '--- 移動用経過時間(ms)
1130 VZ = 4E-3 '--- スクリーン視点間距離(離れると望遠)
1140 TA = 2 '--- 全体の回転速度
1150 '--- 開始
1160 *START
1170 '
1180 ' 半径(km), 軌道長半径(km), 自転周期(日), 自転角(°)
1190 RS = 696000: AS = 0
1200 RE = 6378: AE = 149600000: DE = 0.01/ 0.9973: TE = 180
1210 RM = 1738: AM = 384400: DM = 0.01/27.3217: TM = -0.7
1220 ' 光速 light velocity(km/s) , 地球の位置
1230 LV = 299792 : A0 = AE
1240 '
1250 RX = 0: RY = 0: RZ = 0
1260 TX = 0: TY = 0: TZ = 0
1270 '
1280 '
1290 GPU MATRIX(IDENTITY) '--- 単位行列にする(位置のリセット)
1300 GPU MATRIX(MODE,VIEW) '--- 行列をMODELからVIEWモードに
1310 GPU ROTATE(-90, 1, 0, 0) '--- 視点をx軸周りに 90°(景色移動方向)
1320 GPU ROTATE( 90, 0, 1, 0) '--- 視点をy軸周りに-90°(景色移動方向)
1330 GPU TRANSLATE(0, 0, A0-RE-0.1)'--- 視点をz軸方向に移動(景色移動方向)
1340 GPU ROTATE(180, 0, 1, 0) '--- 視点をy軸周りに180°(景色移動方向)
1350 GPU MATRIX(MODE,PREVIOUS) '--- 行列モードを前の状態(MODELモード)へ
1360 A$ = ""
1370 WHILE A$ <> "q" AND A$ <> CHR$(13)
1380 GPU TRACE(VIEW.R, 1E-3) '--- スクリーン半径r(視半径)
1390 GPU TRACE(VIEW.Z, VZ ) '--- スクリーン視点間距離
1400 GPU MATERIAL(PUSH) '--- 物体情報退避
1410 GPU MATRIX(PUSH) '--- 行列(位置)退避
1420 GOSUB *SUN '--- 光源の色など定義
1430 A = 1.0
1440 GPU MATERIAL(LIGHT , A, A, A) '--- 光源の光の色と強さ
1450 GPU MATERIAL(ATTENUATE, 1, 0, 0) '--- 光減衰(0,1,2乗の係数)
1460 GPU MATERIAL(LIGHTS , RS) '--- 光源半径(球の半陰のみ対応)
1470 GPU SPHERE(RS * 1.4) '--- 光源の球(フレア分大きめに)
1480 GPU MATRIX(POP) '--- 行列(位置)戻す
1490 GPU MATERIAL(POP) '--- 物体情報戻す
1500 GPU MATRIX(PUSH)
1510 GPU TRANSLATE(A0, 0, 0) '--- x軸方向に軌道半径移動
1520 GPU MATERIAL(PUSH)
1530 GPU MATRIX(PUSH)
1540 GPU ROTATE(23.44, 1, 0, 0) '--- x軸周りに回転(右手系)
1550 GPU ROTATE(TE , 0, 0, 1) '--- z軸周りに回転(右手系)
1560 TE = FNMOD(TE + DE*TA, 360)
1570 GPU MATERIAL(DIFFUSE , 0.1, 0.1, 0.1) '--- 拡散反射係数(表面色)白
1580 GPU MATERIAL(REFLECT , 0.0, 0.0, 0.0) '--- 完全鏡面反射係数
1590 GPU MATERIAL(SPECULAR, 0.0, 0.0, 0.0) '--- 鏡面反射係数
1600 GPU MATERIAL(TEX, "Sky") '--- Textureを貼付ける
1610 GPU SPHERE(RE) '--- 地球を置く
1620 GPU MATERIAL(DIFFUSE , 0.9, 0.9, 0.9) '--- 拡散反射係数(表面色)白
1630 GPU MATERIAL(CLARITY , 0.8, 0.8, 0.8)
1640 GPU MATERIAL(REFRACT , 1 )
1650 GPU SPHERE(RE+2) '--- 大気+2km
1660 GPU MATRIX(POP)
1670 GPU MATERIAL(POP)
1680 GPU MATERIAL(PUSH)
1690 GPU ROTATE(TM , 0, 0, 1) '--- 自転周期で公転
1700 TM = FNMOD(TM + DM*TA, 360)
1710 GPU TRANSLATE(-AM, 0, 0)
1720 GPU MATERIAL(DIFFUSE , 1.0, 1.0, 0.9) '--- 拡散反射係数
1730 GPU MATERIAL(SPECULAR, 0.0, 0.0, 0.0) '--- 鏡面反射係数
1740 GPU SPHERE(RM) '--- 月を置く
1750 GPU MATERIAL(POP)
1760 GPU MATRIX(POP)
1770 GOSUB *MOVE '--- 移動
1780 GOSUB *TRACE '--- 描画
1790 LVP = SQR(TX*TX + TY*TY + TZ*TZ)*1000 / (LV*60)
1800 KMPH = INT(LVP * LV * 3600 / 10000)
1810 LVP = INT(LVP * 100)
1820 TI=TI+1:T=TIME(1000)
1830 IF T-T0 >= 1000 THEN '--- VL-BASICではここにWENDは書かないように
1840 TI=CINT((TI*1000)/(T-T0))
1850 CLS
1860 PRINT TI;"fps ";
1870 PRINT KMPH;"万km/h ";
1880 PRINT "光速の";LVP;"%"
1890 ' PUT@(0,0),STR$(TI)+" fps",PSET,7,0
1900 TI=0:T0=T
1910 ENDIF
1920 WEND '--- VL-BASICではWHILEの数とWENDの数が違うと誤動作の可能性あり
1930 IF A$ = CHR$(13) THEN *START
1940 'GPU OFF
1950 END
1960 '--- Sun
1970 *SUN
1980 GPU MATERIAL(LIGHT , 1,1,1) '--- 光源の光の色と強さ(上にあるので不必要)
1990 GPU MATERIAL(ATTENUATE, 0,0,1) '--- 光の減衰、距離t(c+bt+att)に反比例
2000 S = 1.44
2010 GPU MATERIAL(SPECULAR , S,S*0.8,S*0.6) '--- 反射した光の色と強さ
2020 GPU MATERIAL(SHININESS, 20) '--- 大きいほど鋭く、小さいほど鈍く輝く
2030 GPU MATERIAL(DIFFUSE , 0,0,0) '--- 無色(黒)
2040 GPU MATERIAL(CLARITY , 1,1,1) '--- 完全に透明
2050 GPU MATERIAL(REFRACT , 1) '--- 屈折率1.0
2060 RETURN
2070 '--- Trace
2080 *TRACE
2090 IF STEREO THEN *TRACE.STEREO
2100 GPU CLEAR '--- 描画バッファをクリア
2110 GPU TRACE(BEGIN) '--- レイトレーシングの準備
2120 GPU TRACE(VIEWPORT.X, 0)
2130 GPU TRACE(VIEWPORT.Y, 0)
2140 GPU TRACE(VIEWPORT.W,640)
2150 GPU TRACE(VIEWPORT.H,400)
2160 GPU TRACE(VIEW.STEREO, 0) '--- 真ん中
2170 GPU TRACE '--- レイトレーシング
2180 GPU TRACE(END) '--- レイトレーシングの後始末(画面表示)
2190 RETURN
2200 '--- Trace stereo
2210 *TRACE.STEREO
2220 GPU CLEAR '--- 描画バッファをクリア
2230 GPU TRACE(BEGIN) '--- レイトレーシングの準備
2240 GPU TRACE(VIEWPORT.X, 0)
2250 GPU TRACE(VIEWPORT.Y,100)
2260 GPU TRACE(VIEWPORT.W,320)
2270 GPU TRACE(VIEWPORT.H,200)
2280 GPU TRACE(VIEW.STEREO,-STEREO) '--- 左へシフト
2290 GPU TRACE '--- レイトレーシング
2300 GPU TRACE(VIEWPORT.X,320)
2310 GPU TRACE(VIEWPORT.Y,100)
2320 GPU TRACE(VIEWPORT.W,320)
2330 GPU TRACE(VIEWPORT.H,200)
2340 GPU TRACE(VIEW.STEREO, STEREO) '--- 右へシフト
2350 GPU TRACE '--- レイトレーシング
2360 GPU TRACE(END) '--- レイトレーシングの後始末(画面表示)
2370 RETURN
2380 '--- Move
2390 *MOVE
2400 DRX = 0:DRY = 0:DRZ = 0:DTX = 0:DTY = 0:DTZ = 0:TH = 1:BK = 1
2410 DR = 0.002:DT = 0.00002 * LV
2420 IF NOT INP(&HE8) AND &H04 THEN DRX = -DR '--- → 右旋回
2430 IF NOT INP(&HEA) AND &H04 THEN DRX = DR '--- ← 左旋回
2440 IF NOT INP(&HE8) AND &H02 THEN DRY = -DR '--- ↑ 機首を下げる
2450 IF NOT INP(&HEA) AND &H02 THEN DRY = DR '--- ↓ 機首を上げる
2460 IF NOT INP(&HE4) AND &H01 THEN DRZ = DR '--- p 左傾き
2470 IF NOT INP(&HE5) AND &H08 THEN DRZ = -DR '--- [ 右傾き
2480 IF NOT INP(&HE7) AND &H80 THEN DTZ = -DT '--- \(_)前に並進
2490 IF NOT INP(&HE7) AND &H40 THEN DTZ = DT '--- / 後に並進
2500 IF NOT INP(&HE7) AND &H08 THEN DTX = -DT '--- ; 左に並進
2510 IF NOT INP(&HE5) AND &H20 THEN DTX = DT '--- ] 右に並進
2520 IF NOT INP(&HE2) AND &H01 THEN DTY = DT '--- @ 上に並進
2530 IF NOT INP(&HE7) AND &H04 THEN DTY = -DT '--- : 下に並進
2540 IF NOT INP(&HE7) AND &H20 THEN BK = 0.8 '--- Break
2550 IF NOT INP(&HE8) AND &H40 THEN TH = 5 '--- SHIFT 高速
2560 DRX = DRX * TH:DRY = DRY * TH:DRZ = DRZ * TH
2570 DTX = DTX * TH:DTY = DTY * TH:DTZ = DTZ * TH
2580 RX = RX + DRX:RY = RY + DRY:RZ = RZ + DRZ
2590 TX = TX + DTX:TY = TY + DTY:TZ = TZ + DTZ
2600 RX = RX * BK :RY = RY * BK :RZ = RZ * BK
2610 TX = TX * BK :TY = TY * BK :TZ = TZ * BK
2620 GPU MATRIX(MODE,VIEW) '--- 行列をMODELからVIEWモードに
2630 GPU ROTATE(-RY, 1, 0, 0) '--- x軸周りにRY°回転
2640 GPU ROTATE(-RX, 0, 1, 0) '--- y軸周りにRX°回転
2650 GPU ROTATE(-RZ, 0, 0, 1) '--- z軸周りにRZ°回転
2660 I = TIME(1000): T = I-MS:MS = I
2670 T = T*60/1000
2680 GPU TRANSLATE(-TX*T, -TY*T, -TZ*T) '--- VIEWモードは回転移動の符号が逆
2690 A$ = INKEY$
2700 IF A$ = " " THEN TZ = -TZ:GPU ROTATE(180, 0, 1, 0) '--- 後ろを向く
2710 GPU MATRIX(MODE,PREVIOUS) '--- 行列モードを前の状態(MODELモード)へ
2720 IF A$ = "0" THEN STEREO = 0 '--- Mono
2730 IF A$ = "-" THEN STEREO = 1 '--- Stereo
2740 IF A$ = "^" THEN STEREO = -1 '--- Cross
2750 IF A$ = "z" THEN VZ = VZ * 2
2760 IF A$ = "x" THEN VZ = VZ / 2
2770 IF A$ = "n" THEN TA = 2
2780 IF A$ = "m" THEN TA = 1000
2790 IF A$ = "," THEN TA = 0
2800 RETURN
2810 '-----------------------------------------------------------------------
2820 ' 0 - ^ | 0通常表示 -並行ステレオ表示 ^交差ステレオ表示
2830 ' q | q終了
2840 ' p @ [ enter | p左傾き @上に移動 [右傾き enter初期位置へ
2850 ' ; : ] | ;左に移動 :下に移動 ]右に移動
2860 ' |
2870 ' ↑ | ↑機首下げ
2880 ' ← ↓ → space| ←左旋回 ↓機首上げ →右旋回 space後方に向く
2890 ' |
2900 ' / \(_) shift| /後進 \(_)前進 +shiftで速く移動
2910 ' |
2920 ' z x n m , . | z望遠 x広角 n通常 m高速回転 ,回転停止 .ブレーキ
2930 '-----------------------------------------------------------------------