10 '  SAVE"B:SIKI",A
20 '  SAVE"B:SIKI.CPY",A
30 '********************************************************
40 '**** 四季における地軸の傾きと昼の長さ夜の長さの変化 ****
50 '****     1990年 1月           山田 洋               ****
60 '********************************************************
70 SCREEN 3:CONSOLE 0,25,0,1:WIDTH 80,20:CLS 3
80 DEFINT I-M
90 'DEFDBL A-H,O-Z
100 DIME=(((199+7)/8)*199*3+4)/4+1
110 DIM FUYU%(DIME),NATU%(DIME),HARU%(DIME),AKI%(DIME)
120 DIM XDD(200),YDD(200),CH(256)
130 GOSUB *FKEYNUL
140 ON STOP GOSUB *MENU:STOP ON
150 ON KEY GOSUB *F1,*F2,*F3,*F4,*F5,*F6,*F7,*F8,*F9,*F10
160 FOR I=1 TO 10:KEY(I) ON:NEXT I
170 HTILE$=CHR$(&H55)+CHR$(&HFF)+CHR$(&HFF)   '薄黄色
180 'YTILE$=CHR$(&H55)+CHR$(&H55)+CHR$(&H55)  '灰色
190 YTILE$=CHR$(&HAA)+CHR$(&H0)+CHR$(&H0)     '暗青色
200 GOSUB *SETFKEY
210 GOSUB *CH
220 PAY=3.141592653589794#
230 X0SUN=320:Y0SUN=172  '太陽の中心
240 RSUN=30              '太陽の半径
250 RKOUTE=220           '惑星の公転半径
260 RHIRIT=.4           '公転軌道半径のＹ軸のＸ軸に対する比率
270 TR=40                 '地球半径
280 TL=1.3*TR             '地軸の長さ　　　　　　　　　　　
290 IFLAG=1               '初めて描くかどうかの判断のため
300 LOCATE 5,0:COLOR 6
310 PRINT"      ***** 四季における地軸の傾きと昼の長さ夜の長さの変化 *****":COLOR 7
320 IFLAG1=1:IFLAG2=1:IFLAG3=1                    '始めはすべて入力をさせる
330 IFLAG6=-1:IFLAG7=-1:IFLAG8=-1:IFLAG9=-1       '始めは数表を書かない
340 GOSUB *NYUURYOKU
350 IF IFLAG=1 THEN GOSUB *MESSEAGE
360 '
370 '======== 冬至の地球 ========
380 '
390 KISETU$="FUYU"
400 X0=X0SUN-RKOUTE:Y0=Y0SUN      '画面の中心位置
410 WX1=-X0:WY1=-Y0:WX2=639-X0:WY2=399-Y0 'ワ－ルド座標
420 'WINDOW(WX1,WY1/.899)-(WX2,WY2/.899)   'FM-BASIC98用
430 WINDOW(WX1,WY1)-(WX2,WY2)             'N88BASIC用
440 IF IFLAG<>1 THEN LINE(-TL-8 ,-TL-8 )-(TL+8 ,TL+8 ),0,BF   '地球を消す
450 GOSUB *KEISAN:HH1=HIRUHI:YH1=YORUHI:H1=HIRU:Y1=YORU
460 GOSUB *TIKYUU
470 IF IFLAG6=-1 THEN 530
480 '計算表示枠の左隅（ワード単位）
490 NXW=(X0SUN-RKOUTE)/16-6:NYW=INT(Y0SUN+TL)\20+1
500  XHYOU=NXW*16:YHYOU=NYW*20 '計算表示枠の左隅（ドット単位）
510 IF IFLAG=1 THEN GOSUB *KEISANHYOUJI ELSE GOSUB *SUUHYOUJI
520 '
530 '======== 夏至の地球 ========
540 '
550 KISETU$="NATU"
560 X0=X0SUN+RKOUTE:Y0=Y0SUN      '画面の中心位置
570 WX1=-X0:WY1=-Y0:WX2=639-X0:WY2=399-Y0 'ワ－ルド座標
580 'WINDOW(WX1,WY1/.899)-(WX2,WY2/.899)   'FM-BASIC98用
590 WINDOW(WX1,WY1)-(WX2,WY2)             'N88BASIC用
600 IF IFLAG<>1 THEN LINE(-TL-8 ,-TL-8 )-(TL+8 ,TL+8 ),0,BF   '地球を消す
610 GOSUB *TIKYUU
620 IF IFLAG7=-1 THEN  690
630 '計算表示枠の左隅（ワード単位）
640 NXW=(X0SUN+RKOUTE)/16-6:NYW=INT(Y0SUN+TL)\20+1
650  XHYOU=NXW*16:YHYOU=NYW*20 '計算表示枠の左隅（ドット単位）
660 HIRUHI=YH1:YORUHI=HH1:HIRU=Y1:YORU=H1
670 IF IFLAG=1 THEN GOSUB *KEISANHYOUJI ELSE GOSUB *SUUHYOUJI
680 '
690 '======== 春分の地球 ========
700 '
710 KISETU$="HARU"
720 X0=X0SUN:Y0=Y0SUN+RKOUTE*RHIRIT               '画面の中心位置
730 WX1=-X0:WY1=-Y0:WX2=639-X0:WY2=399-Y0 'ワ－ルド座標
740 'WINDOW(WX1,WY1/.899)-(WX2,WY2/.899)   'FM-BASIC98用
750 WINDOW(WX1,WY1)-(WX2,WY2)             'N88BASIC用
760 IF IFLAG<>1 THEN LINE(-TL-8 ,-TL-8 )-(TL+8 ,TL+8 ),0,BF   '地球を消す
770 GOSUB *TIKYUU
780 IF IFLAG8=-1 GOTO 850
790 '計算表示枠の左隅（ワード単位）
800 NXW=(X0SUN       )/16-6:NYW=INT(Y0SUN+TL+RKOUTE*RHIRIT)\20+1
810  XHYOU=NXW*16:YHYOU=NYW*20 '計算表示枠の左隅（ドット単位）
820 HIRUHI=.5:YORUHI=.5:HIRU=12:YORU=12
830 IF IFLAG=1 THEN GOSUB *KEISANHYOUJI ELSE GOSUB *SUUHYOUJI
840 '
850 '======== 秋分の地球 ========
860 '
870 KISETU$="AKI"
880 X0=X0SUN:Y0=Y0SUN-RKOUTE*RHIRIT               '画面の中心位置
890 WX1=-X0:WY1=-Y0:WX2=639-X0:WY2=399-Y0 'ワ－ルド座標
900 'WINDOW(WX1,WY1/.899)-(WX2,WY2/.899)   'FM-BASIC98用
910 WINDOW(WX1,WY1)-(WX2,WY2)             'N88BASIC用
920 IF IFLAG<>1 THEN LINE(-TL-8 ,-TL-8 )-(TL+8 ,TL+8 ),0,BF   '地球を消す
930 GOSUB *TIKYUU
940 IF IFLAG9=-1 THEN 1000
950 '計算表示枠の左隅（ワード単位）
960 NXW=(X0SUN+TL)/16+1:NYW=INT(Y0SUN-TL)\20-5
970  XHYOU=NXW*16:YHYOU=NYW*20 '計算表示枠の左隅（ドット単位）
980 HIRUHI=.5:YORUHI=.5:HIRU=12:YORU=12
990 IF IFLAG=1 THEN GOSUB *KEISANHYOUJI ELSE GOSUB *SUUHYOUJI
1000 'IFLAG=1    ' ゲット、プットを使わずに再び描く（遅いけど見た目に良い）
1010  IFLAG=2    ' ゲット、プットを使う            （早いけどちらつく    )
1020 GOTO 340
1030 END
1040 '
1050 '******** メニューヘ戻る ************
1060 '
1070 *MENU
1080 STOP OFF
1090 FOR I=1 TO 10:KEY(I) OFF:NEXT I
1100 GOSUB *FKEY0
1110 RUN"MENU"
1120 RETURN
1130 '
1140 '
1150 '******** メッセージ文  *******************
1160 *MESSEAGE
1170 CIRCLE (X0SUN,Y0SUN),RSUN,7                 '太陽
1180 TAIYO$=HTILE$                               '太陽の色（薄黄色）
1190 PAINT(X0SUN,Y0SUN),TAIYO$,7
1200 LOCATE X0SUN\8-2,Y0SUN\20 :COLOR 0:PRINT"太陽":COLOR 7
1210 CIRCLE(X0SUN,Y0SUN),RKOUTE,7,,,RHIRIT
1220 LOCATE INT(X0SUN-RKOUTE-TL)\8-5,INT(Y0SUN)\20:PRINT "冬至"
1230 LOCATE INT(X0SUN+RKOUTE+TL)\8+1,INT(Y0SUN)\20:PRINT "夏至"
1240 LOCATE INT(X0SUN+TL)\8+1,INT(Y0SUN+RKOUTE*RHIRIT)\20-2:PRINT "春分"
1250 LOCATE INT(X0SUN+TL)\8+1,INT(Y0SUN-RKOUTE*RHIRIT)\20+2:PRINT "秋分"
1260 RETURN
1270 '
1280 '
1290 '******** 地球を描く **************
1300 *TIKYUU
1310 IF IFLAG=1 THEN GOSUB *TIKYUUSHOKI :GOTO 1360
1320 IF KISETU$="FUYU" THEN PUT@(MAP(-TL-8 ,0),MAP(-TL-8 ,1)),FUYU%
1330 IF KISETU$="HARU" THEN PUT@(MAP(-TL-8 ,0),MAP(-TL-8 ,1)),HARU%
1340 IF KISETU$="NATU" THEN PUT@(MAP(-TL-8 ,0),MAP(-TL-8 ,1)),NATU%
1350 IF KISETU$="AKI"  THEN PUT@(MAP(-TL-8 ,0),MAP(-TL-8 ,1)),AKI%
1360 IF IFLAG<>1 THEN 1410
1370 IF KISETU$="FUYU" THEN GET@(MAP(-TL-8 ,0),MAP(-TL-8 ,1))-STEP(2*TL+16,2*TL+16),FUYU%
1380 IF KISETU$="HARU" THEN GET@(MAP(-TL-8 ,0),MAP(-TL-8 ,1))-STEP(2*TL+16,2*TL+16),HARU%
1390 IF KISETU$="NATU" THEN GET@(MAP(-TL-8 ,0),MAP(-TL-8 ,1))-STEP(2*TL+16,2*TL+16),NATU%
1400 IF KISETU$="AKI"  THEN GET@(MAP(-TL-8 ,0),MAP(-TL-8 ,1))-STEP(2*TL+16,2*TL+16),AKI%
1410 GOSUB *TIJIKU
1420 GOSUB *SEKIDOU
1430 GOSUB *JITENITI
1440 RETURN
1450  '
1460  '
1470  '******** 入力 ************
1480 *NYUURYOKU
1490 IF IFLAG<>1 THEN 1590
1500 NYUUX0=0:NYUUY0=2   '入力領域の左隅（ワード単位）
1510 NYUUXL=10:NYUUYL=3  '入力領域の枠の長さ（ワード単位）
1520 CLNYUU=7            '入力領域の枠の色
1530 LINE(MAP(16*NYUUX0,2),MAP(20*NYUUY0,3))-STEP(16*NYUUXL,20*NYUUYL),CLNYUU,B
1540 LINE(MAP(16*NYUUX0,2),MAP(20*NYUUY0+  20*NYUUYL/3,3))-STEP(16*NYUUXL,0),CLNYUU,
1550 LINE(MAP(16*NYUUX0,2),MAP(20*NYUUY0+2*20*NYUUYL/3,3))-STEP(16*NYUUXL,0),CLNYUU,
1560 LOCATE NYUUX0,NYUUY0:  PRINT " 地軸の傾き = "
1570 LOCATE NYUUX0,NYUUY0+1:PRINT " 緯度　　　 = "
1580 LOCATE NYUUX0,NYUUY0+2:PRINT " 経度　　　 = "
1590 XINP0=2*(NYUUX0+7):YINP0=NYUUY0
1600 IF IFLAG1=-1 AND IFLAG2=-1 AND IFLAG3=-1 THEN GOSUB *F1   '入力が選ばれなかった時の処理
1610 '-------  地軸の傾き入力 -------
1620 *INPTIJIKU
1630 INPFLG=1
1640 IF IFLAG1=-1 THEN GOTO *INPIDO
1650 X=XINP0:Y=YINP0
1660 GOSUB *INPUTT:IF N$<>"" THEN TH=VAL(N$) ELSE *THRETURN
1670 LOCATE X,Y:PRINT "                                   "
1680 TH$=N$
1690 *THRETURN
1700 TH=VAL(TH$):IF TH$="" THEN TH$="0"
1710 LOCATE X,Y:PRINT TH$
1720 IF TH=90 THEN TH=89.9999
1730 IF TH=-90 THEN TH=-89.9999
1740 THR=TH*PAY/180
1750 '--------  緯度の入力 -------
1760 *INPIDO
1770 INPFLG=2
1780 IF IFLAG2=-1 THEN GOTO *INPKEIDO
1790 X=XINP0:Y=YINP0+1
1800 GOSUB *INPUTT:IF N$<>"" THEN PH=VAL(N$) ELSE *PHRETURN
1810 LOCATE X,Y:PRINT "                                   "
1820 IF ABS(PH)>90 THEN GOTO 1800
1830 PH$=N$
1840 *PHRETURN
1850 PH=VAL(PH$):IF PH$="" THEN PH$="0"
1860 LOCATE X,Y:PRINT PH$
1870 IF PH=90 THEN PH=89.9999
1880 IF PH=-90 THEN PH=-89.9999
1890 PHR=PH*PAY/180
1900 '--------  経度の入力 -------
1910 *INPKEIDO
1920 INPFLG=3
1930 IF IFLAG3=-1 THEN 2030
1940 X=XINP0:Y=YINP0+2
1950 GOSUB *INPUTT:IF N$<>"" THEN PK=VAL(N$) ELSE *PKRETURN
1960 LOCATE X,Y:PRINT "                                   "
1970 IF ABS(PK)>180 THEN GOTO 1950
1980 PK$=N$
1990 *PKRETURN
2000 PK=VAL(PK$):IF PK$="" THEN PK$="0"
2010 LOCATE X,Y:PRINT PK$
2020 PKR=PK*PAY/180
2030 RETURN  350
2040 '
2050 '
2060 '***********  地球初期画図 *************
2070 *TIKYUUSHOKI
2080 CIRCLE(0,0),TR,7,,,,F,0                      '地球の外枠
2090 IF KISETU$="HARU" OR KISETU$="AKI" THEN 2120
2100 'CIRCLE(2,0),TR,7,.5*PAY,1.5*PAY,100000!     '日向と日影の堺目
2110 LINE(0,-TR)-(0,TR),7                  '日向と日影の堺目
2120 IF KISETU$="FUYU" THEN PAINT(2,0),HTILE$,7:PAINT(-2,0),YTILE$,7  '冬至
2130 IF KISETU$="HARU" THEN PAINT(0,0),YTILE$,7                       '春分
2140 IF KISETU$="NATU" THEN PAINT(2,0),YTILE$,7:PAINT(-2,0),HTILE$,7  '夏至
2150 IF KISETU$="AKI"  THEN PAINT(0,0),HTILE$,7                       '秋分
2160 'PAINT(2,0),6,7          '昼のペイント
2170 'PAINT(-2,0),1,7          '夜のペイント
2180 RETURN
2190 '
2200 '
2210 '*******    地軸を描く   ********
2220 *TIJIKU
2230 TLX1=TL*SIN(THR):TLY1=TL*COS(THR)
2240 TLX2=TR*SIN(THR):TLY2=TR*COS(THR)
2250 LINE(-TLX1,-TLY1)-(-TLX2,-TLY2),7
2260 LINE(TLX1,TLY1)-(TLX2,TLY2),7
2270 'KANJIN=&H4E    '半角N
2280  KANJIN=&H14E   '1/4角N
2290 'KANJIN=&H234E   '全角Ｎ
2300 PUT@ (MAP(-TLX1,0),MAP(-TLY1-8,1)),KANJI(KANJIN),PSET,2,0  'Ｎ極表示
2310 'KANJIS=&H53    '半角S
2320  KANJIS=&H153   '1/4角S
2330 'KANJIS=&H2353   '全角Ｓ
2340 PUT@ (MAP(TLX1,0),MAP(TLY1-8,1)),KANJI(KANJIS),PSET,7,0    'Ｓ極表示
2350 RETURN
2360 '
2370 '
2380 '************ 赤道を描く ****************
2390 *SEKIDOU
2400 R=TR                  '楕円の長径
2410 GYOUKA=0             '仰角
2420 XX0=0:YY0=0           '傾いていない時の楕円の中心
2430 CLD=2                 '楕円の色
2440 'GOSUB *DAEN
2450 XL=TR*COS(THR):YL=TR*SIN(THR):LINE(-XL,YL)-(XL,-YL),CLD
2460 RETURN
2470 '
2480 '
2490 '********** 自転位置を描く **************
2500 *JITENITI
2510 IF KISETU$<>"FUYU" THEN CLD=4:GOSUB *DAEN2:RETURN
2520 R=TR*COS(PHR)         '楕円の長径
2530 L=5*TR                'みる位置から楕円の中心までの距離
2540 'GYOUKA=ATN(R/L*SIN(PHR)*ABS(COS(THR))/(1-R/L*COS(PHR)))    '仰角
2550 GYOUKA=ATN(R/L*SIN(PHR)              /(1-R/L*COS(PHR)))    '仰角
2560 'GYOUKA=0
2570 XX0=0:YY0=TR*SIN(PHR) '傾いていない時の楕円の中心
2580 CLD=4                 '楕円の色
2590 GOSUB *DAEN
2600 RETURN
2610 *DAEN
2620 NS=20 ' 描くドット数
2630 TRDD=R*SIN(GYOUKA)
2640 FOR IS=0 TO NS
2650 HR=PAY*IS/NS
2660 X=R*COS(HR)+XX0:Y=TRDD*SIN(HR)+YY0
2670 '--------（地軸の傾きによる回転変換）--------
2680 XX=X*COS(THR)-Y*SIN(THR)
2690 YY=X*SIN(THR)+Y*COS(THR)
2700 XDD(IS)=XX:YDD(IS)=YY
2710 NEXT IS
2720 *DAEN2
2730 FOR IS=1 TO NS
2740 LINE(XDD(IS-1),-YDD(IS-1))-(XDD(IS),-YDD(IS)),CLD
2750 LINE(XDD(IS-1),-YDD(IS-1)+1)-(XDD(IS),-YDD(IS)+1),CLD
2760 NEXT IS
2770 RETURN
2780 *KEISAN
2790 '**** 昼だけ，夜だけの判断 ****
2800 COSP=TAN(THR)*TAN(PHR)
2810 IF THR>=.5*PAY AND THR<1.5*PAY THEN COSP=-COSP
2820 IF COSP=0 THEN P=PAY:GOTO 2870
2830 IF COSP>=1 THEN P=0:GOTO 2870
2840 IF COSP<=-1 THEN P=2*PAY:GOTO 2870
2850 P=2*ATN(SQR(1/(COSP*COSP)-1))
2860 IF COSP<0 THEN P=2*PAY-P
2870 HIRUHI=.5*P/PAY
2880 YORUHI=1-HIRUHI
2890 HIRU=24*HIRUHI
2900 YORU=24-HIRU
2910 RETURN
2920 *KEISANHYOUJI
2930 NXL=10.5:NYL=1.9          '計算表示枠の長さ（ワード単位）
2940 XWAKU=NXL*16:YWAKU=NYL*20 '計算表示枠の長さ
2950 CLWAKU=5                  '計算表示枠の色
2960 '------ 計算表示枠を描く --------
2970 GL=3.5 '棒グラフの長さ（ワード単位）
2980 GH=.2   '棒グラフの巾（ワード単位）
2990 LINE (MAP(XHYOU,2),MAP(YHYOU+20,3))-STEP(XWAKU,YWAKU),CLWAKU,B
3000 LINE (MAP(XHYOU,2),MAP(YHYOU+20+.5*YWAKU,3))-STEP(XWAKU,0),CLWAKU,B
3010 LINE (MAP(XHYOU+XWAKU-16*GL,2),MAP(YHYOU+YWAKU-20,3))-STEP(0,40),CLWAKU,B
3020 LOCATE 2*NXW,NYW+1:PRINT" 昼      時間"
3030 LOCATE 2*NXW,NYW+2:PRINT" 夜      時間"
3040 '**** グラフの目盛り ****
3050 LINE (MAP(XHYOU+XWAKU-8*GL+1,2),MAP(YHYOU+20,3))-STEP(0,-3),CLWAKU,B
3060 PUT@ (XHYOU+XWAKU-8*GL-8,YHYOU+ 5),KANJI(&H131),PSET,7,0  '1/4角 1
3070 PUT@ (XHYOU+XWAKU-8*GL  ,YHYOU+ 5),KANJI(&H132),PSET,7,0  '1/4角 2
3080 LINE (MAP(XHYOU+XWAKU,2),MAP(YHYOU+20,3))-STEP(0,-3),CLWAKU,B
3090 PUT@ (XHYOU+XWAKU-8,YHYOU+ 5),KANJI(&H132),PSET,7,0  '1/4角 2
3100 PUT@ (XHYOU+XWAKU    ,YHYOU+ 5),KANJI(&H134),PSET,7,0  '1/4角 4
3110 *SUUHYOUJI
3120 '----- 計算数値を書く ------
3130 COLOR 6:LOCATE 2*NXW+ 4,NYW+1:PRINT USING "##.##";HIRU
3140         LOCATE 2*NXW+ 4,NYW+2:PRINT USING "##.##";YORU:COLOR 7
3150 '----- 棒グラフを描く ----
3160 '  昼の棒グラフ
3170 LINE (MAP(XHYOU+XWAKU-16*GL+1,2),MAP(YHYOU+30-.5*20*GH,3))-STEP(GL*16-2,20*GH),0,BF
3180 GGL=(16*GL-2)*HIRUHI
3190 IF GGL<1  THEN 3230
3200 LINE (MAP(XHYOU+XWAKU-16*GL+1,2),MAP(YHYOU+30-.5*20*GH,3))-STEP(GGL,20*GH),7,B
3210 PAINT STEP(-1,-1),HTILE$,7
3220 '  夜の棒グラフ
3230 LINE (MAP(XHYOU+XWAKU-16*GL+1,2),MAP(YHYOU+50-.5*20*GH,3))-STEP(GL*16-2,20*GH),0,BF
3240 GGL=(16*GL-2)*YORUHI
3250 IF GGL<1 THEN 3280
3260 LINE (MAP(XHYOU+XWAKU-16*GL+1,2),MAP(YHYOU+50-.5*20*GH,3))-STEP(GGL,20*GH),1,B
3270 PAINT STEP(-1,-1),YTILE$,1
3280 RETURN
3290 '
3300 '
3310 '********** 数値のインプット ***********
3320 *INPUTT
3330 N$="":DX=0
3340 AA$=INKEY$:IF AA$<>"" THEN 3340            'キーバッファクリア
3350 V$=""
3360 LOCATE X+DX,Y:V$=INPUT$(1)
3370 IF V$="" THEN 3360
3380 CHV=CH(ASC(V$))
3390 ON CHV GOSUB *SUU,*KETTEI,*SAKUJYO
3400 GOTO 3350
3410 *INPUTTRETURN
3420 RETURN
3430 *CH
3440 FOR I=48 TO 57:CH(I)=1:NEXT I '1,2,3,････,9 ｷｰ
3450 CH(43)=1                      '+ ｷｰ
3460 CH(45)=1                      '- ｷｰ
3470 CH(46)=1                      '. ｷｰ
3480 CH(13)=2                      'RETURN ｷｰ
3490 CH(127)=3                     'DEL ｷｰ
3500 CH(8)=3                       'BS  ｷｰ
3510 CH(27)=4                      'ESC ｷｰ
3520 RETURN
3530 *SUU
3540 N$=N$+V$
3550 LOCATE X+DX,Y:PRINT V$;:DX=DX+1
3560 RETURN
3570 *KETTEI
3580 RETURN 3420
3590 *SAKUJYO
3600 IF N$="" THEN RETURN
3610 DX=DX-1
3620 N$=LEFT$(N$,DX)
3630 LOCATE X,Y:PRINT "               ";
3640 LOCATE X,Y:PRINT N$;
3650 RETURN
3660  '
3670  '******** ファンクションキーによる割り込みサブルーチン *********
3680 *F1
3690  IFLAG1=-IFLAG1
3700  CLF=(1+IFLAG1)/2
3710  PUT@ (FAST1                   +2,401-FWAKUY),KANJI(&H434F),PSET,7,CLF '地
3720  PUT@ (FAST1                +16+2,401-FWAKUY),KANJI(&H3C34),PSET,7,CLF '軸
3730  IF IFLAG1=-1 AND INPFLG=1 THEN RETURN *INPUTTRETURN
3740  RETURN
3750 *F2
3760  IFLAG2=-IFLAG2
3770  CLF=(1+IFLAG2)/2
3780  PUT@ (FAST1+(FKAN+FWAKUX)     +2,401-FWAKUY),KANJI(&H305E),PSET,7,CLF '緯
3790  PUT@ (FAST1+(FKAN+FWAKUX)  +16+2,401-FWAKUY),KANJI(&H4559),PSET,7,CLF '度
3800  IF IFLAG2=-1 AND INPFLG=2 THEN RETURN *INPUTTRETURN
3810  RETURN
3820 *F3
3830  IFLAG3=-IFLAG3
3840  CLF=(1+IFLAG3)/2
3850  PUT@ (FAST1+(FKAN+FWAKUX)*2+   2,401-FWAKUY),KANJI(&H3750),PSET,7,CLF '経
3860  PUT@ (FAST1+(FKAN+FWAKUX)*2+16+2,401-FWAKUY),KANJI(&H4559),PSET,7,CLF '度
3870  IF IFLAG3=-1 AND INPFLG=3 THEN RETURN *INPUTTRETURN
3880  RETURN
3890 *F4
3900  RETURN
3910 *F5
3920  RETURN
3930 *F6
3940 IFLAG6=-IFLAG6
3950 CLF=(1+IFLAG6)/2
3960 PUT@ (FAST2+(FKAN+FWAKUX)*5+2,401-FWAKUY),KANJI(&H455F),PSET,7,CLF   '冬
3970 PUT@ (FAST2+(FKAN+FWAKUX)*5+16+2,401-FWAKUY),KANJI(&H493D),PSET,7,CLF'表
3980 '計算表示枠の左隅（ワード単位）
3990 NXW=(X0SUN-RKOUTE)/16-6:NYW=INT(Y0SUN+TL)\20+1
4000 XHYOU=NXW*16:YHYOU=NYW*20 '計算表示枠の左隅（ドット単位）
4010 HIRUHI=HH1:YORUHI=YH1:HIRU=H1:YORU=Y1
4020 IF IFLAG6=1 THEN GOSUB *KEISANHYOUJI ELSE *SUUHYOUKESI
4030 RETURN
4040 *F7
4050 IFLAG7=-IFLAG7
4060 CLF=(1+IFLAG7)/2
4070 PUT@ (FAST2+(FKAN+FWAKUX)*6+2,401-FWAKUY),KANJI(&H3246),PSET,7,CLF   '夏
4080 PUT@ (FAST2+(FKAN+FWAKUX)*6+16+2,401-FWAKUY),KANJI(&H493D),PSET,7,CLF'表
4090 '計算表示枠の左隅（ワード単位）
4100 NXW=(X0SUN+RKOUTE)/16-6:NYW=INT(Y0SUN+TL)\20+1
4110 XHYOU=NXW*16:YHYOU=NYW*20 '計算表示枠の左隅（ドット単位）
4120 HIRUHI=YH1:YORUHI=HH1:HIRU=Y1:YORU=H1
4130 IF IFLAG7=1 THEN GOSUB *KEISANHYOUJI ELSE *SUUHYOUKESI
4140 RETURN
4150 *F8
4160 IFLAG8=-IFLAG8
4170 CLF=(1+IFLAG8)/2
4180 PUT@ (FAST2+(FKAN+FWAKUX)*7+2,401-FWAKUY),KANJI(&H3D55),PSET,7,CLF   '春
4190 PUT@ (FAST2+(FKAN+FWAKUX)*7+16+2,401-FWAKUY),KANJI(&H493D),PSET,7,CLF'表
4200 '計算表示枠の左隅（ワード単位）
4210 NXW=(X0SUN      )/16-6:NYW=INT(Y0SUN+TL+RKOUTE*RHIRIT)\20+1
4220 XHYOU=NXW*16:YHYOU=NYW*20 '計算表示枠の左隅（ドット単位）
4230 HIRUHI=.5:YORUHI=.5:HIRU=12:YORU=12
4240 IF IFLAG8=1 THEN GOSUB *KEISANHYOUJI ELSE *SUUHYOUKESI
4250 RETURN
4260 *F9
4270 IFLAG9=-IFLAG9
4280 CLF=(1+IFLAG9)/2
4290 PUT@ (FAST2+(FKAN+FWAKUX)*8+2,401-FWAKUY),KANJI(&H3D29),PSET,7,CLF   '秋
4300 PUT@ (FAST2+(FKAN+FWAKUX)*8+16+2,401-FWAKUY),KANJI(&H493D),PSET,7,CLF'表
4310 '計算表示枠の左隅（ワード単位）
4320 NXW=(X0SUN+TL    )/16+1:NYW=INT(Y0SUN-TL)\20-5
4330 XHYOU=NXW*16:YHYOU=NYW*20 '計算表示枠の左隅（ドット単位）
4340 HIRUHI=.5:YORUHI=.5:HIRU=12:YORU=12
4350 IF IFLAG9=1 THEN GOSUB *KEISANHYOUJI ELSE *SUUHYOUKESI
4360 RETURN
4370  *F10
4380  PUT@ (FAST2+(FKAN+FWAKUX)*9+   2,401-FWAKUY),KANJI(&H3D2A),PSET,7,2   '終
4390  PUT@ (FAST2+(FKAN+FWAKUX)*9+16+2,401-FWAKUY),KANJI(&H246A),PSET,7,2   'り
4400  GOSUB *MENU
4410  RETURN
4420 *SUUHYOUKESI
4430 '****** 計算表示枠を描く ********
4440 NXL=10.5:NYL=1.9         '計算表示枠の長さ（ワード単位）
4450 XWAKU=NXL*16:YWAKU=NYL*20 '計算表示枠の長さ
4460 LINE (MAP(XHYOU,2),MAP(YHYOU+20,3))-STEP(XWAKU,YWAKU),0,BF    '数表枠消し
4470 LINE (MAP(XHYOU+16,2),MAP(YHYOU+20-16,3))-STEP(XWAKU  ,16),0,BF '目盛消し
4480 LOCATE 2*NXW,NYW+1:PRINT"             "                         '数値消し
4490 LOCATE 2*NXW,NYW+2:PRINT"             "                         '数値消し
4500 RETURN
4510 '
4520 '
4530 '******************** ファンクションキーの設定 ***************************
4540 *SETFKEY
4550 FAST1=9                  'ファンクションキ－枠の始め(F1-F5 )
4560 FAST2=9+48               'ファンクションキ－枠の始め(F6-F10)
4570 FWAKUX=16*2+3            'ファンクションキ－枠の横の長さ
4580 FWAKUY=20                'ファンクションキ－枠の縦の長さ
4590 FKAN=22                  'ファンクションキー枠間の長さ
4600 FOR I=1 TO 5
4610 LINE(MAP(FAST1+(FKAN+FWAKUX)*(I-1),2),MAP(399-FWAKUY,3))-STEP(FWAKUX,FWAKUY),7,B
4620 NEXT I
4630 FFAST=FAST+16
4640 FOR I=6 TO 10
4650 LINE(MAP(FAST2+(FKAN+FWAKUX)*(I-1),2),MAP(399-FWAKUY,3))-STEP(FWAKUX,FWAKUY),7,B
4660 NEXT I
4670 FFAST=FAST1
4680 PUT@ (FFAST                   +2,401-FWAKUY),KANJI(&H434F),PSET,7,1 '地
4690 PUT@ (FFAST                +16+2,401-FWAKUY),KANJI(&H3C34),PSET,7,1 '軸
4700 PUT@ (FFAST+(FKAN+FWAKUX)     +2,401-FWAKUY),KANJI(&H305E),PSET,7,1 '緯
4710 PUT@ (FFAST+(FKAN+FWAKUX)  +16+2,401-FWAKUY),KANJI(&H4559),PSET,7,1 '度
4720 PUT@ (FFAST+(FKAN+FWAKUX)*2+   2,401-FWAKUY),KANJI(&H3750),PSET,7,1 '経
4730 PUT@ (FFAST+(FKAN+FWAKUX)*2+16+2,401-FWAKUY),KANJI(&H4559),PSET,7,1 '度
4740 FFAST=FAST2
4750 PUT@ (FFAST+(FKAN+FWAKUX)*5   +2,401-FWAKUY),KANJI(&H455F),PSET,7,0 '冬
4760 PUT@ (FFAST+(FKAN+FWAKUX)*5+16+2,401-FWAKUY),KANJI(&H493D),PSET,7,0 '表
4770 PUT@ (FFAST+(FKAN+FWAKUX)*6   +2,401-FWAKUY),KANJI(&H3246),PSET,7,0 '夏
4780 PUT@ (FFAST+(FKAN+FWAKUX)*6+16+2,401-FWAKUY),KANJI(&H493D),PSET,7,0 '表
4790 PUT@ (FFAST+(FKAN+FWAKUX)*7   +2,401-FWAKUY),KANJI(&H3D55),PSET,7,0 '春
4800 PUT@ (FFAST+(FKAN+FWAKUX)*7+16+2,401-FWAKUY),KANJI(&H493D),PSET,7,0 '表
4810 PUT@ (FFAST+(FKAN+FWAKUX)*8   +2,401-FWAKUY),KANJI(&H3D29),PSET,7,0 '秋
4820 PUT@ (FFAST+(FKAN+FWAKUX)*8+16+2,401-FWAKUY),KANJI(&H493D),PSET,7,0 '表
4830 PUT@ (FFAST+(FKAN+FWAKUX)*9   +2,401-FWAKUY),KANJI(&H3D2A),PSET,7,0 '終
4840 PUT@ (FFAST+(FKAN+FWAKUX)*9+16+2,401-FWAKUY),KANJI(&H246A),PSET,7,0 'り
4850 RETURN
4860 '
4870 '
4880 '********* ファンクションキーのセット ***********
4890 *FKEY0
4900 KEY 1,"load "+CHR$(&H22):KEY 2,"auto":KEY 3,"go to":KEY 4,"list ":KEY 5,"run"+CHR$(13):KEY 6,"save "+CHR$(&H22):KEY 7,"key":KEY 8,"print ":KEY 9,"edit ."+CHR$(13):KEY 10,"cont"+CHR$(13)
4910 RETURN
4920 *FKEYNUL
4930 KEY 1,"":KEY 2,"":KEY 3,"":KEY 4,"":KEY 5,"":KEY 6,"":KEY 7,"":KEY 8,"":KEY 9,"":KEY 10,""
4940 RETURN