%INTEGERFN INITIALDAY(%INTEGER YEAR)
      %OWNINTEGER INITIAL = 0;          ! BASE IN 1973
      %INTEGER X
      X = (INITIAL+YEAR-1973+(YEAR-1973)//4)
      %WHILE X > 7 %CYCLE
         X = X-7
      %REPEAT
      %RESULT = X
%END

%EXTERNALROUTINE CALENDAR(%STRING (63)S)
       %INTEGER I, YEAR, DAY
       %OWNINTEGER INITIAL = 0;        !BASE IN 1973
       %OWNSTRING (9) %ARRAY MONTH(1:12) = %C
       'JANUARY  ', 'FEBRUARY ', 'MARCH    ', 'APRIL    ',
       'MAY      ', 'JUNE     ', 'JULY     ', 'AUGUST   ',
       'SEPTEMBER', 'OCTOBER  ', 'NOVEMBER ', 'DECEMBER '
       %OWNBYTEINTEGERARRAY DAYS(1:12) = %C
       31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31
       %EXTERNALROUTINESPEC DEFINE(%STRING (63)S)
       %EXTERNALROUTINESPEC PROMPT(%STRING (15)S)
       PROMPT('YEAR?')
       READ(YEAR)
       %IF S = '' %THEN S = '.LP'
       DEFINE('ST1,'.S)
       SELECT OUTPUT(1)
       NEWPAGE
       PRINTSTRING( '
                  CALENDAR FOR YEAR')
       WRITE(YEAR, 1)
       INITIAL = INITIALDAY(YEAR)
       %IF YEAR = (YEAR//4)*4 %THEN DAYS(2) = 29
       %CYCLE I = 1, 1, 12
         NEWLINES(5)
          PRINTSTRING(MONTH(I). %C
            '           MON  TUE  WED  THR  FRI  SAT  SUN
')
          DAY = 1
          SPACES(18+INITIAL*5)
          %UNTIL DAY > DAYS(I) %CYCLE
             WRITE(DAY, 4)
             DAY = DAY+1;  INITIAL = INITIAL+1
             %IF INITIAL = 7 %START
                 INITIAL = 0;  NEWLINE;  SPACES(18)
             %FINISH
          %REPEAT
       %REPEAT
       NEWPAGE
%END



%EXTERNALROUTINE DESK CAL(%STRING (63)S)
       %INTEGER I, YEAR, DAY, J, STATE, MONTH, K, LP
       %OWNINTEGER INITIAL=0;          !BASE IN 1973
       %OWNSTRING (9) %ARRAY MONTHS(1:12)= %C
       'JANUARY  ', 'FEBRUARY ', 'MARCH    ', 'APRIL    ',
       'MAY      ', 'JUNE     ', 'JULY     ', 'AUGUST   ',
       'SEPTEMBER', 'OCTOBER  ', 'NOVEMBER ', 'DECEMBER '
       %OWNBYTEINTEGERARRAY DAYS(1:12)= %C
       31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31
       %RECORDFORMAT SPACINGF(%INTEGER TITLE, PREN, POSTN, BAR)
       %RECORDNAME SPACING(SPACINGF)
       %OWNINTEGERARRAY NORMAL(0:3)=49, 5, 7, 113
       %OWNINTEGERARRAY DOUBLE(0:3)=21, 1, 3, 57
       !!
       %ROUTINESPEC BIG
       %ROUTINESPEC BAR
       !!
       %EXTERNALROUTINESPEC DEFINE(%STRING (63)S)
       %EXTERNALROUTINESPEC PROMPT(%STRING (15)S)
       !!
       PROMPT('YEAR?')
       READ(YEAR)
       PROMPT('NORMAL LP?')
       SKIPSYMBOL %WHILE NEXTSYMBOL=' ' %OR NEXTSYMBOL=NL
       READSYMBOL(LP)
       %IF LP#'N' %THEN SPACING==RECORD(ADDR(NORMAL(0))) %ELSE %C
         SPACING==RECORD(ADDR(DOUBLE(0)))
       %IF S='' %THEN S='.LP'
       DEFINE('ST1,'.S)
       SELECT OUTPUT(1)
       INITIAL=INITIALDAY(YEAR)-1
       %IF YEAR=(YEAR//4)*4 %THEN DAYS(2)=29
       %CYCLE MONTH=1, 1, 12
          NEWPAGE;  NEWLINES(4)
          BIG %IF LP='N'
          SPACES(SPACING_TITLE)
          PRINTSTRING(MONTHS(MONTH))
          WRITE(YEAR, 5)
          NEWLINES(4)
          BAR
          %IF LP#'N' %START
             PRINTSTRING( %C
               'I     MONDAY    I    TUESDAY    I   WEDNESDAY   '. %C
               'I    THURSDAY   I     FRIDAY    I    SATURDAY'. %C
               '   I     SUNDAY    I
')
          %FINISHELSESTART
             BIG
             PRINTSTRING( %C
               'I  MON  I  TUE  I  WED  I  THR  I  FRI  '. %C
               'I  SAT  I  SUN  I
')
          %FINISH
          BAR
          DAY=1;  STATE=0
          %IF INITIAL=-1 %THEN STATE=1
          %CYCLE J=0, 1, 5;            ! SIX WEEKS
             %CYCLE K=0, 1, 6;         ! 6 BLANK LINES
                BIG %IF LP='N'
                %CYCLE I=0, 1, 6;      ! 7 DAYS
                   PRINTSTRING("I");  SPACES(SPACING_PREN)
                   %IF STATE=1 %AND K=0 %START
                      WRITE(DAY, 2)
                      %IF DAY=DAYS(MONTH) %THEN STATE=2 %AND INITIAL=I
                      DAY=DAY+1
                   %FINISHELSESTART
                      PRINTSTRING( '   ')
                      %IF INITIAL=I %AND STATE=0 %THEN STATE=1
                   %FINISH
                   SPACES(SPACING_POSTN)
                %REPEAT
                PRINTSTRING("I")
               %IF K#6 %THEN NEWLINE %ELSE PRINTCH(13)
             %REPEAT
             BAR
          %REPEAT
          NEWPAGE
       %REPEAT


       %ROUTINE BIG
          !! PRINTCH(14)
       %END


       %ROUTINE BAR
          %INTEGER I
          BIG %IF LP='N'
          %CYCLE I=1, 1, SPACING_BAR
             PRINTSYMBOL('_');         ! NOTE NOT ON ENTRONICS
          %REPEAT
          NEWLINE
       %END
%END
%EXTERNALROUTINE NARROW CAL(%STRING (63)S)
       %INTEGER I, YEAR, DAY, J, STATE, MONTH, K, LP
       %OWNINTEGER INITIAL=0;          !BASE IN 1973
       %OWNSTRING (9) %ARRAY MONTHS(1:12)= %C
       'JANUARY  ', 'FEBRUARY ', 'MARCH    ', 'APRIL    ',
       'MAY      ', 'JUNE     ', 'JULY     ', 'AUGUST   ',
       'SEPTEMBER', 'OCTOBER  ', 'NOVEMBER ', 'DECEMBER '
       %OWNBYTEINTEGERARRAY DAYS(1:12)= %C
       31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31
       %RECORDFORMAT SPACINGF(%INTEGER TITLE, PREN, POSTN, BAR)
       %RECORDNAME SPACING(SPACINGF)
       %OWNINTEGERARRAY NORMAL(0:3)=37, 3, 5, 85
       %OWNINTEGERARRAY DOUBLE(0:3)=21, 1, 3, 57
       !!
       %ROUTINESPEC BIG
       %ROUTINESPEC BAR
       !!
       %EXTERNALROUTINESPEC DEFINE(%STRING (63)S)
       %EXTERNALROUTINESPEC PROMPT(%STRING (15)S)
       !!
       PROMPT('YEAR?')
       READ(YEAR)
      LP = 'Y'
       %IF LP#'N' %THEN SPACING==RECORD(ADDR(NORMAL(0))) %ELSE %C
         SPACING==RECORD(ADDR(DOUBLE(0)))
       %IF S='' %THEN S='.LP'
       DEFINE('ST1,'.S)
       SELECT OUTPUT(1)
       INITIAL=INITIALDAY(YEAR)-1
       %IF YEAR=(YEAR//4)*4 %THEN DAYS(2)=29
       %CYCLE MONTH=1, 1, 12
          NEWPAGE;  NEWLINES(4)
          BIG %IF LP='N'
          SPACES(SPACING_TITLE)
          PRINTSTRING(MONTHS(MONTH))
          WRITE(YEAR, 5)
          NEWLINES(4)
          BAR
          %IF LP#'N' %START
             PRINTSTRING( %C
               'I   MONDAY  I  TUESDAY  I WEDNESDAY '. %C
               'I  THURSDAY I   FRIDAY  I  SATURDAY'. %C
               ' I   SUNDAY  I')
          %FINISHELSESTART
             BIG
             PRINTSTRING( %C
               'I  MON  I  TUE  I  WED  I  THR  I  FRI  '. %C
               'I  SAT  I  SUN  I')
          %FINISH
         PRINTCH(13)
          BAR
          DAY=1;  STATE=0
          %IF INITIAL=-1 %THEN STATE=1
          %CYCLE J=0, 1, 5;            ! SIX WEEKS
             %CYCLE K=0, 1, 6;         ! 6 BLANK LINES
                BIG %IF LP='N'
                %CYCLE I=0, 1, 6;      ! 7 DAYS
                   PRINTSTRING("I");  SPACES(SPACING_PREN)
                   %IF STATE=1 %AND K=0 %START
                      WRITE(DAY, 2)
                      %IF DAY=DAYS(MONTH) %THEN STATE=2 %AND INITIAL=I
                      DAY=DAY+1
                   %FINISHELSESTART
                      PRINTSTRING( '   ')
                      %IF INITIAL=I %AND STATE=0 %THEN STATE=1
                   %FINISH
                   SPACES(SPACING_POSTN)
                %REPEAT
               PRINTSTRING("I")
               %IF K=6 %THEN PRINTCH(13) %ELSE NEWLINE
             %REPEAT
             BAR
          %REPEAT
       %REPEAT


       %ROUTINE BIG
          PRINTCH(14)
       %END


       %ROUTINE BAR
          %INTEGER I
          BIG %IF LP='N'
          %CYCLE I=1, 1, SPACING_BAR
             PRINTSYMBOL('_');         ! NOTE NOT ON ENTRONICS
          %REPEAT
          NEWLINE
       %END
%END
%ENDOFFILE