!                ********************************
!                *  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

You are viewing proxied material from gopher.floodgap.com. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.