'=========================================================================== ' Subject: PERPETUAL CALENDAR V1.75 Date: 04-08-98 (23:37) ' Author: Andrew S. Gibson Code: QB, QBasic, PDS ' Origin: zapf_dingbat@juno.com Packet: DATETIME.ABC '=========================================================================== 'This perpetual calendar program was taken out of an old issue 'of TRS-80 MicroComputer News. I typed it in and adjusted it to 'work properly with PCs (text formatting problems..) 'I believe all major basic languages can use this code. 'Despite its size Auto Calendar *is* accurate even in leap years ! 'Also it 'sports' moving holidays ! 'Remeber if you have an Internet Connection or E-mail you can contact 'me at Zapf_DinBat@JUNO.COM. My real name is Andrew Gibson, Although 'I didn't write the code you'll probably find a working 'true Perpetual Calendar very useful every day. ' MM represents a month (numbers 1-12) ' DD represents a day (numbers 1-31) ' YY represents the year (only the last two digits i.e. 1/98) ' YYYY the full year, i.e. 1/1998 ' Typing in a specific day such as 1/25/98 (or 1/25/1998) with ' cause the program to calculate the julian date. ' The only valid separation character is the foward slash (/). ' ' Changes made by Wolf-Dieter (WDAPPELT@AOL.COM) to work all the ' rest of time. Thanks to him Easter works :> '****************************************************************************** ' ' changes in LINE 850 set to REM, LINE 840 changed sequence ' LINE 980 changed indexing name, LINE 1780 to 1870 total NEW ' '****************************************************************************** ' ' 10 DEFSNG A-Z: '<-Don't change ! / Auto Calendar Version 1.75 20 'WIDTH 40, 25: 'uncomment this so you can strain your eyes :} 30 CY$ = RIGHT$(DATE$, 4) ' EXTRACT CURRENT YEAR FROM SYSTEM CLOCK 40 yr$ = CY$ 50 DIM hol$(31) 60 ed = 99: LM = 31 70 PRINT : 'NEVER ALTER LINES 71-110 71 MH$ = "0414040303230411033104180408032804160405032504130402032204100330041704070327" 80 DY$ = "000031059090120151181212243273304334" 90 MN$ = "JANUARY FEBRUARY MARCH APRIL MAY JUNE JULY AUGUST SEPTEMBEROCTOBER NOVEMBER DECEMBER" 100 AD$ = "SUNDAY MONDAY TUESDAY WEDNESDAY THURSDAY FRIDAY SATURDAY" 110 DZ$ = " SUN MON TUE WED THU FRI SAT " 120 CLS 130 PRINT : PRINT : PRINT 140 PRINT TAB(11); "PERPETUAL CALENDAR" 150 PRINT TAB(14); "VERSION 1.75": PRINT 160 PRINT TAB(5); " ENTER A DATE (YEARS 1753- )" 170 PRINT TAB(6); "(FORMATS: MM/DD, MM/DD/YYYY," 180 PRINT TAB(6); " MM/DD/YY, MM/YYY, OR JUST MM)" 190 PRINT 200 PRINT TAB(10); "ENTER DATE OR END"; : INPUT DT$ 210 LL = LEN(DT$) 220 IF UCASE$(DT$) = "END" THEN WIDTH 80, 25: END 230 IF LL = 0 THEN 120 240 P1 = INSTR(1, DT$, "/"): P2 = INSTR(P1 + 1, DT$, "/") 250 IF P1 = 0 THEN mo = VAL(DT$): DA = 1: GOTO 320 260 mo = VAL(LEFT$(DT$, P1 - 1)) 270 IF P2 = 0 THEN 310 280 DA = VAL(MID$(DT$, P1 + 1, (P2 - 1) - P1)) 290 IF LL - P2 > 3 THEN yr$ = RIGHT$(DT$, 4) ELSE yr$ = STR$(VAL("19" + RIGHT$(DT$, 2))) 300 GOTO 320 310 IF LL - P1 > 3 THEN yr$ = RIGHT$(DT$, 4): DA = 1 ELSE yr$ = CY$: DA = VAL(RIGHT$(DT$, LL - P1)) 320 yr = VAL(yr$) 330 IF LL < 5 AND yr$ = CY$ AND mo < 1 THEN yr = yr + 1: yr$ = LTRIM$(STR$(yr)) 340 IF yr < 1753 AND SW = 0 THEN GOSUB 1200 350 IF mo > 12 OR mo < 1 THEN DA = 1: GOTO 1140 360 IF DA < 1 THEN 1140 370 LP = 0 380 IF (yr / 100 - INT(yr / 100)) = 0 THEN I = INT(yr / 400) * 400 ELSE I = INT(yr / 4) * 4 390 IF I = yr THEN LP = 1 400 LD = 365 + LP 410 IF mo = 2 THEN 450 420 IF mo = 4 OR mo = 6 OR mo = 9 OR mo = 11 THEN 480 430 IF DA > 31 THEN yr$ = STR$(VAL("19" + STR$(DA))) 440 LM = 31: GOTO 500 450 LM = 28 + LP 460 IF DA > LM THEN 1140 470 GOTO 500 480 LM = 30 490 IF DA > LM THEN 1140 500 IF mo < 3 THEN LP = 0 510 N = mo * 3 520 JUL = VAL(MID$(DY$, N - 2, 3)) 530 JUL = JUL + DA + LP 540 N = mo * 9 550 PM$ = MID$(MN$, N - 8, 9) 560 DT = yr + INT((yr - 1) / 4) - INT((yr - 1701) / 100) + INT((yr - 1601) / 400) + JUL 570 IF P1 = 0 OR (P2 = 0 AND LL > 5) THEN 710 580 IF DA > 31 THEN 710 590 DW = (DT / 7): WKDY = INT((DW - INT(DW)) * 7 + .5) 600 O1 = WKDY * 10 + 1 610 WKDY$ = MID$(AD$, O1, 10) 620 CLS : PRINT : PRINT : PRINT 630 PRINT TAB(6); "THE DATE "; DT$; " = "; WKDY$ 640 IF LL > 5 THEN 650 650 PRINT : JD$ = LTRIM$(yr$) + "." + LTRIM$(STR$(JUL)) 660 PRINT TAB(6); " THE JULIAN DATE = "; JD$ 670 PRINT : PRINT : PRINT TAB(6); "WOULD YOU LIKE TO SEE" 680 PRINT TAB(6); "THE WHOLE MONTH? (Y OR N) "; : INPUT R$ 690 IF UCASE$(R$) = "Y" THEN 710 700 IF UCASE$(R$) = "N" THEN 120 ELSE DT$ = R$: GOTO 210 710 DD = 0: HS = 0 720 MS = (DT - (DA - 1)) / 7 730 d1 = INT((MS - INT(MS)) * 7 + .5) 740 CLS 750 PRINT TAB(8); PM$; TAB(18); LTRIM$(yr$) 760 PRINT 770 PRINT DZ$ 780 GOSUB 1010 790 PL$ = "" 800 FOR WK = 1 TO 7 810 IF DD = d1 THEN dp = 1 820 IF dp < 10 THEN dp$ = " " + STR$(dp) ELSE dp$ = " " + STR$(dp) 830 IF dp = 0 THEN dp$ = " " 840 IF hol$(dp) <> "" THEN dp$ = " **": HS = 1 850 'IF hol$(dp) <> "" THEN dp$ = " " + dp$ 860 PL$ = PL$ + dp$ 870 DD = DD + 1 880 IF dp <> 0 THEN dp = dp + 1 890 IF dp > LM THEN dp = 0: dp$ = "" 900 NEXT WK 910 PRINT PL$ 920 IF dp = 0 THEN 940 930 GOTO 790 940 PRINT 950 GOTO 1280 970 DT$ = R$: GOTO 210 980 IF hol$(eh) <> "" THEN hol$(ed) = "EASTER SUNDAY" + CHR$(13) + " & " + hol$(ed) ELSE hol$(ed) = "EASTER SUNDAY" 990 ed = 99 1000 RETURN 1010 'SET MONTHS HOLIDAYS 1020 GOSUB 1880 1030 GOSUB 1480 1040 RESTORE 1050 READ HDT$, hol$ 1060 IF HDT$ = "END" THEN RETURN 1070 MT = VAL(LEFT$(HDT$, 2)) 1080 IF LEN(HDT$) > 5 AND yr <> VAL(RIGHT$(HDT$, 4)) THEN 1050 1090 IF MT <> mo THEN 1050 1100 HDT$ = LEFT$(HDT$, 5) 1110 DX = VAL(RIGHT$(HDT$, 2)) 1120 IF hol$(DX) = "" THEN hol$(DX) = hol$ ELSE hol$(DX) = hol$(DX) + CHR$(13) + " & " + hol$ 1130 GOTO 1050 1140 CLS : LOCATE 10, 14: PRINT "INVALID DATE" 1150 IF DA > LM THEN PRINT TAB(8); "FORMATS ARE:MM/YYYY OR MM/DD ": PRINT TAB(13); " - NOT MM/YY!" 1160 S9 = 1 1170 Period! = 2: GOSUB 1921 1180 IF DA > LM AND S9 < 2 THEN S9 = S9 + 1: GOTO 1170 1190 GOTO 120 1200 'TOO OLD 1210 CLS : LOCATE 2, 12: PRINT "*** CAUTION ***" 1220 PRINT : PRINT : PRINT ; "OUR PRESENT CALENDAR WAS ADOPTED IN 1753- ACCURACY FOR DATES EARLIER THAN 1753" 1230 PRINT "MAY REQUIRE CONVERSION." 1240 PRINT : PRINT TAB(1); "*(MOST DATES IN AMERICAN HISTORY HAVE ALREADY BEEN CONVERTED)" 1250 PRINT : PRINT : PRINT TAB(3); "PRESS TO CONTINUE "; : INPUT R$ 1260 SW = 1 1270 RETURN 1280 ' PRINT HOLIDAYS 1290 IF HS = 0 THEN 1460 1300 PRINT " IMPORTANT DATE(S) IN "; PM$ 1310 PRINT STRING$(30, "*") 1320 FOR H = 1 TO LM 1330 IF hol$(H) = "" THEN 1350 1340 PRINT H; TAB(5); hol$(H) 1350 NEXT H 1360 PRINT ""; 1370 R$ = "": PRINT : PRINT "ENTER DATE OR FOR NEXT MONTH "; : PRINT 1380 PRINT "NEXT DATE OR END "; : INPUT R$ 1390 X = 3 1400 FOR I = 1 TO X: PRINT : NEXT 1410 IF R$ = "" THEN DT$ = STR$(VAL(DT$) + 1): mo = mo + 1 1420 IF mo = 13 THEN mo = 1 1430 IF VAL(DT$) = 13 THEN DT$ = STR$(1): yr$ = STR$((VAL(yr$) + 1)) 1440 IF R$ = "" THEN GOTO 210 1450 DT$ = R$: GOTO 210 1460 PRINT " NO HOLIDAYS, BIRTHDAYS, OR ANYTHING AT ALL IN "; PM$ 1470 GOTO 1360 1480 'MOVABLE HOLIDAYS 1490 ON mo GOSUB 1500, 1510, 1780, 1780, 1540, 1630, 1500, 1500, 1670, 1750, 1700, 1500 1500 RETURN 1510 IF d1 < 2 THEN HX = 16 - d1 ELSE HX = 23 - d1 1520 hol$(HX) = "WASHINGTON'S BIRTHDAY" 1530 RETURN 1540 HX = 15 - d1 1550 IF d1 = 0 THEN HX = 8 1560 hol$(HX) = "MOTHER'S DAY" 1570 HX = 30 - d1 1580 IF d1 = 6 THEN HX = 31 1590 hol$(HX) = "MEMORIAL DAY **" 1600 HX = 21 - d1 1610 hol$(HX) = "ARMED FORCES DAY" 1620 RETURN 1630 HX = 22 - d1 1640 IF d1 = 0 THEN HX = 15 1650 hol$(HX) = "FATHER'S DAY" 1660 RETURN 1670 IF d1 < 2 THEN HX = 2 - d1 ELSE HX = 9 - d1 1680 hol$(HX) = "LABOR DAY **" 1690 RETURN 1700 IF d1 < 2 THEN HX = 3 - d1 ELSE HX = 10 - d1 1710 hol$(HX) = "ELECTION DAY" 1720 IF d1 > 4 THEN HX = 33 - d1 ELSE HX = 26 - d1 1730 hol$(HX) = "THANKSGIVING DAY **" 1740 RETURN 1750 IF d1 < 2 THEN HX = 9 - d1 ELSE HX = 16 - d1 1760 hol$(HX) = "COLUMBUS DAY" 1770 RETURN 1780 'EASTER SUNDAY ' yr must be 1583 to 4099 1790 a = yr \ 100: b = yr MOD 19 ' calculate PFM date 1800 c = (a - 15) \ 2 + (a > 26) + (a > 38) + 202 - 11 * b 1805 c = c + ((a = 21) OR (a = 24) OR (a = 25) OR (a = 33) OR (a = 36) OR (a = 37)) 1810 c = c MOD 30 1815 tA = c + (c = 29) + (c = 28 AND b > 10) + 21 ' table A result (21=M21 to 49=A18) ' find the next Sunday 1820 tB = (tA - 19) MOD 7 ' table B result 1825 c = (40 - a) MOD 4 1830 tC = c - (c > 1) - (c = 3) ' table C result 1835 c = yr MOD 100 1840 tD = (c + c \ 4) MOD 7 ' table D result 1845 tE = ((20 - tB - tC - tD) MOD 7) + 1 ' table E result ' return the date 1850 d = tA + tE: IF d > 31 THEN d = d - 31: m = 4 ELSE m = 3 1860 IF m = mo THEN ed = d: GOSUB 980: ELSE ed = 0 1870 RETURN 1880 ' CLEAR HOLIDAYS 1890 FOR IX = 1 TO 31 1900 hol$(IX) = "" 1910 NEXT 1920 RETURN 1921 BEGIN! = TIMER 'Delay 1922 DO UNTIL (TIMER - BEGIN! > Period!) OR (TIMER - BEGIN! < 0) 1923 LOOP 1924 RETURN 1930 'add any fixed day holidays here. 1940 DATA 01/01, NEW YEARS DAY ** 1941 DATA 02/12, LINCOLN'S BIRTHDAY 1942 DATA 02/14, VALENTINE'S DAY 1943 DATA 03/17, ST. PATRICK'S DAY 1944 DATA 03/20, FIRST DAY OF SPRING 1950 DATA 04/15, INCOME TAXES DUE !!! 1951 DATA 06/14, FLAG DAY 1952 DATA 06/21, FIRST DAY OF SUMMER 1960 DATA 07/04, INDEPENDENCE DAY 1961 DATA 09/22, FIRST DAY OF AUTUMN 2020 DATA 10/31, HALLOWEEN 2030 DATA 11/11, VETERAN'S DAY 2070 DATA 12/07, PEARL HABOR DAY 2080 DATA 12/21, FIRST DAY OF WINTER 2081 DATA 12/25, CHRISTMAS DAY ** ' DON'T change then following line at all ! 2090 DATA END, ***