90 lines
2.5 KiB
Plaintext
90 lines
2.5 KiB
Plaintext
! TRANSLATION OF FREEBASIC VERSION ;
|
|
BEGIN
|
|
|
|
INTEGER PROCEDURE WD(M, D, Y); INTEGER M, D, Y;
|
|
BEGIN
|
|
! 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 ;
|
|
BEGIN
|
|
M := M + 12;
|
|
Y := Y - 1
|
|
END;
|
|
WD := MOD(Y + (Y // 4)
|
|
- (Y // 100)
|
|
+ (Y // 400)
|
|
+ D + ((153 * M + 8) // 5), 7)
|
|
END WD;
|
|
|
|
! ------=< MAIN >=------
|
|
! ONLY MONTHS WITH 31 DAY CAN HAVE FIVE WEEKENDS
|
|
! THESE MONTHS ARE: JANUARY, MARCH, MAY, JULY, AUGUST, OCTOBER, DECEMBER
|
|
! IN NR: 1, 3, 5, 7, 8, 10, 12
|
|
! THE 1E DAY NEEDS TO BE ON A FRIDAY (= 5)
|
|
;
|
|
|
|
TEXT PROCEDURE MONTHNAMES(M); INTEGER M;
|
|
MONTHNAMES :- IF M = 1 THEN "JANUARY"
|
|
ELSE IF M = 2 THEN "FEBRUARY"
|
|
ELSE IF M = 3 THEN "MARCH"
|
|
ELSE IF M = 4 THEN "APRIL"
|
|
ELSE IF M = 5 THEN "MAY"
|
|
ELSE IF M = 6 THEN "JUNE"
|
|
ELSE IF M = 7 THEN "JULY"
|
|
ELSE IF M = 8 THEN "AUGUST"
|
|
ELSE IF M = 9 THEN "SEPTEMBER"
|
|
ELSE IF M = 10 THEN "OCTOBER"
|
|
ELSE IF M = 11 THEN "NOVEMBER"
|
|
ELSE IF M = 12 THEN "DECEMBER"
|
|
ELSE NOTEXT;
|
|
|
|
INTEGER M, YR, TOTAL, I, J;
|
|
INTEGER ARRAY YR_WITHOUT(1:200);
|
|
TEXT ANSWER;
|
|
|
|
FOR YR := 1900 STEP 1 UNTIL 2100 DO ! GREGORIAN CALENDAR ;
|
|
BEGIN
|
|
ANSWER :- NOTEXT;
|
|
FOR M := 1 STEP 2 UNTIL 12 DO
|
|
BEGIN
|
|
IF M = 9 THEN M := 8;
|
|
IF WD(M, 1, YR) = 5 THEN
|
|
BEGIN
|
|
ANSWER :- ANSWER & MONTHNAMES(M) & ", ";
|
|
TOTAL := TOTAL + 1
|
|
END
|
|
END;
|
|
IF ANSWER =/= NOTEXT THEN
|
|
BEGIN
|
|
OUTIMAGE;
|
|
OUTINT(YR, 4); OUTTEXT(" | ");
|
|
OUTTEXT(ANSWER.SUB(1, ANSWER.LENGTH - 2)) ! GET RID OF EXTRA " ," ;
|
|
END
|
|
ELSE
|
|
BEGIN
|
|
I := I + 1;
|
|
YR_WITHOUT(I) := YR
|
|
END
|
|
END;
|
|
|
|
OUTIMAGE;
|
|
OUTTEXT("NR OF MONTH FOR 1900 TO 2100 THAT HAS FIVE WEEKENDS ");
|
|
OUTINT(TOTAL, 0);
|
|
OUTIMAGE;
|
|
OUTIMAGE;
|
|
OUTINT(I, 0);
|
|
OUTTEXT(" YEARS DON'T HAVE MONTHS WITH FIVE WEEKENDS");
|
|
OUTIMAGE;
|
|
|
|
FOR J := 1 STEP 1 UNTIL I DO
|
|
BEGIN
|
|
OUTINT(YR_WITHOUT(J), 0); OUTCHAR(' ');
|
|
IF MOD(J, 8) = 0 THEN OUTIMAGE
|
|
END;
|
|
OUTIMAGE
|
|
|
|
END.
|