RosettaCodeData/Task/Calendar---for-REAL-program.../FreeBASIC/calendar---for-real-program...

98 lines
2.3 KiB
Plaintext

' VERSION 16-03-2016
' COMPILE WITH: FBC -S CONSOLE
' TRUE/FALSE ARE BUILT-IN CONSTANTS SINCE FREEBASIC 1.04
' BUT WE HAVE TO DEFINE THEM FOR OLDER VERSIONS.
#IFNDEF TRUE
#DEFINE FALSE 0
#DEFINE TRUE NOT FALSE
#ENDIF
FUNCTION WD(M AS INTEGER, D AS INTEGER, Y AS INTEGER) AS INTEGER
' ZELLERISH
' 0 = SUNDAY, 1 = MONDAY, 2 = TUESDAY, 3 = WEDNESDAY
' 4 = THURSDAY, 5 = FRIDAY, 6 = SATURDAY
IF M < 3 THEN ' IF M = 1 OR M = 2 THEN
M += 12
Y -= 1
END IF
RETURN (Y + (Y \ 4) - (Y \ 100) + (Y \ 400) + D + ((153 * M + 8) \ 5)) MOD 7
END FUNCTION
FUNCTION LEAPYEAR(Y AS INTEGER) AS INTEGER
IF (Y MOD 4) <> 0 THEN RETURN FALSE
IF (Y MOD 100) = 0 ANDALSO (Y MOD 400) <> 0 THEN RETURN FALSE
RETURN TRUE
END FUNCTION
' ------=< MAIN >=------
' HARD CODED FOR 132 CHARACTERS PER LINE
DIM AS STRING WDN = "MO TU WE TH FR SA SU" ' WEEKDAY NAMES
DIM AS STRING MO(1 TO 12) => {"JANUARY", "FEBRUARY", "MARCH", "APRIL", _
"MAY", "JUNE", "JULY", "AUGUST", "SEPTEMBER", _
"OCTOBER", "NOVEMBER", "DECEMBER"}
DIM AS STRING TMP1, TMP2, D(1 TO 12)
DIM AS UINTEGER ML(1 TO 12) => {31,28,31,30,31,30,31,31,30,31,30,31}
DIM AS UINTEGER I, I1, J, K, Y = 1969
'SCREENRES 1080,600,8
IF LEAPYEAR(Y) = TRUE THEN ML(2) = 29
TMP1 = ""
FOR I = 1 TO 31
TMP1 = TMP1 + RIGHT((" " + STR(I)), 3)
NEXT I
FOR I = 1 TO 12
TMP2 = ""
J = WD(I,1, Y)
IF J = 0 THEN J = 7
J = J - 1
TMP2 = SPACE(J * 3) + LEFT(TMP1, ML(I) * 3) + SPACE(21)
D(I) = TMP2
NEXT I
PRINT
TMP1 = "INSERT YOUR SNOOPY PICTURE HERE"
PRINT SPACE((132 - LEN(TMP1)) \ 2); TMP1
PRINT
TMP1 = STR(Y)
PRINT SPACE((132 - LEN(TMP1)) \ 2); TMP1
PRINT
' 6 MONTH ON A ROW
TMP2 = " "
FOR I = 1 TO 6
TMP2 = TMP2 + WDN
IF I < 6 THEN TMP2 = TMP2 + " "
NEXT I
FOR I = 1 TO 12 STEP 6
TMP1 = ""
FOR J = I TO I + 4
TMP1 = TMP1 + LEFT(SPACE((22 - LEN(MO(J))) \ 2) + MO(J) + SPACE(11), 22)
NEXT J
TMP1 = TMP1 + SPACE((22 - LEN(MO(I + 5))) \ 2) + MO(I + 5)
PRINT TMP1
PRINT TMP2
FOR J = 1 TO 85 STEP 21
FOR K = I TO I + 4
PRINT MID(D(K), J ,21); " ";
NEXT K
PRINT MID(D(I + 5), J ,21)
NEXT J
PRINT
NEXT I
' EMPTY KEYBOARD BUFFER
WHILE INKEY <> "" : WEND
PRINT : PRINT "HIT ANY KEY TO END PROGRAM"
SLEEP
END