10 '	Major Holidays of the Christian Year
20 ' for the KAYPRO 10 ---  5/26/89, by Richard Altman
30 ' Copyright (c) 1989 by Richard Altman, All Rights Reserved
50 '
51 '	 USER SUPPORTED
52 '
53 '     This program is user-supported software.  It is copyrighted and cannot
54 ' be sold for profit (without the author's express written permission),  but
55 ' it may be copied and distributed for free.
56 '
57 '     The  SHAREWARE  concept is a  distribution method  that dispenses with
58 ' heavy  marketing/advertising costs and gives the user the  opportunity  to
59 ' try a software program before buying.   Its continued existence depends on
60 ' each user paying for what he does, in fact, use.
61 '
62 '     If you find this program [EASTER.BAS] useful,  please send the $15 (or
63 ' more) registration fee directly to the author:
64 '
65 '		Richard S. Altman -- P.O. Box 4388 -- Clearlake, CA 95422
66 '
67 '      Upon registration,  you will receive a floppy diskette containing the
68 ' latest version of this program,  as well as a printed manual detailing its
69 ' uses and specifications.   You will also receive a FREE  calendar printing
70 ' program and other programs by the same author.
71 '
72 '      WHEN ORDERING,  please be sure to indicate  single or double  density
73 ' disk drive,  and the name of the program  [EASTER.BAS].   Comments on pro-
74 ' grams are also most welcome!
75 '
76 '     Due to  possible unforeseen circumstances,  the above offer is subject
77 ' to change without notice.
78 '
80 GOTO 7000
90 RT=RZ:RZ=RY:RY=RX:RETURN
95 RT=RL-INT(RL):RT=INT((RT*H)+.5):IF RT=0 THEN RL=RL-1:GOSUB 5400
96 GOTO 3200
100 '	Input Year
105 K0=241303.22#:K1=10281807.26#:K2=15042312.01#:K3=20092717.06#
110 R0=K0:R1=K1:R2=K2:R3=K3
115 print "  ***  C H R I S T I A N   C A L E N D A R  ***  "
120 GOSUB 5065
125 IF Z1=99 THEN 165
126 'R9=1980:GOTO 165
130 PRINT "This program will display the major CHRISTIAN HOLIDAYS"
135 PRINT "that occur during the year."
140 IF C89$="C89" THEN 145 ELSE 150 
145 PRINT "(C) 1989 by Richard Altman -- All Rights Reserved."
150 PRINT "Please input the desired year (";
155 print "between 1900 and 2100"
160 PRINT")  "C7;:INPUT R9:IF R9<1900 OR R9>2100 THEN 150
165 GOSUB 1000:GOSUB 5200:PRINT F(8) DSCR$
170 R9=R9-1:GOSUB 1500:R9=R9+1:GOSUB 2000:GOTO 3000
175 '
1000 '	Easter
1005 R10=365.25:R4=INT(R9*R10)+143
1010 R=R9 MOD 19:R=(R+1)/5:R=R*10:R6=R/10
1015 R=R6-INT(R6):RX=0:R=INT((R*10)+.5)/10
1020 IF R= 0 THEN RX=8:GOTO 1040
1025 IF R=.2 THEN RX=6:GOTO 1040
1030 IF R=.4 THEN RX=4:GOTO 1040
1035 IF R=.6 THEN RX=2:GOTO 1040
1040 RX=10#^RX:RX=1/RX:GOSUB 90
1045 IF INT(R6)=0 THEN KX=K0:GOTO 1065
1050 IF INT(R6)=1 THEN KX=K1:GOTO 1065
1055 IF INT(R6)=2 THEN KX=K2:GOTO 1065
1060 IF INT(R6)=3 THEN KX=K3
1065 R5=KX:IF RY=1 THEN 1075
1070 RX=KX:R=RX*RY:RX=R:RY=RZ:RX=RX-INT(RX):GOTO 1080
1075 K=INT((KX*H)+.5)/H:K=K-INT(K):RX=INT(K*H)/H:RX=RX*RY
1080 RX=INT(RX*H):R4=R4+RX:RY=RX:RX=R4
1085 RX=RX+5:R=INT(RX/7):RX=RX-(R*7)
1090 RX=INT(RX+.5):RX=RX-7:R4=R4-RX
1095 GOSUB 90:RX=R4:RX=RX-122.1
1100 RX=INT(RX/R10):R9=RX:RX=INT(RX*R10)
1105 GOSUB 90:RX=RY-R4:RY=RZ:RX=-RX:R6=RX
1110 R11=30.6001:RX=INT(RX/R11):R7=RX
1115 GOSUB 90:RX=R6:SWAP RX,RY:GOSUB 90:RX=R11
1120 RX=INT(RX*RY):RY=RZ:RX=RY-RX:RZ=RT:RY=RZ
1125 R8=RX:RT=R8:RZ=R7:RY=1:RX=R8
1130 RX=RY-(RX/(RY*H)):RX=RZ-RX:RZ=R8:RY=RX
1135 RX=INT(R7/14):R9=R9+RX:RX=RX*12
1140 RX=RY-RX:RY=RZ:R8=RX:RL=RX:V=7:GOSUB 3200
1145 RESTORE 6500:FOR X=1 TO 12:READ D(X):NEXT:RETURN
1500 '	Christmas
1510 RY=8-RZ:RL=12.25:V=1:GOSUB 3200:IF RY=7 THEN RY=0
1520 GOSUB 2800:DA(1)=" ("+DA+")":RETURN
2000 '	Epiphany Sunday
2010 IF RZ=6 THEN RX=1.06:GOTO 2070
2020 IF RZ=5 THEN RX=1.12:GOTO 2070
2030 IF RZ=4 THEN RX=1.11:GOTO 2070
2040 IF RZ=3 THEN RX=1.1 :GOTO 2070
2050 IF RZ=2 THEN RX=1.09:GOTO 2070
2060 IF RZ=1 THEN RX=1.08:GOTO 2070 ELSE RX=1.07
2070 RL=RX:V=2:GOSUB 3200
2100 '	Ash Wednesday and 1st Sunday in Lent
2110 RX=R8-INT(R8):RL=INT(R8)-1:RX=RX*H
2120 GOSUB 5400:RX=RX+28:RL=RL-.28:RT=RL-INT(RL)
2130 IF (42-RX)/H>RT THEN RX=RX+RT*H:RL=RL-1:GOSUB 5400
2140 R=42-RX:RL=RL-R/H:IF RL<=INT(RL)+.01 THEN RL=RL-1:GOSUB 5400
2150 V=4:GOSUB 95:RT=RL-INT(RL)
2160 IF RT>4/H THEN RL=RL-4/H:GOTO 2190
2170 IF RT=4/H THEN RL=RL-1:GOSUB 5400:GOTO 2190
2180 RX=4-RT*H:RL=RL-1:GOSUB 5400:RL=RL-RX/H
2190 V=3:GOSUB 95
2200 '	Good Friday and Palm Sunday
2210 RL=R8:RT=RL-INT(RL)
2220 IF RT>2/H THEN RL=RL-2/H:GOTO 2250
2230 IF RT=2/H THEN RL=RL-1:GOSUB 5400:GOTO 2250
2240 RX=2-RT*H:RL=RL-1:GOSUB 5400:RL=RL-RX/H
2250 V=6:GOSUB 95:RL=R8:RT=RL-INT(RL)
2260 IF RT>7/H THEN RL=RL-7/H:GOTO 2290
2270 IF RT=7/H THEN RL=RL-1:GOSUB 5400:GOTO 2290
2280 RX=7-RT*H:RL=RL-1:GOSUB 5400:RL=RL-RX/H
2290 V=5:GOSUB 95
2300 '	Ascension Sunday
2310 RL=R8:RT=RL-INT(RL):RM=INT(RL)
2320 RL=RM+1:GOSUB 5400:IF RM=3 THEN RX=11+RT*H ELSE RX=12+RT*H
2330 IF INT(RL)=4 THEN RX=RX-29 ELSE RX=RX-31
2340 RL=RL+RX/H:IF RL-INT(RL)>.31 THEN RL=RL+1:RL=RL-.31
2350 V=8:GOSUB 95
2400 '	Pentecost Sunday
2410 RL=RL+7/H:RT=RL-INT(RL):RM=INT(RL)
2420 IF RM=6 THEN 2440
2430 IF RT>.31 THEN RL=RL+1:RL=RL-.31
2440 V=9:GOSUB 95
2500 '	Kingdomtide
2510 RT=RL-INT(RL):RM=INT(RL)
2520 IF RM=5 THEN RX=92-RT*H ELSE RX=61-RT*H
2530 RL=8.21:RX=RX+21:RY=RX MOD 7:RL=RL-RY/H
2540 IF RL+7/H<=8.31 THEN RL=RL+7/H
2550 IF RL+7/H<=8.31 THEN RL=RL+7/H
2560 V=10:GOSUB 95
2600 '	Advent
2610 RT=RL-INT(RL):RM=8:RX=147-RT*H
2620 RY=RX MOD 7:RX=RX-RY:RL=12.25-RY/H:RC=RL:RYY=RY
2630 RL=RL-.14:RT=RL-INT(RL):RM=INT(RL)
2640 IF RY=0 THEN RL=RL-7/H:RT=RL-INT(RL)
2650 IF RT>7/H THEN RL=RL-7/H:GOTO 2680
2660 IF RT=7/H THEN RL=RL-1:GOSUB 5400:GOTO 2680
2670 RX=7-RT*H:RL=RL-1:GOSUB 5400:RL=RL-RX/H
2680 V=11:GOSUB 95
2700 '	Christmas
2710 RL=12.25:RY=RYY:GOSUB 2800
2720 V=12:GOSUB 95:DA(12)=" ("+DA+")":RETURN
2800 IF RY=0 THEN DA="Sunday":RETURN
2810 IF RY=1 THEN DA="Monday":RETURN
2820 IF RY=2 THEN DA="Tuesday":RETURN
2830 IF RY=3 THEN DA="Wednesday":RETURN
2840 IF RY=4 THEN DA="Thursday":RETURN
2850 IF RY=5 THEN DA="Friday":RETURN
2860 IF RY=6 THEN DA="Saturday":RETURN
2870 '
3000 '	Display Dates and End Program
3010 FOR X=1 TO 12:L=LEN(DA(X))+LEN(D(X))+LEN(DATE(X))
3020 PRINT D(X);" ";DA(X);DATE(X):NEXT
3030 PRINT "Press (1) for DIFFERENT year,  (2) PREVIOUS year,  (3) ";
3040 PRINT"NEXT year,  (Q) to QUIT ";
3050 GOSUB 6000:IF I="Q" OR I="q" THEN PRINT F(21)DD;DSCR$;F(20):END:GOTO 3030
3060 ZZ=99:Z1=0
3070 IF I="1" OR I=CHR$(13) THEN CLS:GOTO 100 ELSE Z1=99
3080 IF I="2" THEN  R9=R9-1:CLS:GOTO 100
3090 IF I="3" THEN  R9=R9+1:CLS:GOTO 100 ELSE 3050
3200 '	Get Date
3205 RX=INT(RL):RD=RL-INT(RL):RD=INT((RD*H)+.5)
3210 IF RX=1  THEN MO$="January"
3215 IF RX=2  THEN MO$="february"
3220 IF RX=3  THEN MO$="March"
3225 IF RX=4  THEN MO$="April"
3230 IF RX=5  THEN MO$="May"
3235 IF RX=6  THEN MO$="June"
3240 IF RX=7  THEN MO$="July"
3245 IF RX=8  THEN MO$="August"
3250 IF RX=9  THEN MO$="September"
3255 IF RX=10 THEN MO$="October"
3260 IF RX=11 THEN MO$="November"
3265 IF RX=12 THEN MO$="December"
3270 DATE(V)=MO$+STR$(RD)+","+STR$(R9):RETURN
3275 '
5000 '	*****	 Misc. Subroutines
5005 '
5010  RETURN
5015 RETURN
5020 RETURN
5025 RETURN
5030 RETURN
5035 RETURN
5040 RETURN
5045 RETURN
5050 GOSUB 5040:GOTO 5045:
5055 '
5060 GOSUB 5010:GOSUB 5030:GOSUB 5015:GOTO 5035:'	Revrs. Video L$
5065 GOSUB 5010:GOTO 5015
5070 '
5200 '	Determine DOW for Jan. 1
5210 RM=INT(R8):RD=(R8-INT(R8))*H:LP=0:IF R9/4=R9\4 THEN LP=1
5220 RDOW=59:IF LP=1 THEN RDOW=60
5230 RDOW=RDOW+RD:IF RM=4 THEN RDOW=RDOW+31
5240 RZ=RDOW MOD 7:IF RZ=0 THEN RZ=7
5250 RETURN
5400 '	Convert to Last Day of Month
5410 RL=INT(RL):RF=28:IF R9/4=R9\4 THEN RF=29
5420 IF RL=2 THEN RL=2+RF/H:RETURN
5430 IF RL=4 OR RL=6 OR RL=9 OR RL=11 THEN RL=RL+.3:RETURN
5440 RL=RL+.31:RETURN
5450 '
6000 '	*****	 INKEY$ Subroutines
6010 K$=INKEY$:I=""
6020 I=INKEY$:IF I="" THEN 6020 ELSE RETURN
6050 KN$=INKEY$:IN=""
6060 IN=INKEY$:IF IN<>CHR$(13) THEN 6060 ELSE RETURN
6070 '
6500 DATA CHRISTMAS,EPIPHANY SUNDAY,ASH WEDNESDAY,"LENT, 1st Sunday"
6510 DATA PALM SUNDAY,GOOD FRIDAY,EASTER,ASCENSION SUNDAY,PENTECOST SUNDAY
6520 DATA KINGDOMTIDE,ADVENT,CHRISTMAS
6530 '
7000 '	*****	Set Up Variables
7005 '
7010 '	String:  A$-F$, I$	Integer:  G-H, T-Z

7011 '	Single Precision: J-S	Double Precision: K
7015 '
7020 DEFSTR A-F,I:DEFINT G-H,T-Z:DEFDBL K:DIM D(12),DA(12),DATE(12),F(24)
7025 DCLEAR$=CHR$(24):DSCR$=CHR$(23):ESC$=CHR$(27):C7=CHR$(7)
7030 fe$=ESC$+"=":H=100:CLS:GOSUB 5020:C89$="C89"
7035 FOR X=1 TO 24:F(X)=fe$+CHR$(X+31)+CHR$(32):NEXT
7040 DEF FNF(X,Y)=fe$+CHR$(X+31)+CHR$(Y+31):DD=STRING$(79,45):GOTO 100
 24:F(X)=fe$+CHR$(X+31)+CHR$(32):NEXT