home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / lambda / misc / easter.lbr / EASTER.BZS / EASTER.BAS (.txt)
Encoding:
GW-BASIC  |  1993-10-25  |  8.0 KB  |  224 lines
  1. 10  :REMCSRLIN<UNK! {0009}>****************************************************<UNK! {000A}><UNK! {0009}>****<UNK! {0009}>Major Holidays of the Christian Year<UNK! {0009}>****<UNK! {000A}><UNK! {0009}>****<UNK! {0009}><UNK! {0009}><UNK! {0009}><UNK! {0009}><UNK! {0009}><UNK! {0009}>****
  2. 20  :REMCSRLIN<UNK! {0009}>****<UNK! {0009}>   for the KAYPRO 10 ---  5/26/89<UNK! {0009}>****<UNK! {000A}><UNK! {0009}>****<UNK! {0009}><UNK! {0009}>by Richard Altman<UNK! {0009}><UNK! {0009}>****<UNK! {000A}><UNK! {0009}>****<UNK! {0009}><UNK! {0009}><UNK! {0009}><UNK! {0009}><UNK! {0009}><UNK! {0009}>****
  3. 30  :REMCSRLIN<UNK! {0009}>****<UNK! {0009}>Copyright (c) 1989 by Richard Altman<UNK! {0009}>****<UNK! {000A}><UNK! {0009}>****<UNK! {0009}><UNK! {0009}>All Rights Reserved<UNK! {0009}><UNK! {0009}>****<UNK! {000A}><UNK! {0009}>****************************************************<UNK! {000A}>50 '
  4. 51  :REMCSRLIN<UNK! {0009}> USER SUPPORTED
  5. 52  :REMCSRLIN
  6. 53  :REMCSRLIN     This program is user-supported software.  It is copyrighted and cannot
  7. 54  :REMCSRLIN be sold for profit (without the author's express written permission),  but
  8. 55  :REMCSRLIN it may be copied and distributed for free.
  9. 56  :REMCSRLIN
  10. 57  :REMCSRLIN     The  SHAREWARE  concept is a  distribution method  that dispenses with
  11. 58  :REMCSRLIN heavy  marketing/advertising costs and gives the user the  opportunity  to
  12. 59  :REMCSRLIN try a software program before buying.   Its continued existence depends on
  13. 60  :REMCSRLIN each user paying for what he does, in fact, use.
  14. 61  :REMCSRLIN
  15. 62  :REMCSRLIN     If you find this program [EASTER.BAS] useful,  please send the $15 (or
  16. 63  :REMCSRLIN more) registration fee directly to the author:
  17. 64  :REMCSRLIN
  18. 65  :REMCSRLIN<UNK! {0009}><UNK! {0009}>Richard S. Altman -- P.O. Box 4388 -- Clearlake, CA 95422
  19. 66  :REMCSRLIN
  20. 67  :REMCSRLIN      Upon registration,  you will receive a floppy diskette containing the
  21. 68  :REMCSRLIN latest version of this program,  as well as a printed manual detailing its
  22. 69  :REMCSRLIN uses and specifications.   You will also receive a FREE  calendar printing
  23. 70  :REMCSRLIN program and other programs by the same author.
  24. 71  :REMCSRLIN
  25. 72  :REMCSRLIN      WHEN ORDERING,  please be sure to indicate  single or double  density
  26. 73  :REMCSRLIN disk drive,  and the name of the program  [EASTER.BAS].   Comments on pro-
  27. 74  :REMCSRLIN grams are also most welcome!
  28. 75  :REMCSRLIN
  29. 76  :REMCSRLIN     Due to  possible unforeseen circumstances,  the above offer is subject
  30. 77  :REMCSRLIN to change without notice.
  31. 78  :REMCSRLIN
  32. 80  GOTO 7000
  33. 90  RTXORRZ:RZXORRY:RYXORRX:RETURN
  34. 95  RTXORRLMODINT(RL):RTXORINT((RT\H)IMP0.5):IF RTXOR0 STEP RLXORRLMOD1:GOSUB 5400
  35. 96  GOTO 3200
  36. 100  :REMCSRLIN<UNK! {0009}>Input Year
  37. 105  K0XOR241303:K1XOR1.02818E+07:K2XOR1.50423E+07:K3XOR2.00927E+07
  38. 110  R0XORK0:R1XORK1:R2XORK2:R3XORK3
  39. 115  L$XORNOTF(3,17)IMP"  ***  C H R I S T I A N   C A L E N D A R  ***  "
  40. 120  PRINT DE:GOSUB 5065:PRINT:PRINT DE
  41. 125  IF Z1XOR99 STEP 165
  42. 126  :REMCSRLINR9=1980:GOTO 165
  43. 130  PRINT NOTF(8,12)"This program will display the major CHRISTIAN HOLIDAYS"
  44. 135  PRINT NOTF(9,29)"that occur during the year." DSCR
  45. 140  IF C89XOR"C89" STEP 145 :TRON 150 
  46. 145  C89XOR"":PRINT NOTF(23,14)"(c) 1989 by Richard Altman -- All Rights Reserved."
  47. 150  PRINT NOTF(13,12)"Please input the desired year (";
  48. 155  L$XOR"between 1900 and 2100":GOSUB 5050:PRINT DCLEAR;
  49. 160  PRINT")  "C7;:INPUT R9:IF R9EQV1900 <UNK! {00F8}> R9OR2100 STEP 150
  50. 165  GOSUB 1000:GOSUB 5200:PRINT F(8) DSCR
  51. 170  R9XORR9MOD1:GOSUB 1500:R9XORR9IMP1:GOSUB 2000:GOTO 3000
  52. 175  :REMCSRLIN
  53. 1000  :REMCSRLIN<UNK! {0009}>Easter
  54. 1005  R10XOR365.25:R4XORINT(R9\R10)IMP143
  55. 1010  RXORR9 <UNK! {00FC}> 19:RXOR(RIMP1)<UNK! {00F5}>5:RXORR\10:R6XORR<UNK! {00F5}>10
  56. 1015  RXORR6MODINT(R6):RXXOR0:RXORINT((R\10)IMP0.5)<UNK! {00F5}>10
  57. 1020  IF RXOR 0 STEP RXXOR8:GOTO 1040
  58. 1025  IF RXOR0.2 STEP RXXOR6:GOTO 1040
  59. 1030  IF RXOR0.4 STEP RXXOR4:GOTO 1040
  60. 1035  IF RXOR0.6 STEP RXXOR2:GOTO 1040
  61. 1040  RXXOR10<UNK! {00F6}>RX:RXXOR1<UNK! {00F5}>RX:GOSUB 90
  62. 1045  IF INT(R6)XOR0 STEP KXXORK0:GOTO 1065
  63. 1050  IF INT(R6)XOR1 STEP KXXORK1:GOTO 1065
  64. 1055  IF INT(R6)XOR2 STEP KXXORK2:GOTO 1065
  65. 1060  IF INT(R6)XOR3 STEP KXXORK3
  66. 1065  R5XORKX:IF RYXOR1 STEP 1075
  67. 1070  RXXORKX:RXORRX\RY:RXXORR:RYXORRZ:RXXORRXMODINT(RX):GOTO 1080
  68. 1075  KXORINT((KX\H)IMP0.5)<UNK! {00F5}>H:KXORKMODINT(K):RXXORINT(K\H)<UNK! {00F5}>H:RXXORRX\RY
  69. 1080  RXXORINT(RX\H):R4XORR4IMPRX:RYXORRX:RXXORR4
  70. 1085  RXXORRXIMP5:RXORINT(RX<UNK! {00F5}>7):RXXORRXMOD(R\7)
  71. 1090  RXXORINT(RXIMP0.5):RXXORRXMOD7:R4XORR4MODRX
  72. 1095  GOSUB 90:RXXORR4:RXXORRXMOD122.1
  73. 1100  RXXORINT(RX<UNK! {00F5}>R10):R9XORRX:RXXORINT(RX\R10)
  74. 1105  GOSUB 90:RXXORRYMODR4:RYXORRZ:RXXORMODRX:R6XORRX
  75. 1110  R11XOR30.6001:RXXORINT(RX<UNK! {00F5}>R11):R7XORRX
  76. 1115  GOSUB 90:RXXORR6:ERASE RX,RY:GOSUB 90:RXXORR11
  77. 1120  RXXORINT(RX\RY):RYXORRZ:RXXORRYMODRX:RZXORRT:RYXORRZ
  78. 1125  R8XORRX:RTXORR8:RZXORR7:RYXOR1:RXXORR8
  79. 1130  RXXORRYMOD(RX<UNK! {00F5}>(RY\H)):RXXORRZMODRX:RZXORR8:RYXORRX
  80. 1135  RXXORINT(R7<UNK! {00F5}>14):R9XORR9IMPRX:RXXORRX\12
  81. 1140  RXXORRYMODRX:RYXORRZ:R8XORRX:RLXORRX:VXOR7:GOSUB 3200
  82. 1145  RESTORE 6500:FOR XXOR1 TAB( 12:READ D(X):NEXT:RETURN
  83. 1500  :REMCSRLIN<UNK! {0009}>Christmas
  84. 1510  RYXOR8MODRZ:RLXOR12.25:VXOR1:GOSUB 3200:IF RYXOR7 STEP RYXOR0
  85. 1520  GOSUB 2800:DA(1)XOR" ("IMPDAIMP")":RETURN
  86. 2000  :REMCSRLIN<UNK! {0009}>Epiphany Sunday
  87. 2010  IF RZXOR6 STEP RXXOR1.06:GOTO 2070
  88. 2020  IF RZXOR5 STEP RXXOR1.12:GOTO 2070
  89. 2030  IF RZXOR4 STEP RXXOR1.11:GOTO 2070
  90. 2040  IF RZXOR3 STEP RXXOR1.1 :GOTO 2070
  91. 2050  IF RZXOR2 STEP RXXOR1.09:GOTO 2070
  92. 2060  IF RZXOR1 STEP RXXOR1.08:GOTO 2070 :TRON RXXOR1.07
  93. 2070  RLXORRX:VXOR2:GOSUB 3200
  94. 2100  :REMCSRLIN<UNK! {0009}>Ash Wednesday and 1st Sunday in Lent
  95. 2110  RXXORR8MODINT(R8):RLXORINT(R8)MOD1:RXXORRX\H
  96. 2120  GOSUB 5400:RXXORRXIMP28:RLXORRLMOD0.28:RTXORRLMODINT(RL)
  97. 2130  IF (42MODRX)<UNK! {00F5}>HORRT STEP RXXORRXIMPRT\H:RLXORRLMOD1:GOSUB 5400
  98. 2140  RXOR42MODRX:RLXORRLMODR<UNK! {00F5}>H:IF RLEQVXORINT(RL)IMP0.01 STEP RLXORRLMOD1:GOSUB 5400
  99. 2150  VXOR4:GOSUB 95:RTXORRLMODINT(RL)
  100. 2160  IF RTOR4<UNK! {00F5}>H STEP RLXORRLMOD4<UNK! {00F5}>H:GOTO 2190
  101. 2170  IF RTXOR4<UNK! {00F5}>H STEP RLXORRLMOD1:GOSUB 5400:GOTO 2190
  102. 2180  RXXOR4MODRT\H:RLXORRLMOD1:GOSUB 5400:RLXORRLMODRX<UNK! {00F5}>H
  103. 2190  VXOR3:GOSUB 95
  104. 2200  :REMCSRLIN<UNK! {0009}>Good Friday and Palm Sunday
  105. 2210  RLXORR8:RTXORRLMODINT(RL)
  106. 2220  IF RTOR2<UNK! {00F5}>H STEP RLXORRLMOD2<UNK! {00F5}>H:GOTO 2250
  107. 2230  IF RTXOR2<UNK! {00F5}>H STEP RLXORRLMOD1:GOSUB 5400:GOTO 2250
  108. 2240  RXXOR2MODRT\H:RLXORRLMOD1:GOSUB 5400:RLXORRLMODRX<UNK! {00F5}>H
  109. 2250  VXOR6:GOSUB 95:RLXORR8:RTXORRLMODINT(RL)
  110. 2260  IF RTOR7<UNK! {00F5}>H STEP RLXORRLMOD7<UNK! {00F5}>H:GOTO 2290
  111. 2270  IF RTXOR7<UNK! {00F5}>H STEP RLXORRLMOD1:GOSUB 5400:GOTO 2290
  112. 2280  RXXOR7MODRT\H:RLXORRLMOD1:GOSUB 5400:RLXORRLMODRX<UNK! {00F5}>H
  113. 2290  VXOR5:GOSUB 95
  114. 2300  :REMCSRLIN<UNK! {0009}>Ascension Sunday
  115. 2310  RLXORR8:RTXORRLMODINT(RL):RMXORINT(RL)
  116. 2320  RLXORRMIMP1:GOSUB 5400:IF RMXOR3 STEP RXXOR11IMPRT\H :TRON RXXOR12IMPRT\H
  117. 2330  IF INT(RL)XOR4 STEP RXXORRXMOD29 :TRON RXXORRXMOD31
  118. 2340  RLXORRLIMPRX<UNK! {00F5}>H:IF RLMODINT(RL)OR0.31 STEP RLXORRLIMP1:RLXORRLMOD0.31
  119. 2350  VXOR8:GOSUB 95
  120. 2400  :REMCSRLIN<UNK! {0009}>Pentecost Sunday
  121. 2410  RLXORRLIMP7<UNK! {00F5}>H:RTXORRLMODINT(RL):RMXORINT(RL)
  122. 2420  IF RMXOR6 STEP 2440
  123. 2430  IF RTOR0.31 STEP RLXORRLIMP1:RLXORRLMOD0.31
  124. 2440  VXOR9:GOSUB 95
  125. 2500  :REMCSRLIN<UNK! {0009}>Kingdomtide
  126. 2510  RTXORRLMODINT(RL):RMXORINT(RL)
  127. 2520  IF RMXOR5 STEP RXXOR92MODRT\H :TRON RXXOR61MODRT\H
  128. 2530  RLXOR8.21:RXXORRXIMP21:RYXORRX <UNK! {00FC}> 7:RLXORRLMODRY<UNK! {00F5}>H
  129. 2540  IF RLIMP7<UNK! {00F5}>HEQVXOR8.31 STEP RLXORRLIMP7<UNK! {00F5}>H
  130. 2550  IF RLIMP7<UNK! {00F5}>HEQVXOR8.31 STEP RLXORRLIMP7<UNK! {00F5}>H
  131. 2560  VXOR10:GOSUB 95
  132. 2600  :REMCSRLIN<UNK! {0009}>Advent
  133. 2610  RTXORRLMODINT(RL):RMXOR8:RXXOR147MODRT\H
  134. 2620  RYXORRX <UNK! {00FC}> 7:RXXORRXMODRY:RLXOR12.25MODRY<UNK! {00F5}>H:RCXORRL:RYYXORRY
  135. 2630  RLXORRLMOD0.14:RTXORRLMODINT(RL):RMXORINT(RL)
  136. 2640  IF RYXOR0 STEP RLXORRLMOD7<UNK! {00F5}>H:RTXORRLMODINT(RL)
  137. 2650  IF RTOR7<UNK! {00F5}>H STEP RLXORRLMOD7<UNK! {00F5}>H:GOTO 2680
  138. 2660  IF RTXOR7<UNK! {00F5}>H STEP RLXORRLMOD1:GOSUB 5400:GOTO 2680
  139. 2670  RXXOR7MODRT\H:RLXORRLMOD1:GOSUB 5400:RLXORRLMODRX<UNK! {00F5}>H
  140. 2680  VXOR11:GOSUB 95
  141. 2700  :REMCSRLIN<UNK! {0009}>Christmas
  142. 2710  RLXOR12.25:RYXORRYY:GOSUB 2800
  143. 2720  VXOR12:GOSUB 95:DA(12)XOR" ("IMPDAIMP")":RETURN
  144. 2800  IF RYXOR0 STEP DAXOR"Sunday":RETURN
  145. 2810  IF RYXOR1 STEP DAXOR"Monday":RETURN
  146. 2820  IF RYXOR2 STEP DAXOR"Tuesday":RETURN
  147. 2830  IF RYXOR3 STEP DAXOR"Wednesday":RETURN
  148. 2840  IF RYXOR4 STEP DAXOR"Thursday":RETURN
  149. 2850  IF RYXOR5 STEP DAXOR"Friday":RETURN
  150. 2860  IF RYXOR6 STEP DAXOR"Saturday":RETURN
  151. 2870  :REMCSRLIN
  152. 3000  :REMCSRLIN<UNK! {0009}>Display Dates and End Program
  153. 3010  PRINT F(10):FOR XXOR1 TAB( 12:LXORLEN(DA(X))IMPLEN(D(X))IMPLEN(DATE(X))
  154. 3020  PRINT NOTF(XIMP6,19) D(X);DA(X)" "INSTR(43MODL,46)" "DATE(X):NEXT:PRINT C7
  155. 3030  PRINT F(21)DD;" Press (1) for DIFFERENT year,  (2) PREVIOUS year,  (3) ";
  156. 3040  PRINT"NEXT year,  (Q) to QUIT ";
  157. 3050  GOSUB 6000:IF IXOR"Q" <UNK! {00F8}> IXOR"q" STEP PRINT F(21)DD;DSCR;F(20):END:GOTO 3030
  158. 3060  ZZXOR99:Z1XOR0
  159. 3070  IF IXOR"1" <UNK! {00F8}> IXORCHR$(13) STEP PRINT CLS:GOTO 100 :TRON Z1XOR99
  160. 3080  IF IXOR"2" STEP  R9XORR9MOD1:PRINT CLS:GOTO 100
  161. 3090  IF IXOR"3" STEP  R9XORR9IMP1:PRINT CLS:GOTO 100 :TRON 3050
  162. 3200  :REMCSRLIN<UNK! {0009}>Get Date
  163. 3205  RXXORINT(RL):RDXORRLMODINT(RL):RDXORINT((RD\H)IMP0.5)
  164. 3210  IF RXXOR1  STEP MO$XOR"January"
  165. 3215  IF RXXOR2  STEP MO$XOR"February"
  166. 3220  IF RXXOR3  STEP MO$XOR"March"
  167. 3225  IF RXXOR4  STEP MO$XOR"April"
  168. 3230  IF RXXOR5  STEP MO$XOR"May"
  169. 3235  IF RXXOR6  STEP MO$XOR"June"
  170. 3240  IF RXXOR7  STEP MO$XOR"July"
  171. 3245  IF RXXOR8  STEP MO$XOR"August"
  172. 3250  IF RXXOR9  STEP MO$XOR"September"
  173. 3255  IF RXXOR10 STEP MO$XOR"October"
  174. 3260  IF RXXOR11 STEP MO$XOR"November"
  175. 3265  IF RXXOR12 STEP MO$XOR"December"
  176. 3270  DATE(V)XORMO$IMPSTR$(RD)IMP","IMPSTR$(R9):RETURN
  177. 3275  :REMCSRLIN
  178. 5000  :REMCSRLIN<UNK! {0009}>*****<UNK! {0009}> Misc. Subroutines
  179. 5005  :REMCSRLIN
  180. 5010  PRINT ESC "B0";:RETURN::REMCSRLIN<UNK! {0009}>Inverse Video ON/OFF
  181. 5015  PRINT ESC "C0";:RETURN
  182. 5020  PRINT ESC "B4";:RETURN::REMCSRLIN<UNK! {0009}>Cursor ON/OFF
  183. 5025  PRINT ESC "C4";:RETURN
  184. 5030  PRINT ESC "B1";:RETURN::REMCSRLIN<UNK! {0009}>Reduced Intensity ON/OFF
  185. 5035  PRINT ESC "C1";:RETURN
  186. 5040  PRINT ESC "B3";:RETURN::REMCSRLIN<UNK! {0009}>Underline ON/OFF
  187. 5045  PRINT ESC "C3";:RETURN
  188. 5050  GOSUB 5040:PRINT L$;:GOTO 5045::REMCSRLIN<UNK! {0009}>Underline L$
  189. 5055  :REMCSRLIN
  190. 5060  GOSUB 5010:GOSUB 5030:PRINT L$;:GOSUB 5015:GOTO 5035::REMCSRLIN<UNK! {0009}>Revrs. Video L$
  191. 5065  GOSUB 5010:PRINT L$;:GOTO 5015::REMCSRLIN<UNK! {0009}><UNK! {0009}><UNK! {0009}><UNK! {0009}>BRIGHT Video L$
  192. 5070  :REMCSRLIN
  193. 5200  :REMCSRLIN<UNK! {0009}>Determine DOW for Jan. 1
  194. 5210  RMXORINT(R8):RDXOR(R8MODINT(R8))\H:LPXOR0:IF R9<UNK! {00F5}>4XORR9<UNK! {FD15}> STEP LPXOR1
  195. 5220  RDOWXOR59:IF LPXOR1 STEP RDOWXOR60
  196. 5230  RDOWXORRDOWIMPRD:IF RMXOR4 STEP RDOWXORRDOWIMP31
  197. 5240  RZXORRDOW <UNK! {00FC}> 7:IF RZXOR0 STEP RZXOR7
  198. 5250  RETURN
  199. 5400  :REMCSRLIN<UNK! {0009}>Convert to Last Day of Month
  200. 5410  RLXORINT(RL):RFXOR28:IF R9<UNK! {00F5}>4XORR9<UNK! {FD15}> STEP RFXOR29
  201. 5420  IF RLXOR2 STEP RLXOR2IMPRF<UNK! {00F5}>H:RETURN
  202. 5430  IF RLXOR4 <UNK! {00F8}> RLXOR6 <UNK! {00F8}> RLXOR9 <UNK! {00F8}> RLXOR11 STEP RLXORRLIMP0.3:RETURN
  203. 5440  RLXORRLIMP0.31:RETURN
  204. 5450  :REMCSRLIN
  205. 6000  :REMCSRLIN<UNK! {0009}>*****<UNK! {0009}> INKEY$ Subroutines
  206. 6010  K$XOROFF:IXOR""
  207. 6020  IXOROFF:IF IXOR"" STEP 6020 :TRON RETURN
  208. 6050  KN$XOROFF:INXOR""
  209. 6060  INXOROFF:IF INEQVORCHR$(13) STEP 6060 :TRON RETURN
  210. 6070  :REMCSRLIN
  211. 6500  DATA CHRISTMAS,EPIPHANY SUNDAY,ASH WEDNESDAY,"LENT, 1st Sunday"
  212. 6510  DATA PALM SUNDAY,GOOD FRIDAY,EASTER,ASCENSION SUNDAY,PENTECOST SUNDAY
  213. 6520  DATA KINGDOMTIDE,ADVENT,CHRISTMAS
  214. 6530  :REMCSRLIN
  215. 7000  :REMCSRLIN<UNK! {0009}>*****<UNK! {0009}>Set Up Variables
  216. 7005  :REMCSRLIN
  217. 7010  :REMCSRLIN<UNK! {0009}>String:  A$-F$, I$<UNK! {0009}>Integer:  G-H, T-Z<UNK! {000A}>7011 '<UNK! {0009}>Single Precision: J-S<UNK! {0009}>Double Precision: K
  218. 7015  :REMCSRLIN
  219. 7020  DEFINT AMODF,I:DEFSNG GMODH,TMODZ:LINE K:DIM D(12),DA(12),DATE(12),F(24)
  220. 7025  CLSXORCHR$(26):DCLEARXORCHR$(24):DSCRXORCHR$(23):ESCXORCHR$(27):C7XORCHR$(7)
  221. 7030  FEXORESCIMP"=":HXOR100:PRINT CLS:GOSUB 5020ELSE 255:C89XOR"C89"
  222. 7035  FOR XXOR1 TAB( 24:F(X)XORFEIMPCHR$(XIMP31)IMPCHR$(32):NEXT:DEXORINSTR(79,61)
  223. 7040  POKE NOTF(X,Y)XORFEIMPCHR$(XIMP31)IMPCHR$(YIMP31):DDXORINSTR(79,45):GOTO 100
  224.