%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
   %ROUTINE define(%STRING (255) s)
      %EXTERNALROUTINESPEC emas3(%STRINGNAME command,params, %INTEGERNAME flag)
      %INTEGER flag
      emas3("DEFINE",s,flag)
   %END;                                 ! Of %ROUTINE define.
   %EXTERNALROUTINESPEC prompt %ALIAS "S#PROMPT"(%STRING (255) 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)."           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 %alias "c#deskcal"(%STRING (255) 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)
   %RECORD (spacingf) %NAME SPACING
   %OWNINTEGERARRAY NORMAL(0:3)=49, 5, 7, 113
   %OWNINTEGERARRAY DOUBLE(0:3)=21, 1, 3, 57
                                         !!
   %ROUTINESPEC BIG
   %ROUTINESPEC BAR
                                         !!
   %ROUTINE define(%STRING (255) s)
      %EXTERNALROUTINESPEC emas3(%STRINGNAME command,params, %INTEGERNAME flag)
      %INTEGER flag
      emas3("DEFINE",s,flag)
   %END;                                 ! Of %ROUTINE define.
   %EXTERNALROUTINESPEC prompt %ALIAS "S#PROMPT"(%STRING (255) 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("I     MONDAY    I    TUESDAY    I   WEDNESDAY   ". %C
            "I    THURSDAY   I     FRIDAY    I    SATURDAY". %C
            "   I     SUNDAY    I
")
      %FINISHELSESTART
         BIG
         PRINTSTRING("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)
   %RECORD (spacingf) %NAME SPACING
   %OWNINTEGERARRAY NORMAL(0:3)=37, 3, 5, 85
   %OWNINTEGERARRAY DOUBLE(0:3)=21, 1, 3, 57
                                         !!
   %ROUTINESPEC BIG
   %ROUTINESPEC BAR
                                         !!
   %ROUTINE define(%STRING (255) s)
      %EXTERNALROUTINESPEC emas3(%STRINGNAME command,params, %INTEGERNAME flag)
      %INTEGER flag
      emas3("DEFINE",s,flag)
   %END;                                 ! Of %ROUTINE define.
   %EXTERNALROUTINESPEC prompt %ALIAS "S#PROMPT"(%STRING (255) 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("I   MONDAY  I  TUESDAY  I WEDNESDAY ". %C
            "I  THURSDAY I   FRIDAY  I  SATURDAY"." I   SUNDAY  I")
      %FINISHELSESTART
         BIG
         PRINTSTRING("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