( Example 11.  Calendars )

( Print monthly calendars for any month in years 1950-2128. )
DECIMAL

VARIABLE JULIAN                         ( 0 is 1/1/1950, good until 2050 )
VARIABLE LEAP                           ( 1 for a leap year, 0 otherwise. )
( 1461 CONSTANT 4YEARS                  ( number of days in 4 years )

: YEAR ( YEAR --, compute Julian date and leap year )
        DUP
        1949 - 1461 4 */MOD             ( days since 1/1/1949 )
        365 - JULIAN !                  ( 0 for 1/1/1950 )
        3 =                             ( modulus 3 for a leap year )
        IF 1 ELSE 0 THEN                ( leap year )
        LEAP !
        DUP 2000 =                      ( 2000 is not a leap year )
        IF 0 LEAP ! THEN
	2000 >				( adjust due to year 2000 )
	IF ELSE -1 JULIAN +! THEN
        ;

: FIRST ( MONTH -- 1ST, 1st of a month from Jan. 1 )
        DUP 1 =
        IF DROP 0 EXIT THEN             ( 0 for Jan. 1 )
        DUP 2 =
        IF DROP 31 EXIT THEN            ( 31 for Feb. 1 )
        DUP 3 =
        IF DROP 59 LEAP @ + EXIT THEN   ( 59/60 for Mar. 1 )
        4 - 30624 1000 */
        90 + LEAP @ +                   ( Apr. 1 to Dec. 1 )
        ;

: STARS 60 FOR 42 EMIT NEXT ;           ( form the boarder )

: HEADER ( -- )                         ( print title bar )
        CR STARS CR 
        ."      SUN     MON     TUE     WED     THU     FRI     SAT"
        CR STARS CR                     ( print weekdays )
        ;

: BLANKS ( MONTH -- )                   ( skip days not in this month )
        FIRST JULIAN @ +                ( Julian date of 1st of month )
        7 MOD 8 * SPACES ;              ( skip colums if not Sunday   )

: DAYS ( MONTH -- )                     ( print days in a month )
        DUP FIRST                       ( days of 1st this month )
        SWAP 1 + FIRST                  ( days of 1st next month )
        OVER - 1 -                      ( loop to print the days )
        1 SWAP                          ( first day count -- )
        FOR  2DUP + 1 -
                JULIAN @ + 7 MOD        ( which day in the week? )
                IF ELSE CR THEN         ( start a new line if Sunday )
                DUP  8 U.R              ( print day in 8 column field )
                1 +
        NEXT
        2DROP ;                         ( discard 1st day in this month )

: MONTH ( N -- )                        ( print a month calendar )
        HEADER DUP BLANKS               ( print header )
        DAYS CR STARS CR ;              ( print days   )

: JANUARY       YEAR 1 MONTH ;
: FEBRUARY      YEAR 2 MONTH ;
: MARCH         YEAR 3 MONTH ;
: APRIL         YEAR 4 MONTH ;
: MAY           YEAR 5 MONTH ;
: JUNE          YEAR 6 MONTH ;
: JULY          YEAR 7 MONTH ;
: AUGUST        YEAR 8 MONTH ;
: SEPTEMBER     YEAR 9 MONTH ;
: OCTOBER       YEAR 10 MONTH ;
: NOVEMBER      YEAR 11 MONTH ;
: DECEMBER      YEAR 12 MONTH ;

\ To print the calender of April 1999, type:
\        2011 APRIL

flush