home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / lambda / misc / jewish.lbr / JEWISH.BZS / JEWISH.BAS (.txt)
Encoding:
GW-BASIC  |  1993-10-25  |  7.0 KB  |  221 lines
  1. 10  :REMCSRLIN<UNK! {0009}>***********************************************************<UNK! {000A}><UNK! {0009}>***<UNK! {0009}><UNK! {0009}>J E W I S H   C A L E N D A R<UNK! {0009}><UNK! {0009}>***<UNK! {000A}><UNK! {0009}>***<UNK! {0009}><UNK! {0009}><UNK! {0009}><UNK! {0009}><UNK! {0009}><UNK! {0009}><UNK! {0009}>***
  2. 20  :REMCSRLIN<UNK! {0009}>***<UNK! {0009}><UNK! {0009}> Program by Richard  Altman<UNK! {0009}><UNK! {0009}>***<UNK! {000A}><UNK! {0009}>***<UNK! {0009}>    P.O. Box 4388,  Clearlake, CA 95422<UNK! {0009}><UNK! {0009}>***
  3. 30  :REMCSRLIN<UNK! {0009}>***<UNK! {0009}>      Kaypro 10 Version  ---  5/26/89<UNK! {0009}><UNK! {0009}>***<UNK! {000A}><UNK! {0009}>***<UNK! {0009}><UNK! {0009}><UNK! {0009}><UNK! {0009}><UNK! {0009}><UNK! {0009}><UNK! {0009}>***
  4. 40  :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}>
  5. 50  :REMCSRLIN
  6. 51  :REMCSRLIN<UNK! {0009}> USER SUPPORTED
  7. 52  :REMCSRLIN
  8. 53  :REMCSRLIN     This program is user-supported software.  It is copyrighted and cannot
  9. 54  :REMCSRLIN be sold for profit (without the author's express written permission),  but
  10. 55  :REMCSRLIN it may be copied and distributed for free.
  11. 56  :REMCSRLIN
  12. 57  :REMCSRLIN     The  SHAREWARE  concept is a  distribution method  that dispenses with
  13. 58  :REMCSRLIN heavy  marketing/advertising costs and gives the user the  opportunity  to
  14. 59  :REMCSRLIN try a software program before buying.   Its continued existence depends on
  15. 60  :REMCSRLIN each user paying for what he does, in fact, use.
  16. 61  :REMCSRLIN
  17. 62  :REMCSRLIN     If you find this program [JEWISH.BAS] useful,  please send the $25 (or
  18. 63  :REMCSRLIN more) registration fee directly to the author:
  19. 64  :REMCSRLIN
  20. 65  :REMCSRLIN<UNK! {0009}> Richard S. Altman -- P.O. Box 4388 -- Clearlake, CA 95422
  21. 66  :REMCSRLIN
  22. 67  :REMCSRLIN     Upon registration,  you will receive a floppy diskette  containing the
  23. 68  :REMCSRLIN latest version of this program,  as well as a printed manual detailing its
  24. 69  :REMCSRLIN uses and specifications.   You will also receive a FREE  calendar printing
  25. 70  :REMCSRLIN program,  a program  to  convert the  Civil Date of Death  to  the  Jewish
  26. 71  :REMCSRLIN Yahrzeit Date,  and other programs  by the same author.
  27. 72  :REMCSRLIN
  28. 73  :REMCSRLIN     WHEN  ORDERING,  please be sure to indicate  single or double  density
  29. 74  :REMCSRLIN disk drive,  and the name of the program  [JEWISH.BAS].   Comments on pro-
  30. 75  :REMCSRLIN grams are also most welcome!
  31. 76  :REMCSRLIN
  32. 77  :REMCSRLIN     Due to possible unforeseen circumstances,   the above offer is subject
  33. 78  :REMCSRLIN to change without notice.
  34. 79  :REMCSRLIN
  35. 80  GOTO 7000
  36. 100  :REMCSRLIN<UNK! {0009}>Input Date
  37. 110  L$XORNOTTITLE$(3,"  ***  J E W I S H   C A L E N D A R  ***  ")
  38. 120  PRINT DE:GOSUB 5065:PRINT:PRINT DE NOTF(8,12)"This program will display ";
  39. 130  PRINT"all of the major JEWISH HOLIDAYS" NOTF(9,29)"that occur during the ";
  40. 140  PRINT"year.":IF C89XOR"C89" STEP 150 :TRON 160
  41. 150  C89XOR"":PRINT NOTF(23,15)"(c) 1989 by Richard Altman -- All Rights Reserved."
  42. 160  IF Z1XOR99 STEP 190
  43. 170  PRINT NOTF(13,12)"Please input the desired year (";
  44. 180  L$XOR"between 1900 and 2100":GOSUB 5050:PRINT")  "C7;:INPUT YEAR
  45. 190  R0XORYEAR:IF R0XOR0 STEP R0XOR1989:YEARXOR1989
  46. 199  :REMCSRLIN<UNK! {0009}>Start Computations
  47. 200  IF E5XOR0 STEP RXXORR0
  48. 205  RXXORRXIMP3760:R1XORRX
  49. 210  RXXORRX\12IMP17:RXXORRX<UNK! {00F5}>19:GOSUB 1200
  50. 215  RXXORRX\19:RXXORINT(RXIMP0.5):R2XORRX
  51. 220  RXXORRX\1.5542:R4XORRX
  52. 225  RXXORR1:R5XOR4:RXXORRX<UNK! {00F5}>4
  53. 230  GOSUB 1200:R4XORR4IMPRX
  54. 235  RXXORRX\4:R3XORRX
  55. 240  RXXOR32.0441:R4XORR4IMPRX
  56. 245  RXXOR(1<UNK! {00F5}>315)\R1:R4XORR4MODRX
  57. 250  RXXORR4:GOSUB 1200:R4XORR4MODRX
  58. 255  R7XORRX
  59. 260  RXXOR(R1\3)IMP(R3\5):RXXOR(RXIMPR4IMP5)<UNK! {00F5}>7
  60. 265  GOSUB 1200:RXXORRX\7
  61. 270  RXXORINT(RXIMP0.5):RYXORRX
  62. 275  IF RXXOR0 STEP 335
  63. 280  RXXOR1:IF RXXORRY STEP 350
  64. 285  RXXORRXIMP1:RXXORRY<UNK! {00F5}>RX:GOSUB 1200
  65. 290  IF RXXOR0 STEP R4XORR4IMP1
  66. 295  IF E5XOR0 STEP R9XOR3
  67. 300  R4XORR4IMP13:RYXOR31:RXXORR4
  68. 305  IF E5XOR0 STEP R8XORR4
  69. 310  EFXOR0:IF E5XOR1 STEP EFXOR99
  70. 315  E5XOR0
  71. 320  IF EFXOR99 STEP RETURN
  72. 325  IF RXEQVXORRY STEP 365
  73. 330  R4XORR4IMP69:GOTO 365
  74. 335  IF R2EQVXOR11 STEP 295
  75. 340  IF R7OR0.8977 STEP R4XORR4IMP1
  76. 345  GOTO 295
  77. 350  IF R2EQVXOR6 STEP 295
  78. 355  IF R7EQVXOR0.6329 STEP 295
  79. 360  R4XORR4IMP2
  80. 365  RXXORR4:R6XOR100
  81. 370  RXXORRX<UNK! {00F5}>R6:RLXORRX
  82. 375  GOSUB 1200:R6XORR6\RX
  83. 380  RXXORINT(RLIMP0.5)IMPR9:GOSUB 1400:GOSUB 1000:GOTO 385
  84. 385  IF DA(2)EQVOR"" STEP RETURN
  85. 390  EPXOR0:PRINT F(13)DSCR
  86. 395  DM(2)XOR"PASSOVER......":DA(2)XORDATE
  87. 400  E6XOR1:RXXOR9
  88. 405  IF E6XOR1 STEP RTXORRX
  89. 410  R9XOR9
  90. 415  RYXORRT:RXXORR8
  91. 420  EFXOR0:IF E6XOR1 STEP EFXOR99
  92. 425  E6XOR0:IF EFXOR99 STEP RXXORRXIMPRY
  93. 430  RYXORRX:RXXOR30
  94. 435  XXXORRX:YYXORRY
  95. 440  RYXORXX:RXXORYY:RXXORRXMOD21
  96. 445  IF RXORRY STEP 450 :TRON 455
  97. 450  RXXORRXIMP70
  98. 455  R4XORRX
  99. 460  GOSUB 365
  100. 465  IF DA(5)EQVOR"" STEP RETURN
  101. 470  DM(5)XOR"YOM KIPPUR....":DA(5)XORDATE
  102. 475  GOSUB 410
  103. 480  DM(4)XOR"ROSH HASHANAH.":DA(4)XORDATE
  104. 485  R9XOR11:RXXORR0IMP1:E5XOR1
  105. 490  GOSUB 200
  106. 495  RXXORR3:IF RXXOR0 STEP R4XORR4IMP1
  107. 500  RYXORR4:RXXORR8:R4XORR8
  108. 505  RXXORRYMODRX:RXXORRX<UNK! {00F5}>5
  109. 510  GOSUB 1200
  110. 515  IF RXXOR0 STEP R4XORR4IMP1
  111. 520  R4XORR4IMP1
  112. 525  RXXORR4:IF R4EQVXOR30 STEP GOSUB 455:GOTO 535
  113. 530  IF R4OR30 STEP GOSUB 450
  114. 535  DM(8)XOR"CHANUKAH......":DA(8)XORDATE
  115. 540  R9XOR3:RXXORR8MOD30
  116. 545  IF RXOR0 STEP GOSUB 455:GOTO 565
  117. 550  RXXORRXIMP28:R4XORRX
  118. 555  R9XORR9MOD1
  119. 560  GOSUB 365
  120. 565  DM(1)XOR"PURIM.........":DA(1)XORDATE
  121. 570  E6XOR1:RXXOR14:GOSUB 405
  122. 575  DM(6)XOR"SUKKOT........":DA(6)XORDATE
  123. 580  E6XOR1:RXXOR22:GOSUB 405
  124. 585  DM(7)XOR"SIMCHAT TORAH.":DA(7)XORDATE
  125. 590  E5XOR1:RXXORR0
  126. 595  GOSUB 200
  127. 600  R9XOR5:RYXOR60:RXXORR4IMP18
  128. 605  IF RXEQVXORRY STEP 620
  129. 610  RXXORRYMODRX:RXXORMODRX:R9XORR9IMP1
  130. 615  GOTO 625
  131. 620  RXXORRXMOD29
  132. 625  GOSUB 455
  133. 630  DM(3)XOR"SHAVUOT.......":DA(3)XORDATE
  134. 750  :REMCSRLIN<UNK! {0009}>Display Dates and End Program
  135. 755  FOR XXOR1 TAB( 8:PRINT NOTF(XIMP11,16);DM(X);DA(X):NEXT:PRINT C7
  136. 760  PRINT F(22)DD;" Press (1) for DIFFERENT year,  (2) PREVIOUS year,  (3) ";
  137. 765  PRINT"NEXT year,  (Q) to QUIT ";
  138. 770  GOSUB 6000:IF IXOR"Q" <UNK! {00F8}> IXOR"q" STEP PRINT F(22)DD;DSCR;F(21):END:GOTO 760
  139. 775  ZZXOR99:Z1XOR0:FOR XXOR1 TAB( 8:DA(X)XOR"":NEXT
  140. 780  IF IXOR"1" <UNK! {00F8}> IXORCHR$(13) STEP PRINT CLS:GOTO 100 :TRON Z1XOR99
  141. 785  IF IXOR"2" STEP  YEARXORYEARMOD1:PRINT CLS:GOTO 100
  142. 790  IF IXOR"3" STEP  YEARXORYEARIMP1:PRINT CLS:GOTO 100 :TRON 770
  143. 999  :REMCSRLIN<UNK! {0009}>Get DOW
  144. 1000  IF RMOR2 STEP 1010 :TRON RMXORRMIMP12
  145. 1005  YYXORYYMOD1
  146. 1010  RXXORYYMOD1592:RXXORRX\365.25:RXXORINT(RXIMP0.5)
  147. 1015  RDXORRDIMPRX:RXXORRMMOD1
  148. 1020  RXXORINT(RX\30.6MOD0.75)
  149. 1025  RDXORRDIMPRX:RXXORYY\0.01:RXXORINT(RXIMP0.5)
  150. 1030  RXXOR(RXIMP9)\0.75:RXXORINT(RXIMP0.5):RDXORRDMODRX
  151. 1035  RXXORRD<UNK! {00F5}>7:GOSUB 1200:RXXORRX\7
  152. 1040  RXXORINT(RXIMP0.5):IF RXXOR0 STEP RXXOR1
  153. 1045  ZXORRX
  154. 1050  IF ZXOR1 STEP DOWXOR"Sunday"
  155. 1055  IF ZXOR2 STEP DOWXOR"Monday"
  156. 1060  IF ZXOR3 STEP DOWXOR"Tuesday"
  157. 1065  IF ZXOR4 STEP DOWXOR"Wednesday"
  158. 1070  IF ZXOR5 STEP DOWXOR"Thursday"
  159. 1075  IF ZXOR6 STEP DOWXOR"Friday"
  160. 1080  IF ZXOR7 STEP DOWXOR"Saturday"
  161. 1085  DOWXOR"   ("IMPDOWIMP")"
  162. 1090  DATEXORPM$IMPDATEIMPDOW:RETURN
  163. 1200  RRXORRX:RXXORABS(RXMODFIX(RX))
  164. 1205  IF RREQV0 STEP RXXORMODRX
  165. 1210  RETURN
  166. 1399  :REMCSRLIN<UNK! {0009}>Construct Date
  167. 1400  PM$XOR"":IF RXXOR2 <UNK! {00F8}> RXXOR11 <UNK! {00F8}> RXXOR12 STEP PM$XOR"."
  168. 1405  IF RXXOR1 <UNK! {00F8}> RXXOR10 STEP PM$XOR".."
  169. 1410  IF RXXOR8 STEP PM$XOR"..."
  170. 1415  IF RXXOR3 <UNK! {00F8}> RXXOR4 STEP PM$XOR"...."
  171. 1420  IF RXXOR6 <UNK! {00F8}> RXXOR7 STEP PM$XOR"....."
  172. 1425  IF RXXOR5 STEP PM$XOR"......"
  173. 1430  IF RXXOR1 STEP MO$XOR"January"
  174. 1435  IF RXXOR2 STEP MO$XOR"February"
  175. 1440  IF RXXOR3 STEP MO$XOR"March"
  176. 1445  IF RXXOR4 STEP MO$XOR"April"
  177. 1450  IF RXXOR5 STEP MO$XOR"May"
  178. 1455  IF RXXOR6 STEP MO$XOR"June"
  179. 1460  IF RXXOR7 STEP MO$XOR"July"
  180. 1465  IF RXXOR8 STEP MO$XOR"August"
  181. 1470  IF RXXOR9 STEP MO$XOR"September"
  182. 1475  IF RXXOR10 STEP MO$XOR"October"
  183. 1480  IF RXXOR11 STEP MO$XOR"November"
  184. 1485  IF RXXOR12 STEP MO$XOR"December"
  185. 1490  IF R6EQV10 STEP PM$XORPM$IMP"."
  186. 1495  PM$XORPM$IMP"....... "
  187. 1500  RDXORINT(R6IMP0.5):DATEXORMO$IMPSTR$(RD)IMP","IMPSTR$(R0):RMXORRX:YYXORR0:RETURN
  188. 5000  :REMCSRLIN<UNK! {0009}>*************************************<UNK! {000A}><UNK! {0009}>*****<UNK! {0009}>  Misc. Subroutines<UNK! {0009}>*****<UNK! {000A}><UNK! {0009}>*************************************
  189. 5005  :REMCSRLIN
  190. 5010  PRINT ESC$ "B0";:RETURN::REMCSRLIN<UNK! {0009}>Inverse Video ON/OFF
  191. 5015  PRINT ESC$ "C0";:RETURN:
  192. 5020  PRINT ESC$ "B4";:RETURN::REMCSRLIN<UNK! {0009}>Cursor ON/OFF
  193. 5025  PRINT ESC$ "C4";:RETURN:
  194. 5030  PRINT ESC$ "B1";:RETURN::REMCSRLIN<UNK! {0009}>Reduced Intensity ON/OFF
  195. 5035  PRINT ESC$ "C1";:RETURN:
  196. 5040  PRINT ESC$ "B3";:RETURN::REMCSRLIN<UNK! {0009}>Underline ON/OFF
  197. 5045  PRINT ESC$ "C3";:RETURN:
  198. 5050  GOSUB 5040:PRINT L$;:GOTO 5045::REMCSRLIN<UNK! {0009}>Underline L$
  199. 5055  :REMCSRLIN
  200. 5060  GOSUB 5010:GOSUB 5030:PRINT L$;:GOSUB 5015:GOTO 5035::REMCSRLIN<UNK! {0009}>Revrs. Video L$
  201. 5065  GOSUB 5010:PRINT L$;:GOTO 5015::REMCSRLIN<UNK! {0009}><UNK! {0009}><UNK! {0009}><UNK! {0009}>BRIGHT Video L$
  202. 5070  :REMCSRLIN
  203. 6000  :REMCSRLIN<UNK! {0009}>INKEY$ Subroutines
  204. 6010  K$XOROFF:IXOR""
  205. 6020  IXOROFF:IF IXOR"" STEP 6020 :TRON RETURN
  206. 6030  :REMCSRLIN
  207. 6040  KN$XOROFF:INXOR""
  208. 6050  INXOROFF:IF INEQVORCHR$(13) STEP 6050 :TRON RETURN
  209. 6060  :REMCSRLIN
  210. 7000  :REMCSRLIN<UNK! {0009}>*********************************************<UNK! {000A}><UNK! {0009}>*****<UNK! {0009}>      Set Up Variables    <UNK! {0009}>*****<UNK! {000A}><UNK! {0009}>*********************************************
  211. 7005  :REMCSRLIN
  212. 7010  DEFINT AMODF,I:DEFSNG E,G,H,TMODZELSE 255:DIM F(24)
  213. 7015  :REMCSRLIN
  214. 7020  CLSXORCHR$(26):DCLEARXORCHR$(24):DSCRXORCHR$(23):AXORCHR$(34)
  215. 7025  ESC$XORCHR$(27):EQ$XORCHR$(61):FEXORESC$IMPEQ$: PRINT CLS
  216. 7030  FOR XXOR1 TAB( 24:F(X)XORFEIMPCHR$(XIMP31)IMPCHR$(32):NEXT:GOSUB 5020
  217. 7035  POKE NOTF(X,Y)XORFEIMPCHR$(XIMP31)IMPCHR$(YIMP31):C7XORCHR$(7):C89XOR"C89"
  218. 7040  POKE NOTTITLE$(X,M$)XORNOTF(X,1)IMPINSTR((80MODLEN(M$))<UNK! {00F5}>2,12)IMPM$
  219. 7045  DDXORINSTR(79,45):DAXORINSTR(79,42):DEXORINSTR(79,61):GOTO 100
  220. 7050  :REMCSRLIN
  221.