RosettaCodeData/Task/Calendar---for-REAL-program.../BBC-BASIC/calendar---for-real-program...

48 lines
1.5 KiB
Plaintext

VDU 23,22,1056;336;8,16,16,128
YEAR = 1969
PRINT TAB(62) "[SNOOPY]" TAB(64); YEAR
DIM DOM(5), MJD(5), DM(5), MONTH$(11)
DAYS$ = "SU MO TU WE TH FR SA"
MONTH$() = "JANUARY", "FEBRUARY", "MARCH", "APRIL", "MAY", "JUNE", \
\ "JULY", "AUGUST", "SEPTEMBER", "OCTOBER", "NOVEMBER", "DECEMBER"
FOR MONTH = 1 TO 7 STEP 6
PRINT
FOR COL = 0 TO 5
MJD(COL) = FNMJD(1, MONTH + COL, YEAR)
MONTH$ = MONTH$(MONTH + COL - 1)
PRINT TAB(COL*22 + 11 - LEN(MONTH$)/2) MONTH$;
NEXT
FOR COL = 0 TO 5
PRINT TAB(COL*22 + 1) DAYS$;
DM(COL) = FNDIM(MONTH + COL, YEAR)
NEXT
DOM() = 1
COL = 0
REPEAT
DOW = FNDOW(MJD(COL))
IF DOM(COL)<=DM(COL) THEN
PRINT TAB(COL*22 + DOW*3 + 1); DOM(COL);
DOM(COL) += 1
MJD(COL) += 1
ENDIF
IF DOW=6 OR DOM(COL)>DM(COL) COL = (COL + 1) MOD 6
UNTIL DOM(0)>DM(0) AND DOM(1)>DM(1) AND DOM(2)>DM(2) AND \
\ DOM(3)>DM(3) AND DOM(4)>DM(4) AND DOM(5)>DM(5)
PRINT
NEXT
END
DEF FNMJD(D%,M%,Y%) : M% -= 3 : IF M% < 0 M% += 12 : Y% -= 1
= D% + (153*M%+2)DIV5 + Y%*365 + Y%DIV4 - Y%DIV100 + Y%DIV400 - 678882
DEF FNDOW(J%) = (J%+2400002) MOD 7
DEF FNDIM(M%,Y%)
CASE M% OF
WHEN 2: = 28 + (Y%MOD4=0) - (Y%MOD100=0) + (Y%MOD400=0)
WHEN 4,6,9,11: = 30
OTHERWISE = 31
ENDCASE