!                ********************************
!                *  PROGRAM TO GET DAY OF WEEK  *
!                *         FOR ANY DATE         *
!                *      AND (OPTIONALLY) A      *
!                *    CALENDAR FOR THE YEAR     *
!                *                              *
!                *   BASED UPON BHAIRAV JOSHI   *
!                *    ALGORITHM PUBLISHED IN    *
!                *    1/14/80 COMPUTER WORLD    *
!                *                              *
!                *   THIS IS THE RESULT OF A    *
!                *   STUDY OF THE PRINCIPLES    *
!                *  OF THE GREGORIAN CALENDAR   *
!                *                              *
!                *   DATA PRODUCED SHOULD BE    *
!                *  ACCURATE OVER THE INTERVAL  *
!                *   YEAR ZERO A.D. TO ABOUT    *
!                *          3000 A.D.           *
!                *                              *
!                *  PROGRAMMED BY  E. WILLIAMS  *
!                *      FEBRUARY  17, 1980      *
!                ********************************
!
!  Tidy up displays 
!  Allow lower case input
!  Give the option to print immediately, or just make a file
!  11/04/87 Steve Elliott
!
!
MAP1 DAPRMO(12),F
   DAPRMO(1)  = 31 : DAPRMO(2)  = 28 : DAPRMO(3)  = 31 : DAPRMO(4)  = 30
   DAPRMO(5)  = 31 : DAPRMO(6)  = 30 : DAPRMO(7)  = 31 : DAPRMO(8)  = 31
   DAPRMO(9)  = 30 : DAPRMO(10) = 31 : DAPRMO(11) = 30 : DAPRMO(12) = 31
MAP1 DAOFWK(7),S,9
   DAOFWK(1) = "Saturday" : DAOFWK(2) = "Sunday"    : DAOFWK(3) = "Monday"
   DAOFWK(4) = "Tuesday"  : DAOFWK(5) = "Wednesday" : DAOFWK(6) = "Thursday"
   DAOFWK(7) = "Friday"
MAP1 TITLE(4),S,74
   TITLE(1) = "        January                      February                      March"
   TITLE(2) = "         April                         May                          June"
   TITLE(3) = "          July                        August                     September"
   TITLE(4) = "        October                      November                     December"
MAP1 HDR,S,22,"   S  M  T  W  T  F  S"
MAP1 MONTH(3,42),S,2
MAP1 PLINE,S,80," "
MAP1 DECIS,S,3
   !
BEGIN:
   PRINT TAB(-1,0)
   PRINT " This program will give the day of the week for any date" : PRINT
   PRINT  "  and print out a calendar for the entire year if you like" : PRINT
   PRINT " What date would you like to select? (year 0 will end the program)" : PRINT
   !
INPYR:
   YEAR = 0 : MONTH = 0 : DAY = 0
   INPUT " Enter the year as a number (ex. 1980)      ",YEAR
   IF YEAR = 0 THEN GOTO QUIT
   IF (YEAR < 0) THEN PRINT "ILLEGAL YEAR" : GOTO INPYR ELSE PRINT
   IF (YEAR/4    - INT(YEAR/4))    = 0 THEN LPYR = 1 ELSE LPYR = 0
   IF (YEAR/100  - INT(YEAR/100))  = 0 THEN LPYR = LPYR - 1
   IF (YEAR/400  - INT(YEAR/400))  = 0 THEN LPYR = LPYR + 1
   IF (YEAR/4000 - INT(YEAR/4000)) = 0 THEN LPYR = LPYR - 1
   IF (LPYR = 1) THEN DAPRMO(2) = 29 ELSE DAPRMO(2) = 28
   !
INPMTH:
   INPUT " Enter the month as a number (1 to 12)      ",MONTH
   IF (MONTH<1 OR MONTH>12) THEN PRINT "ILLEGAL MONTH" : GOTO INPMTH ELSE PRINT
   !
INPDAY:
   INPUT " Enter the day of the month as a number     ",DAY
   IF (DAY<1 OR DAY>DAPRMO(MONTH)) THEN PRINT "ILLEGAL DAY" : GOTO INPDAY ELSE PRINT
   CALL CALC
   PRINT " The date ";MONTH;"/";DAY;"/";YEAR;
   PRINT "will fall on a ";DAOFWK(TOTDYS) : PRINT : PRINT : PRINT
   INPUT "Would you like a calendar for the whole year?  ",DECIS
   DECIS = UCS(DECIS[1,1])
   IF DECIS <> "Y" THEN GOTO BEGIN
   ? "One moment while I generate the calendar";
   OPEN #1,"DAYCAL.PRT",OUTPUT
   POSITION = 0 : MONTH = 1 : DAY = 1 : CALL CALC
   FOR I = 1 TO 7 : PRINT #1 : NEXT
   ? ".";
   PRINT #1, SPACE(30);"CALENDAR  FOR YEAR ";YEAR : PRINT #1 : PRINT #1
   FOR I = 1 TO 4
   ?".";
   PRINT #1, TITLE(I): FRSTMO = 3*(I-1) + 1 : CALL PRINT
   NEXT I
   CLOSE #1
   ?
   INPUT LINE "Would you like to print it out now? ", DECIS
   DECIS = UCS(DECIS[1,1])
   IF DECIS <> "Y" &
       THEN &
           ? "The file is called DAYCAL.PRT and is ready for your inspection" :&
           CALL PAUSE &
       ELSE &
           XCALL SPOOL,"DAYCAL.PRT"
   GO TO BEGIN
   !
CALC:
   X = YEAR - 1
   TOTDYS=YEAR+DAY+INT(X/4)-INT(X/100)+INT(X/400)-INT(X/4000)+INT(X/1000)-INT(X/2000)
   IF (MONTH <> 1) THEN FOR I=1 TO MONTH-1 : TOTDYS=TOTDYS+DAPRMO(I) : NEXT I
   TOTDYS = 1 + INT(10*(7*((TOTDYS-1)/7 - INT((TOTDYS-1)/7))) + .5)/10
   RETURN
   !
PRINT:
   PRINT #1
   PRINT #1, HDR+"       "+HDR+"       "+HDR
   IF (POSITION = 0) THEN IF (TOTDYS = 1) THEN POSITION=7 ELSE POSITION=TOTDYS-1
   FOR J = FRSTMO TO FRSTMO+2
           FOR K = 1 TO POSITION-1
           MONTH(J+1-FRSTMO,K) = "  "
           NEXT K
           FOR K = 1 TO DAPRMO(J)
           MONTH(J+1-FRSTMO,POSITION+K-1) = STR(K)
           NEXT K
           Y = POSITION + K - 1
           POSITION = (POSITION+K-1) - 7*INT((POSITION+K-1.1)/7)
           FOR K = Y TO 42
           MONTH(J+1-FRSTMO,K) = "  "
           NEXT K
   NEXT J
   N = 0
   FOR J = 1 TO 6
   PRINT #1,"  ";
           FOR K = 1 TO 3
                   FOR L = 1 TO 7
                   IF (VAL(MONTH(K,L+N)>0)) THEN PLINE[3*L+29*K-31;2] = MONTH(K,L+N) USING "##"
                   NEXT L
           NEXT K
   PRINT #1, PLINE
   PLINE = " "
   N = N + 7
   NEXT J
   PRINT #1 : PRINT #1
   RETURN
   END
   !

QUIT:
   ? TAB(23,1);
   END

PAUSE:
   ? TAB(23,1); TAB(-1,10); 
   INPUT LINE "Hit RETURN to continue --> ", DECIS
   ? tab(23,1); tab(-1,10);
   RETURN