|
<![CDATA[
10 ' save "BIO.BAS",a '1987.10.25 GB200 Y.MIYAMOTO
20 CONSOLE 0,25:WIDTH 80,25 :color 7,0:CLS
30 DIM TUKI.N(2,12),TUKI.S(2,12),S.WEEK(12) ,D$(30)
40 RESTORE 50
50 FOR I=0 TO 6:READ WEEK$(I):NEXT I : DATA "日","月","火","水","木","金","土"
60 NENGO$(3)="平成":NENGO$(0)="昭和":NENGO$(1)="大正":NENGO$(2)="明治"
70 NENGO(3)=1988:NENGO(0)=1925:NENGO(1)=1911:NENGO(2)=1867
80 DM=VAL(LEFT$(DATE$,2))
90 IF DM>90 THEN C.NEN$="19"+LEFT$(DATE$,2):C.NEN=VAL(C.NEN$)
100 IF DM<=90 THEN C.NEN$="20"+LEFT$(DATE$,2):C.NEN=VAL(C.NEN$)
110 C.TUKI=VAL(MID$(DATE$,4,2)):HI$=RIGHT$(DATE$,2)
120 GOSUB *BIO.HYOU
130 YMD$=RIGHT$(STR$(C.NEN*100+C.TUKI),6)
140 LOCATE 0,23:PRINT STRING$(78,"-");
150 LOCATE 0,24:PRINT USING " & &年&&月";LEFT$(YMD$,4),RIGHT$(YMD$,2);
160 I=6:GOSUB *TUKI.IN:ME=1:gosub *MENU.1
170 cls:end
180 '-
190 *TUKI.IN
200 IF I<1 THEN I=1
210 IF I>6 THEN I=6
220 II=(I\5)*2
230 LOCATE 0,24:PRINT USING " & &年&&月";LEFT$(YMD$,4),RIGHT$(YMD$,2);
240 LOCATE I+II,24:color 0,7:print MID$(YMD$,I,1);:color 7,0:IN$=INPUT$(1)
250 IF IN$=CHR$(13) THEN 300
260 IF IN$=>"0" AND IN$<="9" THEN MID$(YMD$,I,1)=IN$:I=I+1
270 IF IN$=CHR$(28) THEN I=I+1
280 IF IN$=CHR$(29) THEN I=I-1
290 GOTO 200
300 LOCATE 0,24:PRINT USING " & &年&&月";LEFT$(YMD$,4),RIGHT$(YMD$,2);
310 C.NEN$=LEFT$(YMD$,4) :C.TUKI$=RIGHT$(YMD$,2)
320 C.NEN=VAL(C.NEN$):C.TUKI=VAL(C.TUKI$)
330 IF C.TUKI<1 OR C.TUKI>12 THEN BEEP:GOTO *tuki.in
340 RETURN
350 '-
360 '------------
370 *BIO.HYOU
380 CONSOLE 0,25,0,1:WIDTH 80,25
390 LOCATE 70,0:PRINT"Qpon Soft";
400 COLOR 4:LOCATE 27,2:PRINT USING "####年";C.NEN;:PRINT USING "##月";C.TUKI;:PRINT "バイオリズム"
410 LOCATE 46,4 :COLOR 6
420 PRINT "◎=身体 ";:COLOR 5:PRINT "△=感情 ";:COLOR 4:PRINT "◇=知性"
430 LOCATE 4,5 :COLOR 7
440 PRINT "┏┯┯┯┯┯┯┯┯┯┯┯┯┯┯┯┯┯┯┯┯┯┯┯┯┯┯┯┯┯┯┯┓"
450 FOR GI=1 TO 11
460 COLOR 7:LOCATE 4,GI+5
470 PRINT "┠┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┼┨"
480 NEXT GI
490 COLOR 7:LOCATE 4,17
500 PRINT "┗┷┷┷┷┷┷┷┷┷┷┷┷┷┷┷┷┷┷┷┷┷┷┷┷┷┷┷┷┷┷┷┛"
510 COLOR 1:LOCATE 4,11
520 PRINT "┣┿┿┿┿┿┿┿┿┿┿┿┿┿┿┿┿┿┿┿┿┿┿┿┿┿┿┿┿┿┿┿┫"
530 LOCATE 4,18 :COLOR 7
540 PRINT " 5 10 15 20 25 30 "
550 LOCATE 0,23:PRINT STRING$(78,"-");
560 RETURN
570 '--
580 *MENU.1
590 GOSUB *BIO.HYOU
600 '----
610 LOCATE 6,21:PRINT"[<┘] = おわり";
620 LOCATE 6,4:PRINT"氏名 ";:line INPUT NAMAE$
630 LOCATE 6,21:PRINT" ";
640 IF NAMAE$="" THEN RETURN
650 '--
660 NENGO=0 :IN$="":DT$="":UMARE$=" " :P=1
670 GOSUB *YMD
680 UMARE=VAL(UMARE$)
690 ME.A=2:GRF.ME=1
691 DMY.Y=Y:DMY.X=X:DMY.IN$=IN$
692 GOSUB *BIO.NEN
693 IF TUKI<1 OR TUKI>12 THEN 690
694 IF HI<1 OR HI>31 THEN 690
695 GOSUB *BIO.KEISAN
696 GOSUB *BIO.GRF
710 locate 0,24:print "ok=[＜┘]";:yn$=input$(1)
770 GOTO *MENU.1
780 '--
790 *YMD
800 IF NENGO>3 THEN NENGO=0
810 IF NENGO<0 THEN NENGO=3
820 IF P<1 THEN P=1
830 IF P>6 THEN P=6
840 PP=((P-1)\2)*2
850 LOCATE 4,24:PRINT"生年月日 ";NENGO$(NENGO);
860 PRINT USING "&&年&&月&&日";MID$(UMARE$,1,2),MID$(UMARE$,3,2),MID$(UMARE$,5,2);
870 LOCATE 46,24:PRINT"[↓]=年号変更";
880 LOCATE 0,23: PRINT STRING$(78,"-");
890 LOCATE 17+P+PP,24:color 0,7:print MID$(UMARE$,P,1);:color 7,0:A$=INPUT$(1)
900 IF A$=CHR$(30) THEN NENGO=NENGO-1
910 IF A$=CHR$(31) THEN NENGO=NENGO+1
920 IF A$=CHR$(28) THEN P=P+1
930 IF A$=CHR$(29) THEN P=P-1
940 IF A$=>"0" AND A$<="9" THEN MID$(UMARE$,P,1)=A$:P=P+1
950 IF A$=" " THEN MID$( UMARE$,P,1)=A$:P=P+1
960 IF A$<>CHR$(13) THEN 800
970 'PRINT USING "&&年&&月&&日";MID$(UMARE$,1,2),MID$(UMARE$,3,2),MID$(UMARE$,5,2);
980 return
990 '-------
1000 *BIO.GRF
1010 GOSUB *BIO.HYOU
1020 COLOR 7,0:LOCATE 6,4:PRINT "氏名 ";:COLOR 5:PRINT NAMAE$ ;" ";
1030 LOCATE 10,20:PRINT USING " ####年##月##日 &&";U.NEN,TUKI,HI,WEEK$(U.WEEK);
1035 PRINT "曜日 生";
1040 TOTAL.HI=(T.DAY+ TUKI.S(0,C.TUKI-1)+1)-(U.DAY+TUKI.S(1,TUKI-1)+HI)
1050 COLOR 4,0:LOCATE 40,20:PRINT "月初現在生存日数";
1060 COLOR 3,0:PRINT USING " ##,###日";TOTAL.HI
1070 FOR GI=1 TO TUKI.N(0,C.TUKI)
1080 TOTAL.HI=(T.DAY+ TUKI.S(0,C.TUKI-1)+GI )-(U.DAY+ TUKI.S(1,TUKI-1)+HI)
1090 GOSUB *BIO.GRF.1
1100 NEXT GI
1110 COLOR 7,0:RETURN
1120 '---------------
1130 *BIO.GRF.1
1140 BIO.HI=TOTAL.HI:IF BIO.HI>32000 THEN BIO.HI=TOTAL.HI-(33*28*23)
1150 TISEI = COS((( BIO.HI MOD 33)/33)*6.28+1.57)*6 +4
1160 KANZYO= COS((( BIO.HI MOD 28)/28)*6.28+1.57)*6 +4
1170 SINTAI= COS((( BIO.HI MOD 23)/23)*6.28+1.57)*6 +4
1180 COLOR 4,0:LOCATE GI*2+4,FIX(TISEI )+7:PRINT "◇";
1190 COLOR 5,0:LOCATE GI*2+4,FIX(KANZYO )+7:PRINT "△";
1200 COLOR 6,0:LOCATE GI*2+4,FIX(SINTAI )+7:PRINT "◎";
1210 RETURN
1220 '---------------
1230 '*BIO.SUB
1240 'DMY.Y=Y:DMY.X=X:DMY.IN$=IN$
1250 'GOSUB *BIO.NEN
1260 'GOSUB *BIO.KEISAN
1270 'GOSUB *BIO.GRF
1280 'return
1290 '--
1300 *BIO.NEN
1310 U.NEN$=LEFT$(UMARE$,2) :TUKI$=MID$(UMARE$,3,2):HI$=RIGHT$(UMARE$,2)
1320 U.NEN=VAL(RIGHT$(U.NEN$,2 ))+NENGO(NENGO)
1330 TUKI=VAL(TUKI$):HI=VAL(HI$):C.NEN=VAL(C.NEN$)
1340 IF C.NEN<100 THEN C.NEN=C.NEN+1925
1370 U.NEN$=STR$(U.NEN)+"年"
1380 RETURN
1390 '----------
1400 *BIO.KEISAN
1410 RESTORE 1430
1420 FOR BI=1 TO 12:READ TUKI.N(0,BI):TUKI.N (1,BI)=TUKI.N(0,BI):NEXT BI
1430 DATA 31,28,31,30,31,30,31,31,30,31,30,31
1440 '--------
1450 URU=(C.NEN-1)\4-(C.NEN-1)\100+(C.NEN-1)\400 '0~年初
1460 U.URU=(U.NEN-1)\4-(U.NEN-1)\100+(U.NEN-1)\400 '0~生年初
1470 T.DAY=(C.NEN-1)*365+URU+1 '0~年初日数
1480 U.DAY=(U.NEN-1)*365+U.URU+1 '0~生年初日数
1490 S.WEEK(0)=T.DAY-INT(T.DAY / 7 )*7 '年初曜日
1500 U.WEEK(0)=U.DAY-INT(U.DAY / 7 )*7 '生年初曜日
1510 URU.1=(C.NEN)\4-(C.NEN)\100+(C.NEN)\400 '0~年末
1520 U.URU.1=(U.NEN)\4-(U.NEN)\100+(U.NEN)\400 '0~生年末
1530 IF URU.1>URU THEN TUKI.N(0,2)=29 ELSE TUKI.N(0,2)=28 '2月日数
1540 IF U.URU.1>U.URU THEN TUKI.N(1,2)=29 ELSE TUKI.N(1,2)=28 '生年2月日数
1550 '
1560 '----------
1570 FOR BI=1 TO 12:TUKI.S(0,BI)=TUKI.S(0,BI-1)+TUKI.N(0,BI):NEXT BI
1580 FOR BI=1 TO 12:TUKI.S(1,BI)=TUKI.S(1,BI-1)+TUKI.N(1,BI):NEXT BI
1590 FOR BI=1 TO 12:S.WEEK(BI)=(S.WEEK(0)+TUKI.S(0,BI-1)) MOD 7 :NEXT BI
1600 U.WEEK = (U.WEEK(0)+TUKI.S(1,TUKI-1)+HI-1) MOD 7
1610 RETURN
]]>
|