'October 13, 1998;  13:00


CLEAR

RANDOMIZE TIMER


DEFDBL A-Z

DEF FNM (W) = W * PI / 180#
DEF FND (W) = W * 180# / PI
DEF FNV (W) = W - INT(W / 360#) * 360#
DEF FNW (W) = W - INT(W)
DEF FNS (W) = ATN(W / (SQR(1# - W * W) + 1E-20))
DEF FNC (W) = PI / 2# - FNS(W)

DIM WK$(7), DI(4), SN$(4), BL$(4), MR$(4), EV$(4), MN$(13), MG$(13), HB$(25), MO$(13)

YN$ = " Comments? (press Y=Yes N=No C=Comments) "
AG$ = " Again?" + YN$
QL$ = " ZODIAC: The ultimate Space-Time Manifold organizer... "
ES$ = " press Esc to exit "
YY$ = " (press Y=Yes N=No) "
PY$ = YY$ + ES$
DG$ = " press digit to choose item " + ES$
MA$ = SPACE$(14) + " "
CI$ = " is circumpolar, never sets below "
NE$ = " never rises above "
HM$ = " (hr.:min.:sec.) "
AZ$ = MA$ + "Azimuth (deg., North to East) : ###.##"
WD$ = MA$ + "Weekday " + STRING$(30, "") + ": "
LC$ = "Location (lon. lat. UT Offset):"
JU$ = "Julian days since "
JD$ = JU$ + "4713 BCE Jan. 1.5 "
JU$ = JU$ + "1900 CE Jan. 0.5 "
CD$ = " calendar Date :"
DJJ = 2415020#
ZU = 86400#
HG = 1948439.5#


DATA" Sunrise and Sunset, and Azimuth ","horizon"
DATA" Civil Twilight (Sun 6 below horizon) ","6"
DATA" Nautical Twilight (Sun 12 below horizon) ","12"
DATA" Astronomical Twilight (Sun 18 below horizon) ","18"
FOR II% = 1 TO 4
READ SN$(II%), BL$(II%)
NEXT

DATA Sunday,Monday,Tuesday,Wednesday,Thursday,Friday,Saturday,
FOR II% = 0 TO 7
READ WK$(II%)
NEXT

DATA Tishrei,Heshvan,Kislev,Tevet,Shvat,Adar,Adar 2,Nisan,Iyar,Sivan,Tammuz,Av,Elul
DATA January,February,March,April,May,June,July,August,September,October,November,December,
DATA Muharram,Safar,"Rabia I","Rabia II","Jumada I","Jumada II",Rajab,Shaban,Ramadan,Shawwal,"Zu'l-Qadah","Zu'l-Hijjah",
FOR IJ% = 1 TO 3
FOR II% = 1 TO 13
READ QQ$
QQ$ = QQ$ + " "
IF IJ% = 1 THEN MN$(II%) = QQ$
IF IJ% = 2 THEN MG$(II%) = QQ$
IF IJ% = 3 THEN MO$(II%) = QQ$
NEXT
NEXT

DATA Alef,Beit,Gimel,Dalet,Heh,Waw,Zayin,Khet,Tet,Yod
DATA Yod,Caf,Lamed,Mem,Nun,Samech,Ayin,Peh,Tsadi,Kof
DATA Kof,Resh,Shin,Tav,Efes
FOR II% = 1 TO 25
READ HB$(II%)
NEXT

PI = 4# * ATN(1#)
TP = 2# * PI

SMH$ = "infinity"
AZ% = 1

FST:

CLS : RESTORE FST
WZ$ = DATE$
UX% = 0
LOCATE 24, 1, 1
PRINT , ; : COLOR 16 - VU%, 15: PRINT " press H=Halt blinking  Q=Quiet  R=Reset  E=Exit  Enter=continue "; : COLOR 31 - VU%, 0: COLOR 15, 0
LOCATE 2, 1
TI$ = QL$: GOSUB TIT
DATA nightshift,morning,afternoon,evening
FOR II% = 0 TO VAL(TIME$) \ 6
READ QQ$
QQ$ = "A good " + QQ$ + " to you!"
NEXT
PRINT MA$; QQ$
GOSUB TOD
GOSUB JULDAY
PRINT MA$
PRINT MA$; "on "; WK$(WK%); ", the"; DY; MG$(MN); YR;
VJ = DJ: VY = YR
DH% = 1: GOSUB CMN: DH% = 0
PRINT ", the"; DF; MN$(JJ%); CR
PRINT MA$
GOSUB ALAF
PRINT MA$
PRINT MA$
PRINT MA$
PRINT MA$; : AL$ = "Alarm set to " + SMH$: GOSUB ALRT
PR$ = " Always! put commas between entries in Multiple Input commands! ": GOSUB BLINK
PR$ = " Note! Years BCE<0, no Year zero. Example: -4713 means 4713 BCE ": GOSUB BLINK
LOCATE 18, 59
PRINT ""; STRING$(19, ""); ""
IJ% = 79: GOSUB DOR
LOCATE 22, 59
PRINT ""; STRING$(19, ""); ""
LOCATE 19: PR$ = STRING$(63, ">"): GOSUB BLINK
IN$ = "Welcome to ZODIAC"
GOSUB COMN: BZ% = 1
FOR IK% = 15 TO 61
TT = INT(TIMER)
LOCATE 20, IK%
PRINT IN$
GOSUB WEL
LOCATE 20, IK%
PRINT SPACE$(17)
NEXT
BZ% = 0
LOCATE 20, 61
PRINT IN$
IJ% = 59: GOSUB DOR
WHILE QQ <> 13
TT = INT(TIMER)
GOSUB WEL
WEND


MAIN:

GOSUB DAT
CLS : PRINT
TL$ = QL$
TI$ = TL$: GOSUB TIT
RESTORE MAIN
DATA"01. Sunrise, Sunset and Twilight"
DATA"02. Moonrise and Moonset"
DATA"03. New Moon and Full Moon"
DATA"04. Day of the Week and Number of Days in an interval"
DATA"05. Hebrew Perpetual calendar"
DATA"06. Hijra Perpetual calendar"
DATA"07. Stop-Watch"
DATA"08. Countdown Timer and preset time Alarm"
DATA"09. Adjust Computer clock"
DATA"10. Easter Sunday and Passover"
DATA"11. Julian day from Calendar date"
DATA"12. Calendar date from Julian day"
DATA"13. Eclipses: Solar and Lunar"
DATA"14. Information and Credits"
DATA"15. Browse through Comments file"
DATA"16. Shell to DOS"
KK% = 16: GOSUB SCR
PRINT MA$; "17. Help thyself"; : IF HL% = 0 THEN PRINT  ELSE PRINT ": follow ZODIAC's messages"
PR$ = " press two digits to choose item " + ES$: GOSUB BLINK
IF SP% = 1 THEN EX% = 0: AZ% = 0: GOSUB SND: SP% = 0: GOTO AAG

QQ$ = "": GOSUB PUTI: II% = VAL(QQ$): IF QQ = 27 THEN GOTO AAG
QQ$ = "": GOSUB PUTI: II% = 10 * II% + VAL(QQ$)
           
ON II% GOTO HSUN, HMOON, FLMOON, DAYS, HEBREW, HIJRA, STOPW, TTIMER, ADJUST, EASTER, HJULDAY, HCALDAY, ECLPS, INFO, BROWS, SHL, HELP
GOSUB SND

AAG:
QQ$ = AG$: DX% = 1: GOSUB IFEX
IF EE% = 1 THEN CO$ = LA$: AZ% = 1: GOTO FST
AA:
CLOSE : SHELL "IF EXIST ZODIAC.TMP DEL ZODIAC.TMP"
CLS : SYSTEM


PUTI:

AA% = CSRLIN
BB% = POS(0)
TT = 0
WHILE QQ$ = ""
IF SMH$ = TIME$ THEN GOTO WE
LOCATE 25, 1
IF INT(TIMER) > TT THEN TT = INT(TIMER): PRINT "Time: "; TIME$; SPACE$(45); "Alarm set to "; SMH$;
QQ$ = INKEY$
QQ = ASC(QQ$ + " ")
WEND 
LOCATE 25, 1: PRINT "preset time Alarm not operating!"; SPACE$(48);
LOCATE AA%, BB%

RETURN      


ALAF:      

II% = INT(CR / 1000)
GOSUB TAV
AL$ = TI$
II% = CR - INT(CR / 1000) * 1000
GOSUB TAV
QQ$ = AL$: PR$ = TI$: II% = DF
GOSUB TAV
PRINT MA$;
IF DF > 0 THEN PRINT TI$; MN$(JJ%); ", ";
PRINT QQ$; "Alafim ' "; PR$

RETURN


CLP:

CLS : PRINT
TI$ = TL$: GOSUB TIT
TI$ = TL1$: GOSUB TIT

RETURN


DOR:

FOR II% = 19 TO 21
LOCATE II%, IJ%: PRINT ""
NEXT

RETURN


DAT:

GOSUB APP: IF II% > 1 THEN RETURN
CLS : PRINT
RESTORE DAT
PRINT , : AL$ = "file ZODIAC.DAT  n o t  found ": GOSUB ALRT: GOSUB SND
PRINT
DATA"always start ZODIAC.EXE from within ZODIAC directory",
DATA"copy ZODIAC.EXE and ZODIAC.DAT files to same ZODIAC directory",
DATA"if not found, ZODIAC will create a new ZODIAC.DAT file",
DATA"type EXIT Enter to return from DOS to ZODIAC"
KK% = 7: GOSUB SCR
SHELL
GOSUB APP: IF II% > 1 THEN RETURN
OPEN "ZODIAC.DAT" FOR OUTPUT AS #1

FOR II% = 1 TO 58
IF II% < 55 THEN PRINT #1, "ZODIAC- Comments window page #"; II%; ". Enter your new comments." ELSE PRINT #1, "1,1,1"
NEXT
CLOSE
RETURN


APP:

CLOSE : II% = 0
OPEN "ZODIAC.DAT" FOR APPEND AS #1
II% = LOF(1): CLOSE

RETURN


SCR:

FOR II% = 1 TO KK%
READ GG$
PRINT MA$; GG$
NEXT

RETURN


ALMS:

QQ$ = ""
WHILE QQ$ = "" AND NN < 15
QQ% = 0
QQ$ = INKEY$
GOSUB SND
NN = NN + 1
WEND
IF CZ% = 1 AND QQ$ = "" THEN GOTO AA

RETURN


WE:

CO$ = LA$: AZ% = 1: GOSUB COMN: GOSUB ALMS

GOTO FST


WEL:

QQ$ = INKEY$: QQ = ASC(QQ$ + " "): QQ$ = UCASE$(QQ$)
WHILE INT(TIMER) <= TT
IF SMH$ = TIME$ THEN GOTO WE
IF INT(TIMER) <> T3 AND WZ$ <> DATE$ THEN GOTO FST
IF UX% = 0 AND QQ% = 0 AND (1 + VAL(MID$(TIME$, 4, 2))) MOD 15 = 0 AND VAL(RIGHT$(TIME$, 2)) = 55 THEN UX% = 6
IF BZ% = 1 AND LA$ <> "" THEN GOTO NEX
RESTORE WEL
DATA"   Welcome to","    ZODIAC   "," tempus fugit","TEMPUS FUGIT ","             "
FOR KK% = 1 TO 5
READ GG$
LOCATE INT(25 * RND + 1), 1
PRINT GG$; "";
NEXT
NEX:
NN = 0
WEND
LOCATE 10, 15
IF UX% > 0 THEN BEEP: UX% = UX% - 1
PRINT " at "; TIME$;
AL$ = "  . . .  T E M P U S   F U G I T  . . .": GOSUB ALRT
IF QQ = 13 THEN AZ% = 0: GOTO MAIN
IF QQ$ = "E" THEN GOTO AA
IF QQ$ = "H" THEN VU% = 16
IF QQ$ = "Q" THEN QQ% = 1
IF QQ$ = "R" THEN QQ% = 0: VU% = 0
IF QQ$ <> "" THEN RETURN FST

RETURN


SHL:

CLS : PRINT
PRINT , : AL$ = "type EXIT Enter to return to ZODIAC"
GOSUB ALRT
SHELL

GOTO MAIN


TIT:

PRINT , : COLOR 0, 15: PRINT TI$: COLOR 15, 0: PRINT

RETURN


ALRT:

COLOR 31 - VU%, 0: PRINT AL$: COLOR 15, 0

RETURN


BLINK:

PRINT : PRINT , ; : COLOR 16 - VU%, 15: PRINT PR$: COLOR 31 - VU%, 0: COLOR 15, 0

RETURN


IFEX:

AA% = CSRLIN: BB% = POS(0)
EC% = 1: EX% = DX%: GOSUB COMN: EC% = 0: EX% = 0
LOCATE AA%, BB%
GOSUB YESNO
IF EE% = 2 THEN EX% = DX%: GOSUB COMN
IF EX% > 0 THEN EX% = 0: GOTO MAIN

RETURN


BROWS:

CLS : PRINT
TI$ = " Browse through Comments file pages ": GOSUB TIT
PR$ = " type > =forwards < =backwards " + ES$: GOSUB BLINK
EX% = 0: CC% = 1
BRS:
EX% = EX% + CC%
IF EX% < 1 OR EX% > 58 THEN EX% = 1
EC% = 1: GOSUB COMN: EC% = 0
QQ$ = "": GOSUB PUTI
IF QQ$ = ">" THEN CC% = 1
IF QQ$ = "<" THEN CC% = -1
IF QQ = 27 THEN GOTO MAIN
GOTO BRS
                     

TOD:

MN = VAL(DATE$): DY = VAL(MID$(DATE$, 4, 2)): YR = VAL(RIGHT$(DATE$, 4))

RETURN


SPILL:

PRINT , : AL$ = "Caution! Spillover permitted. Examples: 0,1,2000 ; 32,2,1900"
GOSUB ALRT
PRINT

RETURN


HELP:

IF HL% = 1 THEN GOSUB SND: GOTO MAIN
CLS : PRINT
TI$ = TL$: GOSUB TIT
PRINT , : AL$ = "ZODIAC is  l a v i s h l y  annotated, ergo help is superfluous"
GOSUB ALRT
PR$ = ES$: GOSUB BLINK
HL% = 1
QQ$ = "": GOSUB PUTI
GOTO MAIN


ECLPS:

TL$ = " Lunar and Solar Eclipses near a given Date and onward "
CLS : PRINT
TI$ = TL$: GOSUB TIT
RESTORE ECLPS
DATA"1. Solar eclipse"
DATA"2. Lunar eclipse"
DATA"3. Rules of eclipses"
KK% = 3: GOSUB SCR
PR$ = DG$: GOSUB BLINK

FX% = 44

QQ$ = "": GOSUB PUTI: IJ% = VAL(QQ$): IF QQ = 27 THEN GOTO AG6
IF IJ% < 1 OR IJ% > 3 THEN GOTO AG6
FX% = IJ% + 44
IF IJ% = 3 THEN GOTO RULE

AG13:
GOSUB DATE: IF BB% = 1 THEN GOTO AG6
GOSUB GEOG: ZT = TZ + DS: TZ = 0: DS = 0
PRINT
QQ$ = " Height at Sea-level?" + YN$: DX% = FX%: GOSUB IFEX
IF EE% = 1 THEN HT = 0#: HM = 0#: PRINT : GOTO CONT
PRINT
PR$ = " input Height above Sea-level (meter) Enter ": GOSUB BLINK
PRINT : PRINT , : QQ$ = " ": GOSUB PUTI: INPUT HM: HT = HM / 6378140
CONT:
GOSUB JULDAY: IF BB% = 1 THEN GOTO AG6

AG11:
GOSUB FLMN
IF IJ% = 1 THEN EC$ = "Solar": DF = ABS(NB - INT(NB / PI) * PI): Q1 = NN: MN$ = "* New"
IF IJ% = 2 THEN EC$ = "Lunar": DF = ABS(FB - INT(FB / PI) * PI): Q1 = FF: MN$ = "* Full"
IF DF > .37# THEN DF = PI - DF
EC% = 0: IF DF < .242600766# THEN EC% = 2: PS$ = " certain"
IF EC% = 0 THEN IF DF < .37# THEN EC% = 1: PS$ = " possible"

Q2 = INT(Q1) + .5#: Q3 = FNW(Q1) - .5#: DP = 0#
IF Q3 < 0# THEN Q3 = Q3 + 1#: Q2 = Q2 - 1#
Q3 = Q3 * 24#
T1 = Q3 * 3600#: GOSUB HMS
DJ = Q2: GOSUB CALDAY
IF EC% = 0 THEN PS$ = " does not occur": GOTO RSLT
FC% = 0: GOSUB RSLT: AG% = 0
JMP9:
UT = Q3 - 1#: GOSUB SUN
LY = SR: GOSUB MOON: MY = MM: BY = BM: HY = PM
UT = UT + 2#: GOSUB SUN: SB = SR - LY
IF SB < 0# THEN SB = SB + TP
GOSUB MOON: MZ = MM: BZ = BM: HZ = PM: XH = Q3
IF IJ% = 2 THEN GOTO LUN
GOSUB NUT
GOSUB OBLIQ
XX = MY: YY = BY: TM = XH - 1#: HP = HY
GOSUB PRLX: MY = PP: BY = QQ
XX = MZ: YY = BZ: TM = XH + 1#: HP = HZ
GOSUB PRLX: MZ = PP: BZ = QQ
LUN:
X0 = XH + 1# - 2# * BZ / (BZ - BY): DM = MZ - MY
IF DM < 0# THEN DM = DM + TP
LJ = (DM - SB) / 2#: QQ = 0#
MR = MY + DM * (X0 - XH + 1#) / 2#
UT = X0 - .13851852#: GOSUB SUN
SR = SR + FNM(DP - .00569#)
IF IJ% = 2 THEN SR = SR + PI - INT((SR + PI) / TP) * TP: GOTO JMP6
XX = SR: YY = 0#: TM = UT
HP = .00004263452# / RR: GOSUB PRLX: SR = PP
JMP6:
BY = BY - QQ: BZ = BZ - QQ: P3 = .00004263#
ZH = (SR - MR) / LJ: TC = X0 + ZH
SH = (((BZ - BY) * (TC - XH - 1#) / 2#) + BZ) / LJ
S2 = SH * SH: Z2 = ZH * ZH: PS = P3 / (RR * LJ)
Z1 = ZH * Z2 / (Z2 + S2) + X0
IF AG% < 3 AND ABS(Z1 - Q3) > .05 THEN
AG% = AG% + 1
Q3 = Z1
GOSUB WRK
GOTO JMP9
END IF
H0 = (HY + HZ) / (2# * LJ): RM = .272446# * H0
RN = .00465242# / (LJ * RR): HD = H0 * .99834#
RU = (HD - RN + PS) * 1.02#: RP = (HD + RN + PS) * 1.02#
PJ = ABS(SH * ZH / SQR(S2 + Z2))
IF IJ% = 2 THEN GOTO JMP7
RR = RM + RN: GOSUB DDD
IF DD < 0# THEN EC% = 4: GOTO RSLT
GOSUB LIN
MG = (RM + RN - PJ) / (2# * RN)
GOTO RSLT

DDD:
DD = Z1 - X0: DD = DD * DD - (Z2 - RR * RR) * DD / ZH
RETURN

LIN:
ZD = SQR(DD): Z6 = Z1 - ZD
Z7 = Z1 + ZD - INT((Z1 + ZD) / 24#) * 24#
IF Z6 < 0# THEN Z6 = Z6 + 24#
RETURN

JMP7:
RR = RM + RP: GOSUB DDD
IF DD < 0# THEN EC% = 5: GOTO RSLT
GOSUB LIN
RR = RM + RU: GOSUB DDD
MG = (RM + RP - PJ) / (2# * RM)
IF DD < 0# THEN EC% = 6: GOTO RSLT
ZD = SQR(DD): Z8 = Z1 - ZD
Z9 = Z1 + ZD - INT((Z1 + ZD) / 24#) * 24#
IF Z8 < 0# THEN Z8 = Z8 + 24#
RR = RU - RM: GOSUB DDD
MG = (RM + RU - PJ) / (2# * RM)
IF DD < 0# THEN EC% = 7: GOTO RSLT
ZD = SQR(DD): ZC = Z1 - ZD
ZB = Z1 + ZD - INT((Z1 + ZD) / 24#) * 24#
IF ZC < 0# THEN ZC = ZC + 24#


RSLT:

CLS : PRINT
TI$ = TL$: GOSUB TIT
TI$ = " " + EC$ + " eclipse ": GOSUB TIT
PRINT MA$; WK$(WK%); DY; MG$(MN); YR; MN$; " Moon at UT(h:m:s): "; HMS$
PRINT MA$; LC$; USING "####.##"; GL; GQ;
PRINT USING "####.##hr."; ZT
PRINT MA$; "Height above Sea-level:"; HM; "meter"
PRINT MA$
PRINT MA$; : AL$ = EC$ + " eclipse" + PS$: GOSUB ALRT
IF EC% > 0 AND FC% = 0 THEN FC% = 1: PRINT : RETURN
IF EC% = 0 THEN GOTO AG12
IF EC% = 4 THEN QQ$ = "but is not seen from this location"
IF EC% = 5 THEN QQ$ = EC$ + " eclipse does not occur"
IF EC% = 4 OR EC% = 5 THEN PRINT MA$: PRINT MA$; : AL$ = QQ$: GOSUB ALRT: GOTO AG12
IF EC% = 6 THEN QQ$ = "No Umbral phase occurs"
IF EC% = 7 THEN QQ$ = "No Total phase occurs"
IF EC% > 5 THEN PRINT MA$: PRINT MA$; : AL$ = QQ$: GOSUB ALRT
PRINT MA$
IF MD% = 1 THEN MD% = 0: PRINT MA$; : AL$ = MD$: GOSUB ALRT: GOSUB SND: PRINT MA$
T1 = Z1 * 3600#: GOSUB HMS
PRINT MA$; "Maximum eclipse at UT : "; HMS$
T1 = Z6 * 3600#: GOSUB HMS
PRINT MA$; "Eclipse begins at UT : "; HMS$;
GOSUB SPL
T1 = Z7 * 3600#: GOSUB HMS
PRINT MA$; "Eclipse ends at UT : "; HMS$;
GOSUB SPL
PRINT MA$; USING "Magnitude of eclipse : #.###"; MG
IF IJ% = 2 AND EC% <> 6 THEN
T1 = Z8 * 3600#: GOSUB HMS
IF EC% <> 6 THEN PRINT MA$; "Umbral phase begins at UT : "; HMS$;
GOSUB SPL
T1 = ZC * 3600#: GOSUB HMS
IF EC% < 7 THEN
PRINT MA$; "Total phase begins at UT : "; HMS$;
GOSUB SPL
END IF
T1 = ZB * 3600#: GOSUB HMS
IF EC% < 7 THEN
PRINT MA$; "Total phase ends at UT : "; HMS$;
GOSUB SPL
END IF
T1 = Z9 * 3600#: GOSUB HMS
IF EC% <> 6 THEN
PRINT MA$; "Umbral phase ends at UT : "; HMS$;
GOSUB SPL
END IF
END IF

AG12:
DX% = FX%
QQ$ = " Continue?" + YN$: GOSUB IFEX
IF EE% = 1 THEN DJ = DJ + 28 / IJ%: GOSUB CALDAY: GOTO AG11
PRINT

AG6:
DX% = FX%
QQ$ = AG$: GOSUB IFEX
IF EE% = 1 THEN GOTO ECLPS
GOTO MAIN

SPL:

QQ$ = "": IF Z1 * 3600# - T1 > 21600# THEN QQ$ = " on Next UT day"
IF T1 - Z1 * 3600# > 21600# THEN QQ$ = " on Previous UT day"
AL$ = QQ$: GOSUB ALRT

RETURN


RULE:

CLS : PRINT
TI$ = " Notes, and `Rules' of (SE=Solar, LE=Lunar,) eclipses ": GOSUB TIT
RESTORE RULE
DATA"Notes: ZODIAC assumes transparent Earth. Event visible only if"
DATA"       occurring above horizon. Check Sun/Moon Rise/set time."
DATA"       ZODIAC displays UT. For Local time add local UT Offset."
DATA"Rules:"
DATA"   1. SE [LE] occurs at New, [Full] Moon."
DATA"  2. SE Minimum 2, Maximum 5 per year."
DATA"  3. LE Maximum 3 per year."
DATA"  4. SE+LE Maximum 7 per year."
DATA"  5. LE preceded or followed by SE."
DATA"  6. Saros cycle (not exact): SE-LE pattern repeats at 18yr."
DATA"     11day (6585day) and 8hr., or 223 lunar months interval."
DATA"  7. No Total LE: angle between Moon OR Sun and node > 1215'."
DATA"  8. Yes LE: angle between Moon AND Sun, and node < 930'."
DATA"  9. No SE: angle between Sun OR Moon, and node > 1831'."
DATA" 10. Yes SE: angle between Sun AND Moon, and node < 1531'."
DATA" 11. LE phases: total Max. 1hr. 40min., umbral 3hr. 40min."
DATA" 12. SE: total Max. 7min. 40sec., annular Max. 12min. 24sec."
KK% = 17: GOSUB SCR
GOTO AG6


PRLX:

SW3 = -1#: GOSUB EQECL: CN = 3.819718634#
X1 = PP * CN: SW2 = 1: GOSUB TIME
XX = SG + GL / 15#: GOSUB ITR: LS = XX
XX = LS - X1: GOSUB ITR: PP = XX
XX = PP / CN: YY = QQ

ZE = .9966469999999999#
C1 = COS(GP): S1 = SIN(GP)
UU = ATN(ZE * S1 / C1)
C2 = COS(UU): S2 = SIN(UU)
RS = ZE * S2 + HT * S1
RC = C2 + HT * C1
RP = 1 / SIN(HP)
CX = COS(XX): SY = SIN(YY): CY = COS(YY)
AA = RC * SIN(XX) / (RP * CY - RC * CX)
DX = ATN(AA): PP = XX + DX: CP = COS(PP)
WHILE PP > TP: PP = PP - TP: WEND
WHILE PP < 0#: PP = PP + TP: WEND
QQ = ATN(CP * (RP * SY - RS) / (RP * CY * CX - RC))

YY = QQ: X1 = PP * CN
XX = SG + GL / 15#: GOSUB ITR: LS = XX
XX = LS - X1: GOSUB ITR: PP = XX
XX = PP / CN: SW3 = 1#: GOSUB EQECL

RETURN


COP:

CLOSE
OPEN "ZODIAC.DAT" FOR INPUT AS #1
IF EC% = 0 THEN OPEN "ZODIAC.TMP" FOR OUTPUT AS #2
FOR II% = 1 TO EX%
LINE INPUT #1, CO$
IF EC% = 0 AND II% < EX% THEN PRINT #2, CO$
NEXT
IF EC% = 1 THEN CLOSE
RETURN

LENG:
II% = LEN(GG$): IF II% = 0 THEN GG$ = "No comment"
IF RIGHT$(GG$, 1) = " " THEN GG$ = LEFT$(GG$, II% - 1): GOTO LENG
RETURN

COPY:

GOSUB LENG
PRINT #2, GG$
FOR II% = EX% + 1 TO 58
LINE INPUT #1, CO$
PRINT #2, CO$
NEXT
CLOSE
SHELL "DEL ZODIAC.DAT"
SHELL "REN ZODIAC.TMP ZODIAC.DAT"
     
RETURN


COMN:

FOR II% = 1 TO 24
LOCATE II%, 1
PRINT , ;
NEXT

IF AZ% = 0 THEN GOSUB COP
LOCATE 2, 1
COLOR 0, 15: PRINT "Comments:p."; RIGHT$(STR$(EX%), 2); : COLOR 15, 0: PRINT ""
WN$ = SPACE$(13) + ""
PRINT WN$
MM% = 0: CT$ = CO$
WHILE LEN(CT$) > 0
CT$ = MID$(CO$, 1 + MM% * 13, 13)
MM% = MM% + 1
IF LEN(CT$) > 0 THEN PRINT USING "\           \"; CT$; : PRINT ""
WEND
IF EC% = 1 OR AZ% = 1 THEN RETURN
QQ$ = " New? (Y N) ": GOSUB YESNO
IF EE% = 0 THEN RETURN

ONC:

CLS
TI$ = " Comments Editor ": GOSUB TIT
QQ$ = " ": GOSUB PUTI
COLOR 0, 15: PRINT " Old Comments: ": COLOR 15, 0
PRINT
IF AZ% = 1 THEN CO$ = LA$
GG$ = LEFT$(CO$ + SPACE$(247), 247)
PRINT GG$;
PR$ = " input New Comments (up to 3 lines) Enter (use > < to move right, left) ": GOSUB BLINK
PRINT
PRINT GG$
JJ% = 1
MRE:
IF JJ% > 247 THEN JJ% = 247
LOCATE 12 + (JJ% - 1) \ 80, 1 + (JJ% - 1) MOD 80
MR$ = INKEY$: IF MR$ = "" THEN GOTO MRE
IJ% = ASC(MR$)
IF IJ% = 13 THEN GOTO RET
IF IJ% = 62 THEN
JJ% = JJ% + 1
GOTO MRE
END IF
IF IJ% = 60 THEN
JJ% = JJ% - 1
GOTO MRE
END IF
MID$(GG$, JJ%) = MR$
JJ% = JJ% + 1
PRINT MR$;
GOTO MRE
RET:
GOSUB LENG
LOCATE 12, 1: PRINT GG$: PRINT
COLOR 0, 15: PRINT " Review: ": COLOR 15, 0
PRINT
PRINT GG$
QQ$ = " Save New comment?" + PY$
DX% = EX%: EX% = 0: GOSUB YESNO: EX% = DX%
IF EE% = 0 THEN GOTO ONC
IF EE% = 1 THEN
IF AZ% = 1 THEN CO$ = GG$: LA$ = GG$: GOTO FST
GOSUB COPY
END IF
GOTO MAIN


HIJRA:

DW% = 0
TL$ = " Hijra Perpetual calendar "
CLS : PRINT
TI$ = TL$: GOSUB TIT
FX% = 23
GOSUB HEBHIJ: IF QQ = 27 THEN GOTO AGN6
NY = 10631#

FX% = II% + 23               
ON II% GOTO CMNHIJ, HIJCMN, ATTRHIJ, ONSETHIJ, MJRH, SPRDHIJ, HIJRUL

REST:
DATA 0,1,0,0,1,0,1,0,0,1,0,0,1,0,0,1,0,1,0,0,1,0,0,1,0,1,0,0,1,0

AGN6:
QQ$ = AG$: DX% = FX%: GOSUB IFEX
IF EE% = 1 THEN GOTO HIJRA
GOTO MAIN



FFORH:

GOSUB CLP
QQ$ = "for Hijra calendar Year "
IF HY >= 1 THEN PRINT MA$; QQ$; HY
IF HY < 1 THEN PRINT MA$; : AL$ = "available only " + QQ$ + "1 or later": GOSUB ALRT: GOSUB SND: RETURN
DH = HD: MH = HM
DW% = 1: GOSUB HIJCM
DJ0 = DJ
FF = HY
HY = HY + 1: GOSUB HIJCM
DJ1 = DJ
LN = DJ1 - DJ0
DJ = DJ0
GOSUB CALDAY
PRINT MA$; "beginning on Common calendar Date"; DY; MG$(MN); YR
PRINT MA$
HD = DH: HM = MH

RETURN


CMNHIJ:

TL1$ = " Common calendar to Hijra calendar Date transformation "
GOSUB DATE: IF BB% = 1 THEN GOTO AGN6
M1 = DY: M2 = MN: M3 = YR: M4 = WK%
CMNH:
DF = JD - HG
IF DH% < 2 AND DF < 0 THEN HY = 0: GOSUB FFORH: GOTO AGN6
VD = INT(DF / NY)
HY = VD * 30 + 1
DF = DF - VD * NY + 1
RESTORE REST
HIJY:
READ YC
M5 = 354# + YC
VM = DF - M5: IF VM > 0 THEN DF = VM: HY = HY + 1: GOTO HIJY
FOR JJ% = 1 TO 12
M5 = 29 + (JJ% MOD 2)
IF JJ% = 12 THEN M5 = 29 + CY
VM = DF - M5
IF VM < 1 THEN GOTO FNL
DF = VM
NEXT
FNL:
IF DH% > 0 THEN QQ$ = MO$(JJ%): AA = HY: RETURN
M6 = DF
KK% = JJ%
GOSUB FFORH
PRINT MA$; "Common"; CD$; M1; MG$(M2); M3
PRINT MA$
PRINT MA$; "Hijra "; CD$; M6; MO$(KK%); FF
PRINT MA$
PRINT WD$; WK$(M4)
II% = CSRLIN
PRINT MA$
GOSUB MOMN
PRINT

GOTO AGN6


MOMN:

FOR KK% = 0 TO 3
LOCATE II% + 1 + KK%, 1
PRINT MA$;
FOR JJ% = 1 TO 3
LL% = JJ% + 3 * KK%
PRINT USING "##"; LL%;
PRINT " "; USING "\            \"; MO$(LL%);
IJ% = LL% MOD 2
QQ$ = "29": IF IJ% = 1 THEN QQ$ = "30"
IF JJ% = 3 THEN QQ$ = "" + QQ$
IF LL% = 12 THEN QQ$ = "29/30"
PRINT QQ$; "";
NEXT JJ%, KK%

RETURN


INH:

TL1$ = CT$ + " calendar to Common calendar Date transformation "
GOSUB CLP
PR$ = " input" + CT$ + " calendar date: (Day,Mth.#,Hijra Yr.) Enter ": GOSUB BLINK
PRINT
GOSUB TOD
GOSUB JULDAY
VJ = DJ: VY = YR
JD = DJ + DJJ
DH% = 1
ON DU% GOSUB CMN, CMNH
DH% = 0
PRINT , "Example (Today's date):"; DF; QQ$; AA; " = "; DF; ","; JJ%; ","; AA
II% = CSRLIN

RETURN


HIJCMN:

CT$ = " Hijra"
DU% = 2: GOSUB INH
GOSUB MOMN
GOSUB IFFN
IF HD = -1 THEN GOTO AGN6
GOSUB FFORH
IF HY < 1 THEN GOTO AGN6
HY = FF
DW% = 0
HIJCM:
IF DW% = 1 THEN HD = 1: HM = 1
VY = INT((HY - 1) / 30#)
NN = VY * NY
VY = HY - VY * 30
RESTORE REST
CMNM:
READ YC
DF = 354# + YC
VM = VY - 1: IF VM >= 1 THEN VY = VY - 1: NN = NN + DF: GOTO CMNM
FOR II% = 1 TO HM
DF = 29 + (II% MOD 2)
IF II% = 12 THEN DF = DF + YC
NN = NN + DF
NEXT
DJ = NN + HG - DJJ - DF + HD - 1
IF DW% = 1 THEN RETURN
GOSUB CALDAY
PRINT MA$; "Hijra "; CD$; HD; MO$(HM); HY
PRINT MA$
PRINT MA$; "Common"; CD$; DY; MG$(MN); YR
PRINT MA$
PRINT WD$; WK$(WK%)
II% = CSRLIN
PRINT MA$
GOSUB MOMN
PRINT

GOTO AGN6


ONAT:

GOSUB DATE: IF BB% = 1 THEN RETURN
DH% = 1
IF YR = 622 THEN JD = HG
GOSUB CMNH: DH% = 0
GOSUB FFORH

RETURN


ATTRHIJ:

TL1$ = " Attributes of Hijra calendar Year "
GOSUB ONAT: IF BB% = 1 THEN GOSUB AGN6
PRINT MA$; "the number of Days in this Year is"; LN
PRINT MA$; "this Year is a ";
IF LN = 355 THEN PRINT "Leap";: CO$ = "30"  ELSE PRINT "Simple";: CO$ = "29"
PRINT " year ("; CO$; " days in Zu'l-Hijjah)"
QQ$ = "1 Muharram"
XX = FF
GOSUB USI
DJ = DJ1
GOSUB CALDAY
XX = HY
GOSUB USI
II% = CSRLIN
PRINT MA$
GOSUB MOMN
PRINT

GOTO AGN6


USI:

PRINT MA$; "New Year "; QQ$; XX;"= "; WK$(WK%);","; DY; " "; MG$(MN); YR

RETURN


ONSETHIJ:

TL1$ = " Onset of Hijra calendar Months and related New Moon date"
GOSUB ONAT: IF BB% = 1 THEN GOTO AGN6
LN = LN - 354
DJ2 = DJ0
FOR JJ% = 1 TO 12
CT$ = MO$(JJ%)
GOSUB BG
DM = 29 + JJ% MOD 2: IF JJ% = 12 THEN DM = DM + LN
GOSUB FM
NEXT

GOTO AGN6


SPRDHIJ:

DH% = 2
TL1$ = "Hijra"
GOSUB SP: IF BB% = 1 THEN GOTO AGN6
GOSUB STR

PRINT " "; MO$(JJ1%); QQ$; ", ";
CR1 = CR: GOSUB STR
PRINT MO$(JJ%); QQ$; SPACE$(79 - POS(0))

GOTO AGN6


STR:

QQ$ = STR$(CR1)
QQ$ = RIGHT$(QQ$, LEN(QQ$) - 1)

RETURN


MJRH:

TL1$ = " Date and Duration (D=number of days) of major Calendar events "
GOSUB ONAT: IF BB% = 1 THEN GOTO AGN6
RESTORE MJRH
DATA 0,1,1,1,"New Year, 1st Hijra Day",236,9,1,30,"Ramadan fasting begins"
DATA 265,9,30,1,"end of Ramadan fasting",266,10,1,3,"Eid al-Fiter"
DATA 334,12,10,4,"Eid al-Adha"

FOR JJ% = 1 TO 5
READ AA%, BB%, CC%, DD%, CT$
DJ = DJ0 + AA%
GG$ = " "
CO$ = MO$(BB%)
GOSUB MJ
NEXT


GOTO AGN6


HIJRUL:

CLS : PRINT
TI$ = TL$: GOSUB TIT
TI$ = " Hijra calendar Rules ": GOSUB TIT
RESTORE HIJRUL
DATA"1. The epoch is 16 July 622 CE, day 1 of Muharram,"
DATA"   Hijra year 1."
DATA"2. A cycle of 30 years is defined, beginning with Hijra year 1."
DATA"3. Each year has 12 months."
DATA"4. Months are alternating 30/29 days, 354 days in regular years."
DATA"5. Cycle years 2,5,7,10,13,16,18,21,24,26,29 are leap years of"
DATA"   355 days: 1 day is added to the last month Zu'l-Hijjah."
DATA"6. Number of days in a cycle is 10631."
DATA"7. The present calendar Mean Tabular Month is about 2.9 sec."
DATA"   less than the Lunar Synodic Month."
DATA"8. Traditionally days begin on the eve of the previous Common"
DATA"   calendar Date."
KK% = 12: GOSUB SCR

GOTO AGN6


HEBHIJ:

RESTORE HEBHIJ
CLS : PRINT
TI$ = TL$: GOSUB TIT
DATA"1. Common calendar Date transformation into Calendar Date"
DATA"2. Calendar Date transformation into Common calendar Date"
DATA"3. Attributes of Calendar Year"
DATA"4. Onset of Calendar Months and date of New Moon"
DATA"5. Major Holidays Dates"
DATA"6. Monthly Spreadsheet"
DATA"7. Calendar Rules"
KK% = 7: GOSUB SCR
IF DW% = 1 THEN PRINT MA$; CT$
PR$ = DG$: GOSUB BLINK
QQ$ = "": GOSUB PUTI: II% = VAL(QQ$): IF QQ = 27 THEN RETURN

RETURN


HEBREW:

DW% = 1
TL$ = " Hebrew Perpetual calendar "
CT$ = "8. Hebrew Numerals"

FX% = 12

GOSUB HEBHIJ: IF QQ = 27 THEN GOTO AGN9

FX% = II% + 12

ON II% GOTO CMNHEB, HEBCMN, ATTR, ONSET, MJR, SPRD, FORM, NUM

AGN9:
QQ$ = AG$: DX% = FX%: GOSUB IFEX
IF EE% = 1 THEN GOTO HEBREW
GOTO MAIN


NUM:

CLS : PRINT
FX% =22
TI$ = " Hebrew Numerals and transformation ": GOSUB TIT
PRINT MA$; "Numerical values of Hebrew characters, and zero:"
PRINT MA$
CC% = 10
GOSUB NUMB
PRINT
PR$ = " Input Hebrew year number, Enter. Example:" + STR$(VAL(RIGHT$(DATE$, 4)) + 3760) + " ": GOSUB BLINK
PRINT
PRINT , : QQ$ = " ": GOSUB PUTI: INPUT CR
IF CR > 999999 OR CR < 1 THEN
PRINT
PRINT , : AL$ = "only integers 1 to 999999": GOSUB ALRT
GOSUB SND
GOTO AGN9
END IF
PRINT
PRINT MA$; "Alafim (thousands) and remainder, in Hebrew numerals:"
PRINT MA$
DF = 0: GOSUB ALAF
                           
GOTO AGN9


NUMB:

RESTORE NUMB
DATA 0,1,0,1,10,10,10,10,20,100
FOR IJ% = 0 TO 4
READ AA%, BB%
PRINT MA$;
FOR II% = 1 TO 5 - AA% \ 20
DW% = II% + 5 * IJ%
PRINT USING "\    \"; HB$(DW%);
PRINT "="; USING "###"; (DW% - AA%) * BB%;
PRINT " ";
NEXT
PRINT
NEXT
LOCATE CC%, 65
PRINT HB$(25) + "  =  0";

RETURN


TAV:
IJ% = II% \ 100: II% = II% - IJ% * 100
TI$ = ""
TV:
IF IJ% > 3 THEN TI$ = TI$ + "Tav ": IJ% = IJ% - 4: GOTO TV
IF IJ% > 0 THEN TI$ = TI$ + HB$(20 + IJ%) + " "
IF II% = 15 THEN TI$ = TI$ + "Tet Waw ": RETURN
IF II% = 16 THEN TI$ = TI$ + "Tet Zayin ": RETURN
IJ% = II% \ 10: II% = II% - IJ% * 10
IF IJ% > 0 THEN TI$ = TI$ + HB$(IJ% + 10) + " "
IF II% > 0 THEN TI$ = TI$ + HB$(II%) + " "
IF TI$ = "" THEN TI$ = HB$(25) + " "
RETURN


FORM:

CLS : PRINT
TL$ = " Hebrew calendar Rules and the Gauss formula. Page "
TI$ = TL$ + "1 ": GOSUB TIT
RESTORE FORM
DATA" 1. Gf(Gauss formula) method: Align H(ebrew) and J(ulian)"
DATA"    c(alendar|s) to S(olar) Y(ear). For given JY Gf yields the"
DATA"    date Z in March or Z-31 in April, +D(ay) fraction z, of 15"
DATA"    Nisan, 1st D of P(assover)."
DATA" 2. Add HD +6h(our) to align HD to X(next) JD. XJD-6h=HD, HD-6h"
DATA"    is the original JD or G(regorian)D time of event."
DATA" 3. In H c 1h=1080p(art), 1p=76i(nstant). M(onth)=28D+E(xcess)="
DATA"    4W(eek)+(1.5D+793p)=765433p. C(ycle)=235M=19SY=12N(ormal)Y+"
DATA"    7L(eap)Y. SY=235M/19=NY+7M/19=LY-12M/19. NY=12M=50W+NYE,"
DATA"    LY=13M=54W+LYE. NYE=4D+8h+876p, LYE=5D+21h+589p. SY=365D+5h"
DATA"    +997p+48i. HY=JY+3760. No JY=0! If JY is BCE use JY=-JY+1."
DATA" 4. A(ccumulated lag) SY < C Y in M/19 units=(12HY+17)MOD19."
DATA"    CY  # :  1 2  3 4 5  6 7  8  9 10 11 12 13 14 15 16 17 18 19"
DATA"    t(ype):  N N  L N N  L N  L  N  N  L  N  N  L  N  N  L  N  L"
DATA"    A   = : 10 3 15 8 1 13 6 18 11  4 16  9  2 14  7  0 12  5 17"
DATA" 5. T(commencement)  M|NY|LY = previous T + 4|50|54W+ME|NYE|LYE."
KK% = 16: GOSUB SCR
QQ$ = " Continue?" + YN$
DX% = 19: GOSUB IFEX
IF EE% = 0 THEN GOTO MAIN


CLS : PRINT
TI$ = TL$ + "2 ": GOSUB TIT
DATA" 6. Heshvan|Kislev: 29|30D in r(egular)Y, 29|29D d(eficient)Y,"
DATA"    30|30D in a(bundant)Y. rNY=354D, rLY=384. dY -1D, aY +1D."
DATA" 7. Adar NY is 29D. In LY Adar is 30D, before Adar sheni 29D."
DATA" 8. Dr(Delay rules) for TY(1 Tishrei). Add  1 or 2 D to avoid"
DATA"    TY of HY+1: (a) on WD1(Sunday), WD4 or WD6; (b) on NY, on"
DATA"    WD3 on|after HD 9h+204p=XJD 15h+204p=u=1367/2160D; (c) on"
DATA"    NY AND after LY, on WD2 on|after HD 15h+589p=XJD 21h+589p=v"
DATA"    =23269/25920D. HY t r|d|a accomodates delays of TY of HY+1."
DATA"    Late NM(NewMoon) `Molad Zaken' Dr redundant in XJD format!"
DATA" 9. Only 14 sets of TY WD|d-r-a t|1st P WD. For NY: 2|d|3 2|a|5"
DATA"    3|r|5 5|r|7 5|a|1 7|d|1 7|a|3. For LY: 2|d|5 2|a|7 3|r|7"
DATA"    5|d|1 5|a|3 7|d|3 7|a|5."
DATA"10. TY of HY on same WD as 3rd P D of HY-1. Hence T of P never"
DATA"    on WD2, WD4, WD6."
DATA"11. Creation NM `Molad Tohu': TY of HY=1, aNY of C #1, WD2 HD"
DATA"    5h+204p=XJD 11h+204p=.466..D. (JD 7|10|3761 BCE). Creation"
DATA"    of Man, NM of Tishrei HY=2 `Molad Adam', WD6 HD 14h."
KK% = 17: GOSUB SCR
QQ$ = " Continue?" + YN$
DX% = 20: GOSUB IFEX
IF EE% = 0 THEN GOTO MAIN

CLS : PRINT
TI$ = TL$ + "3 ": GOSUB TIT
DATA"12. HY=1 precedes SY by 17M/19=17x765433/19/1080/24D=26D+"
DATA"    .422..D. F=.466..-.422..=4343/98496D. F is ~~1h discrepancy!"
DATA"13. J A(verage) Y=365.25D. JAY is longer than SY by R=82p+28i="
DATA"    313/98496D. JY=365D+B. B=JY MOD4."
DATA"14. To align the J c and H c Gf also includes a constant K=32D."
DATA"    Finally Gf is: Z+z=K+F+AxM/19+.25xB-RxHY."
DATA"15. P Dr: Compute WD=(Z+3H+5B+5)MOD7. (a) if WD=2, 4, 6 add 1D;"
DATA"    (b) if WD=1, A>6, zu add 2D; (c) if WD=0, A>11, zv add 1D."
DATA"    Correct for G c: Add 10D on|after 15 October 1582, add 1D"
DATA"    for GY which is divisible into 100 but not into 400."
DATA"16. Find length V of HY: Compute the P G date for HY and HY-1."
DATA"    All changes in HY, Adar sheni in LY and d-r-a t are already"
DATA"    included. V fully detrmines HY properties."
DATA"17. Above rules and formulas are based on Fraenkel, and Keren,"
DATA"    see Info. This is how ZODIAC works, and ZODIAC knows best.."
KK% = 15: GOSUB SCR
FX% = 21: GOTO AGN9

             
INIT:

GOSUB DATE: IF BB% = 1 THEN GOTO AGN9
IN:
VJ = DJ: VY = YR: VM = MN: VD = DY: DW% = WK%
INI:
DY = 1#: MN = 3#: GOSUB JULDAY: IF BB% = 1 THEN GOTO AGN9
Y1 = YR
GOSUB GAUSS: DJ1 = DJ: CR = YC
YR = YR - 1#: IF YR = 0# THEN YR = -1#
DY = 1#: MN = 3#: GOSUB JULDAY: IF BB% = 1 THEN GOTO AGN9
Y1 = YR
GOSUB GAUSS: DJ0 = DJ
LN = DJ1 - DJ0
LN% = 0: IF LN > 355 THEN LN% = 1
IF LN = 383 OR LN = 353 THEN DA% = 1
IF LN = 384 OR LN = 354 THEN DA% = 2
IF LN = 385 OR LN = 355 THEN DA% = 3

RETURN


GAUSS:

IF Y1 < 1# THEN Y1 = Y1 + 1#
YC = Y1 + 3760#
AA = 12# * YC + 17#: AA% = AA - INT(AA / 19#) * 19#
BR% = YC - INT(YC / 4#) * 4#
FF = 32# + 4343# / 98496# + 765433# / 492480# * AA% + .25# * BR% - 313# / 98496# * YC
MM% = INT(FF)
MF = FNW(FF)
CC = MM% + 3# * YC + 5# * BR% + 5#
CC% = CC - INT(CC / 7#) * 7#
IF CC% = 2 OR CC% = 4 OR CC% = 6 THEN MM% = MM% + 1
IF CC% = 1 AND AA% > 6 AND MF >= 1367# / 2160# THEN MM% = MM% + 2
IF CC% = 0 AND AA% > 11 AND MF >= 23269# / 25920# THEN MM% = MM% + 1
MN = 3#: DY = MM% - BB
GOSUB JULDAY: IF BB% = 1 THEN GOTO AGN9

RETURN


SP:

TL1$ = " Common and " + TL1$ + " calendars monthly Spreadsheet "
GOSUB DATE: IF BB% = 1 THEN RETURN
IF YR = 1582# AND MN = 10# THEN DY = 10#
GOSUB JULDAY: IF BB% = 1 THEN PRINT : PRINT , : AL$ = "Spreadsheet not available for this month": GOSUB ALRT: RETURN

CLS
TI$ = TL$: GOSUB TIT
TI$ = TL1$: GOSUB TIT
UM1% = MN: UY1 = YR
DY = 1#: GOSUB JULDAY
IF DH% = 1 AND JD < 347997.5 THEN CR = 0: GOSUB FFOR: BB% = 1
IF DH% = 2 AND JD < HG - 15 THEN HY = 0: GOSUB FFORH: BB% = 1
UJ1 = DJ: WK1% = WK%
MN = MN + 1#: IF MN = 13# THEN MN = 1#: YR = YR + 1#: IF YR = 0# THEN YR = 1#
UM2% = MN: UY2 = YR
GOSUB JULDAY
UJ2 = DJ
LM = UJ2 - UJ1
VJ = UJ1: VY = UY1
JD = UJ1 + DJJ
ON DH% GOSUB CMN, CMNH
DF1 = DF
JJ1% = JJ%
IF DH% = 1 THEN DH% = 3: CR1 = CR: VJ = UJ2 - 1: VY = UY2: GOSUB CMN: MR$ = "Heb. "
IF DH% = 2 THEN CR1 = HY: JD = UJ2 + DJJ - 1: GOSUB CMNH: CR = HY: MR$ = "Hij. "
DH% = 0

NN% = 1
FOR KK% = 0 TO 5
PRINT MA$; STRING$(55, "")
QQ$ = STRING$(48, "")
PRINT MA$; "Com. "; QQ$
PRINT MA$; MR$; QQ$
FOR AA% = 0 TO 2
GOSUB FORL
NEXT: NEXT
LOCATE 21, 36: PRINT " Common calendar Month: "; MG$(UM1%); UY1
LOCATE 22, 36

RETURN


SPRD:

DH% = 1
TL1$ = "Hebrew"
GOSUB SP: IF BB% = 1 GOTO AGN9
PRINT " Hebrew Month/s: "; MN$(JJ1%); CR1; MN$(JJ%); CR

GOTO AGN9


FORL:

FOR LL% = 0 TO 6
LOCATE 5 + AA% + KK% * 3
GG% = 7 * KK% + LL% - WK1% + 1
IF GG% >= LM + 1 THEN PRINT : RETURN
IF AA% = 0 THEN LOCATE , 7 * LL% + 23: PRINT LEFT$(WK$(LL%), 3): GOTO JUM
HH% = GG%: MD% = UM1%
IF AA% = 2 THEN
MD% = JJ1%
HH% = GG% + DF1 - 1
IF GG% >= LM - DF + 1 THEN HH% = NN%: NN% = NN% + 1: MD% = JJ%
END IF
GG$ = STR$(HH%) + "/" + STR$(MD%)
IF GG% < 1 THEN GOTO JUM
LOCATE , 7 * LL% + 22: PRINT USING "\     \"; GG$;
JUM:
NEXT

RETURN

IFFN:

PRINT
PRINT
GOSUB SPILL
PRINT , : QQ$ = " ": GOSUB PUTI: INPUT HD, HM, HY
IF FNW(HD) <> 0# OR FNW(HM) <> 0# OR FNW(HY) <> 0# OR HD < 0 OR HM <= 0 THEN
PRINT
PRINT , : AL$ = "day/month/year integer, month > 0, no negative day": GOSUB ALRT
GOSUB SND
HD = -1
END IF

RETURN


HEBMN:

RESTORE HEBMN
DATA 30,29/30,30/29,29,30,29/30,29,30,29,30,29,30,29,
FOR KK% = 0 TO 3
LOCATE II% + 1 + KK%, 1
PRINT MA$;
FOR JJ% = 1 TO 4
READ LN$
LL% = JJ% + 4 * KK%
IF LL% = 14 THEN GOTO FIN1
PRINT USING "##"; LL%;
PRINT " "; USING "\      \"; MN$(LL%);
PRINT LN$; "";
NEXT JJ%, KK%
FIN1:
PRINT

RETURN


HEBCMN:

CT$ = " Hebrew"
DU% = 1: GOSUB INH
GOSUB HEBMN
CC% = 20
PRINT
GOSUB NUMB
GOSUB IFFN
IF HD = -1 THEN GOTO AGN9
YR = HY - 3760#: IF YR <= 0# THEN YR = YR - 1#
VY = YR
GOSUB INI
IF LN% = 0 AND HM = 7 THEN
PRINT
PRINT , : AL$ = "no Adar 2 month in year" + STR$(HY): GOSUB ALRT
GOSUB SND
GOTO AGN9
END IF

DJ = DJ0 + 162#
GOSUB CALDAY
GOSUB FFOR
FOR JJ% = 1 TO HM
IF JJ% = 7 AND LN% = 0 THEN GOTO JMP2
KK% = JJ%:  IF JJ% > 7 AND LN% = 0 THEN KK% = JJ% - 1
IF LN% = 1 AND JJ% > 5 THEN KK% = KK% + 1
DM = KK% MOD 2 + 29#
IF JJ% = 3 AND DA% = 1 THEN DM = 29#
IF JJ% = 2 AND DA% = 3 THEN DM = 30#
DJ = DJ + DM
JMP2:
NEXT
DJ = DJ - DM + HD
GOSUB CALDAY
IF CR < 1 GOTO AGN9
PRINT MA$; "Hebrew"; CD$; HD; MN$(HM); HY
DF = HD: JJ% = HM: CR = HY
GOSUB ALAF
PRINT MA$
PRINT MA$; "Common"; CD$; DY; MG$(MN); YR
PRINT MA$
PRINT WD$; WK$(WK%)
II% = CSRLIN
PRINT MA$
GOSUB HEBMN

GOTO AGN9


CMNHEB:

TL1$ = " Common calendar to Hebrew calendar Date transformation "
GOSUB INIT
CMN:
IF DH% = 1 THEN GOSUB INI
IF VJ >= DJ1 + 163# THEN
YR = VY + 1#: IF YR = 0# THEN YR = 1#
GOSUB INI: YY% = 1
END IF
DJ2 = DJ0 - 15#
FOR JJ% = -5 TO 13
IF JJ% = 7 AND LN% = 0 THEN GOTO JMP1
KK% = ABS(JJ%):  IF JJ% > 7 AND LN% = 0 THEN KK% = JJ% - 1
IF LN% = 1 AND JJ% > 5 THEN KK% = KK% + 1
NN = KK% MOD 2 + 29#
IF JJ% = 3 AND DA% = 1 THEN NN = 29#
IF JJ% = 2 AND DA% = 3 THEN NN = 30#
DF = VJ - DJ2: IF DF <= NN THEN GOTO FIN
DJ2 = DJ2 + NN
JMP1:
NEXT
FIN:
IF JJ% < 1 THEN JJ% = JJ% + 13: CR = CR - 1
IF DH% = 1 OR DH% = 3 THEN RETURN
GOSUB FFOR
IF CR < 1 THEN GOTO AGN9
PRINT MA$; "Common"; CD$; VD; MG$(VM); VY
PRINT MA$
PRINT MA$; "Hebrew"; CD$; DF; MN$(JJ%); CR
GOSUB ALAF
PRINT MA$
PRINT WD$; WK$(DW%)
II% = CSRLIN
PRINT MA$
GOSUB HEBMN

GOTO AGN9


UBI:

GOSUB INIT
IF VY = -3761 THEN YR = -3760: GOSUB IN
GOSUB FFOR
IF CR < 1 THEN GOTO AGN9

RETURN


ATTR:

TL1$ = " Attributes of Hebrew calendar Year "
GOSUB UBI
PRINT MA$; "the number of Days in this Year is"; LN
PRINT MA$; "this Year is a ";
IF LN% = 1 THEN PRINT "Leap year (13 months"; ELSE PRINT "Simple year (12 months, not";
PRINT " comprising Adar 2)" 
PRINT MA$; "this Year is ";
IF DA% = 1 THEN CO$ = "Deficient"
IF DA% = 2 THEN CO$ = "Regular"
IF DA% = 3 THEN CO$ = "Abundant"
PRINT CO$; " (Heshvan"; 29 + DA% \ 3; "days, Kislev"; 29 + DA% \ 2; "days)"
DJ = DJ0 + 163#
GOSUB CALDAY
QQ$ = "1 Tishrei"
XX = CR
GOSUB USI
DJ = DJ1 + 163#
GOSUB CALDAY
XX = CR + 1
GOSUB USI
II% = CSRLIN
PRINT MA$
GOSUB HEBMN

GOTO AGN9


FM:

DJ2 = DJ2 + DM
PRINT DM; USING " \ \"; WK$(WK%);
PRINT USING "###"; DY;
PRINT USING " \ \"; MG$(MN);
PRINT USING "######"; YR;
GOSUB FLMN: DJ = NN
GOSUB CALDAY
PRINT USING "####"; INT(DY);
PRINT USING " \ \"; MG$(MN);
PRINT USING "######"; YR;
T1 = (DY - INT(DY)) * ZU
GOSUB HMS
PRINT USING "  \   \"; HMS$

RETURN


BG:

IF JJ% = 1 THEN PRINT MA$; "#  Month_name Days Beginning_on      UT_New_Moon (hr.:min.)"
DJ = DJ2
GOSUB CALDAY
PRINT MA$; USING "##"; JJ%;
PRINT USING " \         \"; CT$;

RETURN


ONSET:

TL1$ = " Onset of Hebrew calendar Months and related New Moon date"
GOSUB UBI
DJ2 = DJ0 + 163#
FOR JJ% = 1 TO 13
CT$ = MN$(JJ%)
GOSUB BG
DM = (JJ% + JJ% \ 7) MOD 2 + 29#
IF JJ% = 6 AND LN% = 1 THEN DM = 30#
IF JJ% = 7 AND LN% = 0 THEN AL$ = "  nonexistent in year" + STR$(CR): GOSUB ALRT: GOTO JMP
IF JJ% = 3 AND DA% = 1 THEN DM = 29#
IF JJ% = 2 AND DA% = 3 THEN DM = 30#
GOSUB FM
JMP:
NEXT

GOTO AGN9


MJ:

GOSUB CALDAY
PRINT MA$; USING "##"; CC%;
PRINT GG$;
PRINT USING "\          \"; CO$;
PRINT USING "D##"; DD%;
PRINT USING " \                        \"; CT$;
PRINT USING " \ \"; WK$(WK%);
PRINT USING "###"; DY;
PRINT USING " \ \"; MG$(MN);
PRINT USING "#####"; YR

RETURN


MJR:

TL1$ = " Date and Duration (D=number of days) of major Calendar events "
GOSUB UBI
RESTORE MJR
DATA 0,1,1,2,"Rosh Hashana=New Year",9,1,10,1,"Yom Kippur=Atonement Day"
DATA 14,1,15,8,Sucoth=Tabernacles,83,3,25,8,Hanukkah=Dedication
DATA 132,5,15,1,"Tu-Bishvat=Planting Day",161,6,14,1,"Purim=Feast of Lots"
DATA 191,8,15,7,Pesach=Passover,203,8,27,1,"Yom Hashoah=Holocaust Day"
DATA 210,9,4,1,"Yom Hazicaron=Memorial Day",211,9,5,1,"Yom Haazmaut=Independence"
DATA 224,9,18,1,"Lag Baomer=33 Harvest Days",234,9,28,1,"Yom Yerushalaim=Jerusalem"
DATA 241,10,6,1,Shavuoth=Pentecost,303,12,9,1,"Tisha B'av=Lamentation Day"

KK% = 0
FOR JJ% = 1 TO 14
READ AA%, BB%, CC%, DD%, CT$
DJ = DJ0 + 163# + AA%
IF JJ% > 4 AND DA% = 1 THEN DJ = DJ - 1
IF JJ% > 3 AND DA% = 3 THEN DJ = DJ + 1
IF JJ% > 5 AND LN% = 1 THEN DJ = DJ + 30
IF JJ% = 6 AND LN% = 1 THEN BB% = BB% + 1
GG$ = " "
GOSUB CALDAY
IF JJ% = 8 AND WK% = 5 THEN DJ = DJ - 1: CC% = CC% - 1: GG$ = "<": KK% = 1
IF JJ% = 9 AND WK% = 4 THEN DJ = DJ - 1: CC% = CC% - 1: GG$ = "<": KK% = 1
IF JJ% = 9 AND WK% = 5 THEN DJ = DJ - 2: CC% = CC% - 2: GG$ = "["
IF JJ% = 10 AND WK% = 5 THEN DJ = DJ - 1: CC% = CC% - 1: GG$ = "<"
IF JJ% = 10 AND WK% = 6 THEN DJ = DJ - 2: CC% = CC% - 2: GG$ = "["
IF JJ% = 12 AND WK% = 5 THEN DJ = DJ - 1: CC% = CC% - 1: GG$ = "<": KK% = 1
IF JJ% = 14 AND WK% = 6 THEN DJ = DJ + 1: CC% = CC% + 1: GG$ = ">"
CO$ = MN$(BB%)
GOSUB MJ
NEXT
IF KK% = 1 THEN LOCATE 23, 28: AL$ = "Antedated: 1day= < ;2days= [ ;Postponed: 1day= >": GOSUB ALRT: LOCATE 23, 1: GOSUB SND

GOTO AGN9


FFOR:

GOSUB CLP
QQ$ = "for Hebrew calendar Creation Year "
IF CR >= 1 THEN PRINT MA$; QQ$; CR
IF CR < 1 THEN PRINT MA$; : AL$ = "available only " + QQ$ + "1 or later": GOSUB ALRT: GOSUB SND: RETURN
RY = YR + 1: IF RY = 0 THEN RY = 1
PRINT MA$; "overlapping Common calendar Years "; YR; "and "; RY
PRINT MA$

RETURN


HSUN:

TL$ = " Time and Azimuth of Sunrise and Sunset, Twilight "
CLS : PRINT
TI$ = TL$: GOSUB TIT
RESTORE HSUN
DATA"1. Sunrise and Sunset"
DATA"2. Civil Twilight"
DATA"3. Nautical Twilight"
DATA"4. Astronomical Twilight"
KK% = 4: GOSUB SCR
PR$ = DG$: GOSUB BLINK

FX% = 2

QQ$ = "": GOSUB PUTI: IJ% = VAL(QQ$): IF QQ = 27 THEN GOTO AGN5
FX% = 2 + IJ%

IF IJ% < 1 OR IJ% > 4 THEN FX% = 3: GOTO AGN5
GOSUB DATE: IF BB% = 1 THEN GOTO AGN5
GOSUB GEOG
GOSUB NUT
GOSUB OBLIQ

DI(1) = .01454441#
DI(2) = FNM(6#)
DI(3) = FNM(12#)
DI(4) = FNM(18#)
MR$(1) = "Sunrise" + HM$ + ": "
EV$(1) = "Sunset" + HM$ + ": "
MR$(2) = "Morning Twilight begins" + HM$ + ": "
MR$(3) = MR$(2): MR$(4) = MR$(2)
EV$(2) = "Evening Twilight ends" + HM$ + ": "
EV$(3) = EV$(2): EV$(4) = EV$(3)
CLS : PRINT
TI$ = TL$: GOSUB TIT
TI$ = SN$(IJ%): GOSUB TIT
UT = 12# + TZ + DS
DI = DI(IJ%)
GOSUB RIS
LA = LU: LB = LD
IF ER3% <> 0 THEN GOTO RESL
SW2 = -1
TM = LA: GOSUB TIME: GU = UT
TM = LB: GOSUB TIME: GD = UT
UT = GU: GOSUB RISS: LA = LU: AZU = FNV(FND(AU))
IF ER3% <> 0 THEN GOTO RESL
UT = GD: GOSUB RISS: LB = LD: AZD = FNV(FND(AD))
IF ER3% <> 0 THEN GOTO RESL
TM = LA: GOSUB TIME: TU = TL
TM = LB: GOSUB TIME: TD = TL
GOTO RESL

RISS:
DN = DJ: ZZ = UT + TZ + DS
IF ZZ > 24# THEN DJ = DJ - 1#
IF ZZ < 0# THEN DJ = DJ + 1#
GOSUB RIS: DJ = DN: RETURN

RIS:
GOSUB SUN
XX = SR + FNM(DP - .00569#)
YY = 0#
SW3 = -1#: GOSUB EQECL
XX = PP: YY = QQ
GOSUB RISET
GOSUB WRK
RETURN

RESL:
CLS : PRINT
TI$ = TL$: GOSUB TIT
TI$ = SN$(IJ%): GOSUB TIT
GOSUB FORD
IF ER3% = -1 THEN PRINT MA$; : AL$ = "Sun" + CI$ + BL$(IJ%): GOSUB ALRT: GOSUB SND
IF ER3% = 1 THEN PRINT MA$; : AL$ = "Sun" + NE$ + BL$(IJ%): GOSUB ALRT: GOSUB SND
IF MD% = 1 THEN MD% = 0: PRINT MA$; : AL$ = MD$: GOSUB ALRT: GOSUB SND: PRINT MA$
IF ER3% <> 0 THEN GOTO AGN5
T1 = TU * 3600#: GOSUB HMS
PRINT MA$; MR$(IJ%); HMS$
PRINT USING AZ$; AZU
T1 = TD * 3600#: GOSUB HMS
PRINT MA$; EV$(IJ%); HMS$
PRINT USING AZ$; AZD
T1 = (24# + TD - TU) * 3600#: GOSUB HMS
PRINT MA$; "Length of Day"; HM$; ": "; HMS$

AGN5:
QQ$ = AG$: DX% = FX%: GOSUB IFEX
IF EE% = 1 THEN GOTO HSUN
GOTO MAIN


SUN:

TT = DJ / 36525# + UT / 876600#: T2 = TT * TT
AA = 100.0021359# * TT: BB = 360# * (AA - INT(AA))
LL = 279.69668# + .0003025# * T2 + BB
AA = 99.99736042000001# * TT: BB = 360# * (AA - INT(AA))
M1 = 358.47583# - (.00015# + .0000033# * TT) * T2 + BB
EC = .01675104# - .0000418# * TT - .000000126# * T2
AM = FNM(M1)
GOSUB ANOM
AA = 62.55209472# * TT: BB = 360# * (AA - INT(AA))
A1 = FNM(153.23# + BB)
AA = 125.1041894# * TT: BB = 360# * (AA - INT(AA))
B1 = FNM(216.57# + BB)
AA = 91.56766028# * TT: BB = 360# * (AA - INT(AA))
C1 = FNM(312.69# + BB)
AA = 1236.853095# * TT: BB = 360# * (AA - INT(AA))
D1 = FNM(350.74# - .00144# * T2 + BB)
E1 = FNM(231.19# + 20.2# * TT)
AA = 183.1353208# * TT: BB = 360# * (AA - INT(AA))
H1 = FNM(353.4# + BB)
D2 = .00134# * COS(A1) + .00154# * COS(B1) + .002# * COS(C1)
D2 = D2 + .00179# * SIN(D1) + .00178# * SIN(E1)
D3 = .00000543# * SIN(A1) + .00001575# * SIN(B1)
D3 = D3 + .00001627# * SIN(C1) + .00003076# * COS(D1)
D3 = D3 + 9.269999999999999D-06 * SIN(H1)
SR = at + FNM(LL - M1 + D2)
RR = 1.0000002# * (1# - EC * COS(AE)) + D3
WHILE SR < 0#: SR = SR + TP: WEND
WHILE SR > TP: SR = SR - TP: WEND

RETURN


FORD:

PRINT MA$; WK$(WK%); ","; DY; " "; MG$(MN); YR
PRINT MA$; LC$; USING "####.##"; GL; GQ;
PRINT USING "####.##hr."; TZ + DS
PRINT MA$

RETURN


TIME:

VV = 1.002737908#
DD = INT(DJ - .5#) + .5#: TT = DD / 36525# - 1#
R0 = TT * (.0513366# + TT * (.00002586222# - TT * .000000001722#))
R1 = 6.697374558# + 2400# * (TT - ((YR - 2000#) / 100#))
XX = R0 + R1: GOSUB ITR: T0 = XX
IF SW2 = -1 THEN GOTO TIM
XX = TM - DS - TZ: GOSUB ITR: UT = XX: TT = T0
UU = 6.570982440000001D-02
IF DD% = 1 THEN TT = TT + UU
IF DD% = -1 THEN TT = TT - UU
XX = UT * VV + TT: GOSUB ITR: SG = XX
XX = SG + GL / 15#: GOSUB ITR: TL = XX

RETURN

TIM:
XX = T0 - (DS + TZ) * VV: GOSUB ITR: TT = XX
XX = TM - (GL / 15#): GOSUB ITR: SG = XX
IF SG < TT THEN XX = XX + 24#
XX = (XX - TT) * .9972695677#: GOSUB ITR: TL = XX
XX = TL - DS - TZ: GOSUB ITR: UT = XX
IF MD% = 0 AND TL < .065529# THEN MD% = 1: MD$ = "Midnight 3.93 min. Ambiguous sidereal to civil time conversion"

RETURN

ITR:

DD% = 0
WHILE XX < 0#: XX = XX + 24#: DD% = -1: WEND
WHILE XX > 24#: XX = XX - 24#: DD% = 1: WEND

RETURN


HMOON:

TL$ = " Time and Azimuth of Moonrise and Moonset, Age and Phase "
GOSUB DATE: IF BB% = 1 THEN GOTO AGN8
GOSUB GEOG
PRINT
PRINT
GOSUB NUT
GOSUB OBLIQ
UT = 12# + TZ + DS
GOSUB SUN
GOSUB MRIS
AG = MM - SR: AG = AG - INT(AG / TP) * TP
PH = (1# - COS(AG)) * 50#
AG = AG / TP * 100#
LA = LU: LB = LD
IF ER3% <> 0 THEN GOTO MRESL
FOR JJ = 1 TO 3
SW2 = -1
H1 = HU: TM = LA: GOSUB TIME: GU = UT: HU = TL
H2 = HD: TM = LB: GOSUB TIME: GD = UT: HD = TL
UT = GU: GOSUB MRISS: LA = LU: AZU = FNV(FND(AU))
IF ER3% <> 0 THEN GOTO MRESL
UT = GD: GOSUB MRISS: LB = LD: AZD = FNV(FND(AD))
IF ER3% <> 0 THEN GOTO MRESL
NEXT
UX% = 0: IF ABS(HU - H1) > 6# THEN UX% = 1
TM = LA: GOSUB TIME: TU = TL
DX% = 0: IF ABS(HD - H2) > 6# THEN DX% = 1
TM = LB: GOSUB TIME: TD = TL
GOTO MRESL

MRISS:
DN = DJ: ZZ = UT + TZ + DS
IF ZZ > 24# THEN DJ = DJ - 1#
IF ZZ < 0# THEN DJ = DJ + 1#
GOSUB MRIS: DJ = DN: RETURN

MRIS:
GOSUB MOON
GOSUB NUT
TH = .27249# * SIN(PM): DI = TH + .0098902# - PM
XX = MM + FNM(DP): YY = BM
SW3 = -1#: GOSUB EQECL
XX = PP: YY = QQ
GOSUB RISET
GOSUB WRK
RETURN

MRESL:
CLS : PRINT
OC$ = "occurs Next day"
TI$ = TL$: GOSUB TIT
GOSUB FORD
IF ER3% = -1 THEN PRINT MA$; : AL$ = "Moon" + CI$ + BL$(1): GOSUB ALRT: GOSUB SND
IF ER3% = 1 THEN PRINT MA$; : AL$ = "Moon" + NE$ + BL$(1): GOSUB ALRT: GOSUB SND
IF MD% = 1 THEN MD% = 0: PRINT MA$; : AL$ = MD$: GOSUB ALRT: GOSUB SND: PRINT MA$
IF ER3% <> 0 THEN GOTO AGN8
T1 = TU * 3600#: GOSUB HMS
CT$ = STRING$(15, "") + ": "
PRINT MA$; "Moonrise"; HM$; ""; CT$;
IF UX% = 1 THEN AL$ = OC$: GOSUB ALRT: GOSUB SND: GOTO NXT
PRINT HMS$
PRINT USING AZ$; AZU
NXT:
T1 = TD * 3600#: GOSUB HMS
PRINT MA$; "Moonset"; HM$; ""; CT$;
IF DX% = 1 THEN AL$ = OC$: GOSUB ALRT: GOSUB SND: GOTO NXTT
PRINT HMS$
PRINT USING AZ$; AZD

NXTT:
PRINT MA$; "Moon's Age at local noon "; CT$; USING "###.##%"; AG
PRINT MA$; "Moon's Phase at local noon "; CT$; USING "###.##%"; PH

AGN8:
QQ$ = AG$: DX% = 7: GOSUB IFEX
IF EE% = 1 THEN GOTO HMOON
GOTO MAIN


MOON:

TT = DJ / 36525# + UT / 876600#: T2 = TT * TT
M1 = 27.32158213#: M2 = 365.2596407#
M3 = 27.55455094#: M4 = 29.53058868#
M5 = 27.21222039#: M6 = 6798.363307#
QQ = DJ + UT / 24#: M1 = QQ / M1: M2 = QQ / M2
M3 = QQ / M3: M4 = QQ / M4: M5 = QQ / M5: M6 = QQ / M6
M1 = 360# * (M1 - INT(M1)): M2 = 360# * (M2 - INT(M2))
M3 = 360# * (M3 - INT(M3)): M4 = 360# * (M4 - INT(M4))
M5 = 360# * (M5 - INT(M5)): M6 = 360# * (M6 - INT(M6))
ML = 270.434164# + M1 - (.001133# - .0000019# * TT) * T2
MS = 358.475833# + M2 - (.00015# + .0000033# * TT) * T2
MD = 296.104608# + M3 + (9.192000000000001D-03 + .0000144# * TT) * T2
ME = 350.737486# + M4 - (.001436# - .0000019# * TT) * T2
MF = 11.250889# + M5 - (.003211# + .0000003# * TT) * T2
NA = 259.183275# - M6 + (.002078# + .0000022# * TT) * T2
AA = FNM(51.2# + 20.2# * TT): S1 = SIN(AA): S2 = SIN(FNM(NA))
BB = 346.56# + (132.87# - .0091731# * TT) * TT
S3 = .003964# * SIN(FNM(BB))
CC = FNM(NA + 275.05# - 2.3# * TT): S4 = SIN(CC)
ML = ML + .000233# * S1 + S3 + .001964# * S2
MS = MS - .001778# * S1
MD = MD + .000817# * S1 + S3 + .002541# * S2
MF = MF + S3 - .024691# * S2 - .004328# * S4
ME = ME + .002011# * S1 + S3 + .001964# * S2
EE = 1# - (.002495# + .00000752# * TT) * TT: E2 = EE * EE
ML = FNM(ML): MS = FNM(MS): NA = FNM(NA)
ME = FNM(ME): MF = FNM(MF): MD = FNM(MD)
LL = 6.28875# * SIN(MD) + 1.274018# * SIN(2# * ME - MD)
LL = LL + .658309# * SIN(2# * ME) + .213616# * SIN(2# * MD)
LL = LL - EE * .185596# * SIN(MS) - .114336# * SIN(2# * MF)
LL = LL + .058793# * SIN(2# * (ME - MD))
LL = LL + .057212# * EE * SIN(2# * ME - MS - MD) + .05332# * SIN(2# * ME + MD)
LL = LL + .045874# * EE * SIN(2# * ME - MS) + .041024# * EE * SIN(MD - MS)
LL = LL - .034718# * SIN(ME) - EE * .030465# * SIN(MS + MD)
LL = LL + .015326# * SIN(2.000020980834961# * (ME - MF)) - .012528# * SIN(2# * MF + MD)
LL = LL - .01098# * SIN(2# * MF - MD) + .010674# * SIN(4# * ME - MD)
LL = LL + .010034# * SIN(3# * MD) + .008548# * SIN(4# * ME - 2# * MD)
LL = LL - EE * .00791# * SIN(MS - MD + 2# * ME) - EE * .006783# * SIN(2 * ME + MS)
LL = LL + .005162# * SIN(MD - ME) + EE * .005# * SIN(MS + ME)
LL = LL + .003862# * SIN(4# * ME) + EE * .004049# * SIN(MD - MS + 2# * ME)
LL = LL + .003996# * SIN(2# * (MD + ME)) + .003665# * SIN(2# * ME - 3# * MD)
LL = LL + EE * .002695# * SIN(2# * MD - MS) + .002602# * SIN(MD - 2# * (MF + ME))
LL = LL + EE * .002396# * SIN(2# * (ME - MD) - MS) - .002349# * SIN(MD + ME)
LL = LL + E2 * .002249# * SIN(2# * (ME - MS)) - EE * .002125# * SIN(2# * MD + MS)
LL = LL - E2 * .002079# * SIN(2# * MS) + E2 * .002059# * SIN(2# * (ME - MS) - MD)
LL = LL - .001773# * SIN(MD + 2# * (ME - MF)) - .001595# * SIN(2# * (MF + ME))
LL = LL + EE * .00122# * SIN(4# * ME - MS - MD) - .00111# * SIN(2# * (MD + MF))
LL = LL + .000892# * SIN(MD - 3# * ME) - EE * .000811# * SIN(MS + MD + 2# * ME)
LL = LL + EE * .000761# * SIN(4# * ME - MS - 2# * MD)
LL = LL + E2 * .000704# * SIN(MD - 2# * (MS + ME))
LL = LL + EE * .000693# * SIN(MS - 2# * (MD - ME))
LL = LL + EE * .000598# * SIN(2# * (ME - MF) - MS)
LL = LL + .00055# * SIN(MD + 4# * ME) + .000538# * SIN(4# * MD)
LL = LL + EE * .000521# * SIN(4# * ME - MS) + .000486# * SIN(2# * MD - ME)
LL = LL + E2 * .000717# * SIN(MD - 2# * MS)
MM = ML + FNM(LL)
WHILE MM < 0#: MM = MM + TP: WEND
WHILE MM > TP: MM = MM - TP: WEND
GG = 5.128189 * SIN(MF) + .280606# * SIN(MD + MF)
GG = GG + .277693# * SIN(MD - MF) + .173238# * SIN(2# * ME - MF)
GG = GG + .055413# * SIN(2# * ME + MF - MD) + .046272# * SIN(2# * ME - MF - MD)
GG = GG + .032573# * SIN(2# * ME + MF) + .017198# * SIN(2# * MD + MF)
GG = GG + 9.266999999999999D-03 * SIN(2# * ME + MD - MF) + 8.822999999999999D-03 * SIN(2# * MD - MF)
GG = GG + EE * 8.247000000000001D-03 * SIN(2# * ME - MS - MF) + .004323# * SIN(2# * (ME - MD) - MF)
GG = GG + .0042# * SIN(2# * ME + MF + MD) + EE * .003372# * SIN(MF - MS - 2# * ME)
GG = GG + EE * .002472# * SIN(2# * ME + MF - MS - MD)
GG = GG + EE * .002222# * SIN(2# * ME + MF - MS)
GG = GG + EE * .002072# * SIN(2# * ME - MF - MS - MD)
GG = GG + EE * .001877# * SIN(MF - MS + MD) + .001828# * SIN(4# * ME - MF - MD)
GG = GG - EE * .001803# * SIN(MF + MS) - .00175# * SIN(3# * MF)
GG = GG + EE * .00157# * SIN(MD - MS - MF) - .001487# * SIN(MF + ME)
GG = GG - EE * .001481# * SIN(MF + MS + MD) + EE * .001417# * SIN(MF - MS - MD)
GG = GG + EE * .00135# * SIN(MF - MS) + .00133# * SIN(MF - ME)
GG = GG + .001106# * SIN(MF + 3# * MD) + .00102# * SIN(4# * ME - MF)
GG = GG + .000833# * SIN(MF + 4# * ME - MD) + .000781# * SIN(MD - 3# * MF)
GG = GG + .00067# * SIN(MF + 4# * ME - 2# * MD) + .000606# * SIN(2# * ME - 3# * MF)
GG = GG + .000597# * SIN(2# * (ME + MD) - MF)
GG = GG + EE * .000492# * SIN(2# * ME + MD - MS - MF) + .00045# * SIN(2# * (MD - ME) - MF)
GG = GG + .000439# * SIN(3# * MD - MF) + .000423# * SIN(MF + 2# * (ME + MD))
GG = GG + .000422# * SIN(2# * ME - MF - 3# * MD) - EE * .000367# * SIN(MS + MF + 2# * ME - MD)
GG = GG - EE * .000353# * SIN(MS + MF + 2# * ME) + .000331# * SIN(MF + 4# * ME)
GG = GG + EE * .000317# * SIN(2# * ME + MF - MS + MD)
GG = GG + E2 * .000306# * SIN(2# * (ME - MS) - MF) - .000283# * SIN(MD + 3# * MF)
W1 = .0004664# * COS(NA): W2 = .0000754# * COS(CC)
BM = FNM(GG) * (1# - W1 - W2)
PM = .950724# + .051818# * COS(MD) + .009531# * COS(2# * ME - MD)
PM = PM + 7.842999999999999D-03 * COS(2# * ME) + .002824# * COS(2# * MD)
PM = PM + .000857# * COS(2# * ME + MD) + EE * 5.330000000000001D-04 * COS(2# * ME - MS)
PM = PM + EE * .000401# * COS(2.000020980834961# * ME - MD - MS)
PM = PM + EE * .00032# * COS(MD - MS) - .000271# * COS(ME)
PM = PM - EE * .000264# * COS(MS + MD) - .000198# * COS(2# * MF - MD)
PM = PM + .000173# * COS(3# * MD) + .000167# * COS(4# * ME - MD)
PM = PM - EE * .000111# * COS(MS) + .000103# * COS(4# * ME - 2# * MD)
PM = PM - .000084# * COS(2# * MD - 2# * ME) - EE * .000083# * COS(2# * ME + MS)
PM = PM + .000079# * COS(2# * ME + 2# * MD) + .000072# * COS(4# * ME)
PM = PM + EE * .000064# * COS(2# * ME - MS + MD) - EE * .000063# * COS(2# * ME + MS - MD)
PM = PM + EE * .000041# * COS(MS + ME) + EE * .000035# * COS(2# * MD - MS)
PM = PM - .000033# * COS(3# * MD - 2# * ME) - .00003# * COS(MD + ME)
PM = PM - .000029# * COS(2# * (MF - ME)) - EE * .000029# * COS(2# * MD + MS)
PM = PM + E2 * .000026# * COS(2# * (ME - MS)) - .000023# * COS(2# * (MF - ME) + MD)
PM = PM + EE * .000019# * COS(4# * ME - MS - MD)
PM = FNM(PM)

RETURN


GEOG:

CLS : PRINT
TI$ = TL$: GOSUB TIT
EX% = 56     
GOSUB DEFAULT: EX% = 0
GL = N1: GQ = N2: LT = N3
PRINT , "Default "; LC$
PRINT
PRINT , USING "####.##"; GL; GQ;
PRINT USING "####.##hr."; LT
QQ$ = " use Default Location?" + YN$
DX% = 49: GOSUB IFEX
IF EE% = 1 THEN GOTO RTRN1
PRINT
EX% = 57
GOSUB DEFAULT: EX% = 0
GL = N1: GQ = N2: LT = N3
PRINT
PRINT , "Previously chosen "; LC$
PRINT
PRINT , USING "####.##"; GL; GQ;
PRINT USING "####.##hr."; LT
QQ$ = " use Previous Location?" + YN$
DX% = 50: GOSUB IFEX
IF EE% = 1 THEN GOTO RTRN1
PRINT

EDT:

PR$ = " input Longitude: (East=+deg.,+min. West=-deg.,-min.) Enter ": GOSUB BLINK
PRINT : PRINT , : QQ$ = " ": GOSUB PUTI: INPUT XD, XM
GL = XD + XM / 60#
PR$ = " input Latitude: (North=+deg.,+min. South=-deg.,-min.) Enter ": GOSUB BLINK
PRINT : PRINT , : QQ$ = " ": GOSUB PUTI: INPUT XD, XM
GQ = XD + XM / 60#
CLS : PRINT
TI$ = TL$: GOSUB TIT
PR$ = " input Local to UT Offset (East=+hr.,+min. West=-hr.,-min.) Enter ": GOSUB BLINK
PRINT : PRINT , : QQ$ = " ": GOSUB PUTI: INPUT XD, XM
LT = XD + XM / 60#
TZ = INT((GL - 7.5#) / 15#) + 1#
IF TZ <> LT THEN
QQ$ = " Time Zone =" + STR$(TZ) + "hr.?" + YN$
DX% = 51: GOSUB IFEX
IF EE% = 1 THEN LT = TZ
PRINT
END IF
EX% = FL%
GG$ = STR$(GL) + "," + STR$(GQ) + "," + STR$(LT)
GOSUB COP: GOSUB COPY
PRINT
PRINT , : AL$ = "only if you need a new default!": GOSUB ALRT
QQ$ = " create new Default?" + YN$
DX% = 52: GOSUB IFEX
IF EE% = 1 THEN EE% = 0: GOSUB SND: QQ$ = " sure?" + PY$: PRINT : GOSUB YESNO
IF EE% = 0 THEN GOTO RTRN1

EX% = 56
GOSUB DEFAULT: EX% = 0
EX% = FL%
GOSUB COP: GOSUB COPY

RTRN1:

TZ = INT((GL - 7.5#) / 15#) + 1#
DS = LT - TZ
GP = FNM(GQ)

RETURN


DEFAULT:

FL% = EX%
GOSUB COP
OPEN "ZODIAC.000" FOR OUTPUT AS #3
PRINT #3, CO$: CLOSE #3
OPEN "ZODIAC.000" FOR INPUT AS #3
INPUT #3, N1, N2, N3
CLOSE #3
SHELL "DEL ZODIAC.000"

RETURN


ANOM:

MM = AM - TP * INT(AM / TP): AE = MM
DD = AE - EC * SIN(AE) - MM
WHILE ABS(DD) > .000001#
DD = DD / (1# - EC * COS(AE))
AE = AE - DD
DD = AE - EC * SIN(AE) - MM
WEND
AA = SQR((1# + EC) / (1# - EC)) * TAN(AE / 2#)
at = 2# * ATN(AA)

RETURN


NUT:

TT = DJ / 36525#: T2 = TT * TT
AA = 100.0021358# * TT: BB = 360# * (AA - INT(AA))
L1 = 279.6967# + .000303# * T2 + BB: L2 = 2# * FNM(L1)
AA = 1336.855231# * TT: BB = 360# * (AA - INT(AA))
D1 = 270.4342# - .001133# * T2 + BB: D2 = 2# * FNM(D1)
AA = 99.99736056# * TT: BB = 360# * (AA - INT(AA))
M1 = 358.4758# - .00015# * T2 + BB: M1 = FNM(M1)
AA = 1325.552359# * TT: BB = 360# * (AA - INT(AA))
M2 = 296.1046# + 9.192000000000001D-03 * T2 + BB: M2 = FNM(M2)
AA = 5.372616667# * TT: BB = 360# * (AA - INT(AA))
N1 = 259.1833# + .002078# * T2 - BB: N1 = FNM(N1)
N2 = 2# * N1
DP = (-17.2327# - .01737# * TT) * SIN(N1)
DP = DP + (-1.2729# - .00013# * TT) * SIN(L2) + .2088# * SIN(N2)
DP = DP - .2037# * SIN(D2) + (.1261# - .00031# * TT) * SIN(M1)
DP = DP + .0675# * SIN(M2) - (.0497# - .00012# * TT) * SIN(L2 + M1)
DP = DP - .0342# * SIN(D2 - N1) - .0261# * SIN(D2 + M2)
DP = DP + .0214# * SIN(L2 - M1) - .0149# * SIN(L2 - D2 + M2)
DP = DP + .0124# * SIN(L2 - N1) + .0114# * SIN(D2 - M2)
DOB = (9.210000000000001# + .00091# * TT) * COS(N1)
DOB = DOB + (.5522# - .00029# * TT) * COS(L2) - 9.039999999999999D-02 * COS(N2)
DOB = DOB + 8.840000000000001D-02 * COS(D2) + .0216# * COS(L2 + M1)
DOB = DOB + .0183# * COS(D2 - N1) + .0113# * COS(D2 + M2)
DOB = DOB - 9.299999999999999D-03 * COS(L2 - M1) - .0066# * COS(L2 - N1)
DP = DP / 3600#: DOB = DOB / 3600#

RETURN


EQECL:

EE = FNM(OB): SE = SIN(EE): CE = COS(EE)
CY = COS(YY): SY = SIN(YY)
IF ABS(CY) < 1E-20 THEN CY = 1E-20
TY = SY / CY: CX = COS(XX): SX = SIN(XX)
SS = SY * CE - CY * SE * SX * SW3
QQ = FNS(SS): AA = SX * CE + TY * SE * SW3
PP = ATN(AA / CX)
IF CX < 0# THEN PP = PP + PI
WHILE PP > TP: PP = PP - TP: WEND
WHILE PP < 0#: PP = PP + TP: WEND

RETURN


OBLIQ:

TT = DJ / 36525# - 1#
AA = (46.815# + (5.999999999999999D-04 - .00181# * TT) * TT) * TT
AA = AA / 3600#: OB = 23.43929167# - AA + DOB

RETURN


RISET:

ER3% = 0
CF = COS(GP): SF = SIN(GP)
SY = SIN(YY): CY = COS(YY): SD = SIN(DI)
CD = COS(DI): CH = -(SD + (SF * SY)) / (CF * CY)
IF CH < -1# THEN ER3% = -1: RETURN
IF CH > 1# THEN ER3% = 1: RETURN
CA = (SY + SD * SF) / (CD * CF)
HH = FNC(CH): AU = FNC(CA)
BB = FND(HH) / 15#: AA = FND(XX) / 15#
LU = 24# + AA - BB: LD = AA + BB: AD = TP - AU
CC = LU: DD = 24#: GOSUB REDUC: LU = CC
CC = LD: GOSUB REDUC: LD = CC
CC = AU: DD = TP: GOSUB REDUC: AU = CC
CC = AD: GOSUB REDUC: AD = CC

RETURN

REDUC:
WHILE CC < 0#: CC = CC + DD: WEND
WHILE CC > DD: CC = CC - DD: WEND
RETURN


FLMOON:

TL$ = " Nearest New Moon and the following Full Moon dates "
GOSUB DATE: IF BB% = 1 THEN GOTO AGN1
GOSUB FLMN
CLS : PRINT
TI$ = TL$: GOSUB TIT
DJ = NN
IN$ = "  Moon: Date and Universal Time"
PRINT MA$; " N e w"; IN$
GOSUB RES
QQ$ = " Continue?" + YN$
DX% = 8: GOSUB IFEX
IF EE% = 0 THEN GOTO MAIN

CLS : PRINT
TI$ = TL$: GOSUB TIT
DJ = FF: PRINT MA$; " F u l l"; IN$
GOSUB RES

AGN1:
QQ$ = AG$: DX% = 9: GOSUB IFEX
IF EE% = 1 THEN GOTO FLMOON
GOTO MAIN


RES:

GOSUB CALDAY
GOSUB OUTDAY
PRINT MA$; JD$; ":"; JD
PRINT MA$
PRINT WD$; WK$(WK%)
RETURN


FLMN:

GOSUB JULDAY: IF BB% = 1 THEN GOTO AGN1
EE = 29.5305891203#: CC = 365.242190972#: CC = CC / EE
KK = INT(DJ / EE + .5#)
TN = KK / CC / 100#: TF = (KK + .5#) / CC / 100#
TT = TN: GOSUB FLM: NN = BB + DD + EE: NB = F1
TT = TF: KK = KK + .5#: GOSUB FLM: FF = BB + DD + EE: FB = F1

RETURN


FLM:

T2 = TT * TT: EE = 29.53# * KK: CC = 166.56# + (132.87# - 9.173000000000001D-03 * TT) * TT
CC = FNM(CC): BB = .00058868# * KK + (.0001178# - .000000155# * TT) * T2
BB = BB + .00033# * SIN(CC) + .7593299999999999#
A1 = FNV(KK * 29#) + FNV(KK * .10535608#)
A1 = 359.2242# + A1 - (.0000333# + .00000347# * TT) * T2
A2 = FNV(KK * 385#) + FNV(KK * .81691806#)
A2 = 306.0253# + A2 + (.0107306# + .00001236# * TT) * T2
F1 = FNV(KK * 390#) + FNV(KK * .67050646#)
F1 = 21.2964# + F1 - (.0016528# + .00000239# * TT) * T2
A1 = FNV(A1): A2 = FNV(A2): F1 = FNV(F1)
A1 = FNM(A1): A2 = FNM(A2): F1 = FNM(F1)
DD = (.1734# - .000393# * TT) * SIN(A1) + .0021# * SIN(2# * A1)
DD = DD - .4068# * SIN(A2) + .0161# * SIN(2# * A2) - .0004# * SIN(3# * A2)
DD = DD + .0104# * SIN(2# * F1) - .0051# * SIN(A1 + A2)
DD = DD - .0074# * SIN(A1 - A2) + .0004# * SIN(2# * F1 + A1)
DD = DD - .0004# * SIN(2# * F1 - A1) - 5.999999999999999D-04 * SIN(2# * F1 + A2) + .001# * SIN(2# * F1 - A2)
DD = DD + .0005# * SIN(A1 + 2# * A2)

RETURN


YESNO:

EE% = 0
IF EX% = 0 THEN PRINT : LOCATE , 15 ELSE PRINT WN$
COLOR 16 - VU%, 15: PRINT QQ$; : COLOR 31 - VU%, 0
COLOR 15, 0
QQ$ = "": GOSUB PUTI: PRINT QQ$; : QQ$ = UCASE$(QQ$)
IF QQ = 27 THEN EX% = 0: RETURN MAIN
IF QQ$ = "C" THEN EE% = 2: RETURN
IF QQ$ = "Y" THEN EE% = 1: RETURN
IF QQ$ = "N" THEN EE% = 0: RETURN
SP% = 1: RETURN MAIN


DATE:

CLS : PRINT
PRINT , : COLOR 0, 15: PRINT TL$; : COLOR 15, 0
IF QX% = 1 THEN QX% = 0: COLOR 16 - VU%, 15: PRINT QQ$: COLOR 31 - VU%, 0: COLOR 15, 0 ELSE PRINT
PRINT

BB% = 0
GOSUB TOD
PRINT , "Today's date is: "; DY; MG$(MN); YR
QQ$ = " use Today's date?" + YN$
DX% = 53: GOSUB IFEX
IF EE% = 1 THEN GOSUB JULDAY: RETURN
PRINT

EX% = 55
GOSUB DEFAULT: EX% = 0
DY = N1: MN = N2: YR = N3
PRINT
PRINT , "Previously chosen date was: "; DY; MG$(MN); YR
QQ$ = " use Previous date?" + YN$
DX% = 54: GOSUB IFEX
IF EE% = 1 THEN GOSUB JULDAY: PRINT : GOTO RTRN
PRINT
PR$ = " input Calendar date: (day, month#, year [BCE= - ]) Enter ": GOSUB BLINK
PRINT
GOSUB TOD
PRINT , "Example (Today's date): "; DY; MG$(MN); YR; " = "; STR$(DY); ","; STR$(MN); ","; YR
PRINT
GOSUB DA
PRINT
GOSUB SPILL
PRINT , : QQ$ = " ": GOSUB PUTI: INPUT DY, MN, YR
GOSUB JULDAY: IF BB% = 1 THEN RETURN
IF YR = 0 OR FNW(YR) <> 0# OR FNW(MN) <> 0# OR DY < 0 OR MN <= 0 THEN
PRINT
PRINT , : AL$ = "month/year integer, month > 0, no year 0, no negative day": GOSUB ALRT
GOSUB SND
BB% = 1: RETURN
END IF

RTRN:

EX% = FL%
GG$ = STR$(DY) + "," + STR$(MN) + "," + STR$(YR)
GOSUB COP: GOSUB COPY

RETURN


DA:

RESTORE DA
DATA 31,28/29,31,30,31,30,31,31,30,31,30,31
FOR KK% = 0 TO 3
PRINT MA$;
FOR JJ% = 1 TO 3
II% = 3 * KK% + JJ%
READ QQ$: IF II% <> 2 THEN QQ$ = "   " + QQ$
PRINT USING "###"; II%;
PRINT USING " \         \"; MG$(3 * KK% + JJ%);
PRINT USING "\   \"; QQ$;
NEXT: NEXT
PRINT

RETURN


DAYS:

TL$ = " Day of the Week and Days in an interval "
QQ$ = "  F i r s t  d a t e  ": QX% = 1
PRINT
GOSUB DATE
IF BB% = 1 THEN
QQ$ = AG$: DX% = 10: GOSUB IFEX
IF EE% = 1 THEN GOTO DAYS
GOTO MAIN
END IF
JJD = JD: DZ = DY: MZ = MN: YZ = YR: WZ$ = WK$(WK%)
QX% = 1: GOSUB FIR
QQ$ = "  S e c o n d  d a t e  ": QX% = 1
GOSUB DATE: IF BB% = 1 THEN GOTO AGN3
PRINT
QX% = 2: GOSUB FIR
AA = ABS(JD - JJD): FR! = FNW(AA)
PRINT MA$
PRINT MA$; "Second"; CD$; USING "###"; DY;
PRINT " "; MG$(MN);
PRINT USING "#####"; YR
PRINT WD$; WK$(WK%)
PRINT MA$
PRINT MA$; "Number of days in closed interval :"; AA + FR! + 1
PRINT MA$
GOSUB DA

AGN3:
QQ$ = AG$: DX% = 11: GOSUB IFEX
IF EE% = 1 THEN GOTO DAYS
GOTO MAIN

FIR:

CLS : PRINT
TI$ = TL$: GOSUB TIT
PRINT MA$; "First "; CD$; USING "###"; DZ;
PRINT " "; MG$(MZ);
PRINT USING "#####"; YZ
IF QX% = 1 THEN PRINT MA$
PRINT WD$; WZ$
PRINT MA$
IF QX% = 1 THEN GOSUB DA
IF QX% = 2 THEN RETURN

AGN2:
QQ$ = " Continue?" + YN$: DX% = 10: GOSUB IFEX
IF EE% = 1 THEN RETURN
GOTO MAIN


STOPW:

CLS : PRINT
TI$ = " One hour Stop-Watch ": GOSUB TIT
QQ$ = " ": GOSUB PUTI
PR$ = " press Spacebar to Start, afterwards" + ES$: GOSUB BLINK
AA! = 0!
PRINT
WHILE INKEY$ <> " ": WEND
PRINT MA$; "Start time"; HM$; ": "; TIME$
PRINT MA$
AA! = TIMER: BB! = AA!
WHILE QQ <> 27 AND KK! - AA! < 3600
QQ = ASC(INKEY$ + " ")
LOCATE 9, 1
EE! = 0!: KK! = TIMER: IF KK! < BB! THEN EE! = 1!
IF KK! - BB! > 1! THEN EE! = -1!
PRINT MA$; "Time elapsed (sec.) :  "; USING "####.##"; KK! + EE! - AA!
BB! = KK! + EE!
WEND
PRINT MA$
PRINT MA$; "Stop time"; HM$; ": "; TIME$

AGN4:
QQ$ = AG$: DX% = 31: GOSUB IFEX
IF EE% = 1 THEN GOTO STOPW
GOTO MAIN


TTIMER:

TL$ = " Twenty four hours Countdown Timer and preset time Alarm "
CLS : PRINT   
TI$ = TL$: GOSUB TIT
RESTORE TTIMER
DATA"1. Preset time Alarm"
DATA"2. Countdown Timer"
KK% = 2: GOSUB SCR
PR$ = DG$: GOSUB BLINK
QQ$ = "": GOSUB PUTI: II% = VAL(QQ$): IF QQ = 27 THEN GOTO AGN16

CZ% = 0
QQ$ = " Return to system after event?" + YY$: GOSUB YESNO
PRINT
IF EE% > 0 THEN CZ% = 1

ON II% GOTO ALA, DUR

AGN16:
QQ$ = AG$: DX% = 32: GOSUB IFEX
IF EE% = 1 THEN GOTO TTIMER
GOTO MAIN


ALA:

CLS : PRINT
TI$ = TL$: GOSUB TIT
PR$ = " input Alarm time" + HM$ + "Enter ": GOSUB BLINK
GOSUB INPU
GOSUB HMS
QQ$ = " Continue?" + PY$: GOSUB YESNO
PRINT
IF EE% = 0 THEN GOTO AGN16
AZ% = 1: SMH$ = HMS$: GOTO ONC


DUR:

CLS : PRINT
TI$ = TL$: GOSUB TIT
PR$ = " input Timer Duration" + HM$ + "Enter ": GOSUB BLINK
GOSUB INPU
PR$ = " press Spacebar to Start, afterwards" + ES$: GOSUB BLINK
PRINT
WHILE INKEY$ <> " ": WEND
PRINT MA$; "Start time"; HM$; ": "; TIME$
PRINT MA$
BB = INT(TIMER)
AL$ = TIME$
WHILE T1 > 0 AND QQ <> 27
QQ = ASC(INKEY$ + " ")
LOCATE 13, 1
PRINT MA$; "Current time"; HM$; ": "; AL$
IF INT(TIMER) = 0 THEN BB = 0
IF INT(TIMER) > BB THEN AL$ = TIME$: BB = INT(TIMER): T1 = T1 - 1
IN$ = MA$ + "total "
PRINT MA$
PRINT IN$; "Hours to go :"; T1 \ 3600
PRINT IN$; "Minutes to go :"; T1 \ 60
PRINT IN$; "Seconds to go :"; T1
WEND
PRINT MA$
PRINT MA$; "Stop time"; HM$; ": "; TIME$
GOSUB ALMS

QQ$ = AG$: DX% = 33: GOSUB IFEX
IF EE% = 1 THEN GOTO TTIMER
GOTO MAIN


INPU:

PRINT : PRINT , : QQ$ = " ": GOSUB PUTI: INPUT HH, MM, SS
T1 = HH * 3600# + MM * 60# + SS: IF T1 > ZU - 1# THEN GOSUB SND: GOTO TTIMER
T3 = T1

RETURN


ADJUST:

TL$ = " Automatic and Manual Computer clock Adjustment "
CLS : PRINT
TI$ = TL$: GOSUB TIT
RESTORE ADJUST
DATA"1. Manual adjustment"
DATA"2. Automatic adjustment"
DATA"3. Nudge Computer Clock"
DATA"4. How to time..."
KK% = 4: GOSUB SCR
PRINT
PRINT , : AL$ = "Caution! Spillover possible. Date adjustment may be required."
GOSUB ALRT

DX% = 34

PR$ = DG$: GOSUB BLINK
QQ$ = "": GOSUB PUTI: II% = VAL(QQ$): IF QQ = 27 THEN GOTO AGN14

ON II% GOTO MANU, AUTO, NUDG, HOW

AGN14:
QQ$ = AG$: GOSUB IFEX
IF EE% = 1 THEN GOTO ADJUST
GOTO MAIN

NUDG:

CLS : PRINT
TI$ = TL$: GOSUB TIT
TI$ = " Nudge (delay < 1sec.) Computer clock ": GOSUB TIT
PR$ = " Input 0 to exit, 1 to 10 to nudge, Enter ": GOSUB BLINK
COLOR 15, 0: PRINT
IJ% = 0
PRINT , : QQ$ = " ": GOSUB PUTI: INPUT IJ%
IF IJ% > 10 GOTO NUDG
IF IJ% = 0 THEN GOTO AGN14
QQ$ = TIME$
FOR II% = 0 TO 2000 * IJ%: NEXT
TIME$ = QQ$

MANU:

CLS : PRINT
TI$ = TL$: GOSUB TIT
TI$ = " Manual Computer clock Adjustment ": GOSUB TIT
PR$ = " input Correction " + HM$ + "Enter ": GOSUB BLINK
LOCATE 11, 1: PRINT MA$; "Correction: _"
LOCATE 12, 1
PR$ = ES$: GOSUB BLINK

WHIL:
GOSUB SCN
LOCATE 9, 1
PRINT MA$; "Current time"; HM$; ": "; TIME$
QQ$ = " ": GOSUB PUTI
BEEP: IF RIGHT$(TIME$, 2) = "00" THEN BEEP: BEEP
PRINT MA$
QQ$ = INKEY$: QQ = ASC(QQ$ + " ")
IF QQ = 27 THEN PRINT : DX% = 35: GOTO AGN14
IF QQ$ <> "" THEN GOTO JMP8
GOTO WHIL
JMP8:
HH = 0: MM = 0: SS = 0
LOCATE 11, 15: INPUT " Correction: ", HH, MM, SS
DF = HH * 3600# + MM * 60# + SS
PRINT MA$
GOSUB COR
DX% = 36: GOTO AGN14


SCN:

T1 = INT(TIMER)
WIL:
IF INT(TIMER) > T1 THEN RETURN
GOTO WIL


COR:

GOSUB SCN
PRINT MA$; "Old Time"; HM$; ": "; TIME$
T1 = (INT(TIMER) + INT(DF) + ZU) MOD ZU
GOSUB HMS
TIME$ = HMS$
PRINT MA$; "New Time"; HM$; ": "; HMS$
RETURN


AUTO:

GOSUB TOD
QD = DY: QM = MN: QY = YR
DY = DY + TIMER / ZU
GOSUB JULDAY
DJQ = DJ
TL1$ = " Automatic Computer clock Adjustment "
EX% = 58
GOSUB DEFAULT: EX% = 0
DJ = N1
GOSUB CALDAY
T1 = FNW(DY): DY = INT(DY)
ER = N2
T1 = T1 * ZU: GOSUB HMS
GOSUB PRN

QQ$ = " new Systematic error?" + YN$
DX% = 37: GOSUB IFEX
PRINT
IF EE% = 1 THEN
PR$ = " input new Systematic error (Sec./day) Enter ": GOSUB BLINK
PRINT : PRINT , : QQ$ = " ": GOSUB PUTI: INPUT ER
END IF
QQ$ = " make Adjustment?" + YN$
DX% = 38: GOSUB IFEX
PRINT
IF EE% = 0 THEN GOTO AGN14
PRINT
DF = (DJQ - N1) * ER + N3
GOSUB COR
DY = QD + T1 / ZU: MN = QM: YR = QY
GOSUB JULDAY
EX% = FL%
GG$ = STR$(DJ) + "," + STR$(ER) + "," + STR$(DF - INT(DF))
GOSUB COP: GOSUB COPY

DX% = 39
GOTO AGN14

PRN:

GOSUB CLP
PRINT MA$; USING "Today's Date is : ##"; QD;
PRINT USING " \        \"; MG$(QM);
PRINT QY
PRINT MA$; USING "Previous Correction date : ##"; DY;
PRINT USING " \        \"; MG$(MN);
PRINT YR
PRINT MA$; "...and Time"; HM$; ": "; HMS$
PRINT MA$
PRINT MA$; "Systematic error (sec./day) :"; ER
DF! = (DJQ - N1) * ER + N3
PRINT MA$; "required Adjustment (integer, sec.) :"; INT(DF!)
PRINT MA$; "deferred Excess (fraction, sec.) :"; DF! - INT(DF!)
      
RETURN


HOW:

CLS : PRINT
TI$ = TL$: GOSUB TIT
TI$ = " Getting the Time and assessing Computer clock Error ": GOSUB TIT
RESTORE HOW
DATA"   Most PC time-pieces are not better than cheap quartz wrist-"
DATA"watches (without the advantage of being kept at constant body"
DATA"temperature) and need readjustment. Most TV stations displays"
DATA"or phone-company tape answerers provide similar poor accuracy."
DATA"   To obtain more accurate time, tune in a SW radio to 5, 10,"
DATA"15, or 20 MHz to beeping atomic-clock regulated transmitters."
DATA"Of course, propagation-delay and human response-time limit the"
DATA"accuracy. To assess the systematic error of your computer,"
DATA"adjust the computer clock to a SW time beeper, repeat after"
DATA"a week or two, and figure out your daily average systematic"
DATA"error in seconds. Input this parameter to ZODIAC."
DATA"   The program keeps the last adjustment Julian day date, the"
DATA"excess fraction of a second deferred adjustment, and the"
DATA"assigned systematic error. When later accessed, the adjustment"
DATA"is recomputed and the computer clock readjusted."
DATA"   Caution! A large correction near midnight might spill over"
DATA"into the next day and thus require a change of date as well."
KK% = 17: GOSUB SCR
DX% = 40: GOTO AGN14
                                                                          

EASTER:

TL$ = " Date of Easter Sunday, Passover, and related Full Moon "
GOSUB DATE
IF YR < 1583 THEN PRINT : PRINT , : AL$ = "only for Gregorian years 1583 CE and onward": GOSUB ALRT: GOSUB SND: GOTO AGN10
CLS : PRINT
TI$ = TL$: GOSUB TIT

R19 = YR MOD 19
I100 = YR \ 100: R100 = YR MOD 100
I4 = I100 \ 4: R4 = I100 MOD 4
I25 = (I100 + 8) \ 25
I3 = (I100 - I25 + 1) \ 3
R30 = (19 * R19 + I100 - I4 - I3 + 15) MOD 30
II4 = R100 \ 4: RR4 = R100 MOD 4
R7 = (32 + 2 * R4 + 2 * II4 - R30 - RR4) MOD 7
I451 = (R19 + 11 * R30 + 22 * R7) \ 451
AA = R30 + R7 - 7 * I451 + 114: I31 = AA \ 31: R31 = AA MOD 31
DY = 21: MN = 3: GOSUB JULDAY
HJ = DJ
DY = 7

MOR:
GOSUB WRK
GOSUB FLMN
IF FF < HJ THEN DY = DY + 7: GOTO MOR
DJ = FF: GOSUB CALDAY
D1 = INT(DY): MN1 = MN
DJ = DJ + (7 - WK%) MOD 7: GOSUB CALDAY
D2 = INT(DY): MN2 = MN
GOSUB INI: DJ = DJ1
GOSUB CALDAY
D3 = DY: MN3 = MN
DJ = DJ1 - 14:
GOSUB CALDAY
GOSUB FLMN
DJ = FF: GOSUB CALDAY
CLS: PRINT
TI$ = TL$: GOSUB TIT
PRINT MA$; USING "Easter Sunday date : ##"; R31 + 1;
PRINT USING " \    \"; MG$(I31);
PRINT YR
PRINT MA$; USING "First Full Moon on/after 21 March : ##"; D1;
PRINT USING " \    \"; MG$(MN1);
PRINT YR
PRINT MA$; USING "First Sunday on/after Full Moon : ##"; D2;
PRINT USING " \    \"; MG$(MN2);
PRINT YR
PRINT MA$; USING "Passover (15 Nisan) date : ##"; D3;
PRINT USING " \    \"; MG$(MN3);
PRINT YR
PRINT MA$; USING "Date of Full Moon near Passover date : ##"; INT(DY);
PRINT USING " \    \"; MG$(MN);
PRINT YR
RESTORE MOR
DATA,"              COINCIDENT PASSOVER AND EASTER"
DATA"    Fraenkel (see credits) discusses the historical"
DATA"significance. The original rules (Council of Nicea, 325 CE)"
DATA"for setting the Easter Sunday date attempted to absolutely"
DATA"exclude the concurrence with Passover, but obviously failed."
DATA"Could this have motivated Gauss to derive his formula?"
DATA"    Check the years: 1609, 1805, 1825, 1903, 1923, 1927,"
DATA"1954, 1981, 2123, 2143, 2150, 2170, 2201. These are the only"
DATA"years into the 23rd. century that show coincidence."
KK% = 10: GOSUB SCR


AGN10:
QQ$ = AG$: DX% = 41: GOSUB IFEX
IF EE% = 1 THEN GOTO EASTER
GOTO MAIN

OUTDAY:

PRINT MA$
PRINT MA$; "Common"; CD$; ID; MG$(MN); YR
T1 = FD * ZU: GOSUB HMS
PRINT MA$; "Day fraction :"; CSNG(FD)
PRINT MA$; "...equals Time"; HM$; ": "; HMS$

RETURN


HMS:

HMS$ = MID$(STR$(INT(T1 / 3600#) MOD 24), 2, 2) + ":"
IF VAL(HMS$) < 10 THEN HMS$ = "0" + HMS$
HM1$ = MID$(STR$(INT(T1 / 60#) MOD 60), 2, 2) + ":"
IF VAL(HM1$) < 10 THEN HM1$ = "0" + HM1$
HM2$ = MID$(STR$(INT(T1) MOD 60), 2, 2)
IF VAL(HM2$) < 10 THEN HM2$ = "0" + HM2$
HMS$ = HMS$ + HM1$ + HM2$

RETURN


HJULDAY:

TL$ = " Julian day number from Calendar date "
GOSUB DATE: IF BB% = 1 THEN GOTO AGN
CLS : PRINT
TI$ = TL$: GOSUB TIT
PRINT MA$; "Date "; STRING$(33, ""); ":"; DY; MG$(MN); YR
PRINT WD$; WK$(WK%)
PRINT MA$
PRINT MA$; JD$; ":"; JD
PRINT MA$; JU$; ":"; DJ
PRINT MA$
GOSUB DA
AGN:
QQ$ = AG$: DX% = 42: GOSUB IFEX
IF EE% = 1 THEN GOTO HJULDAY
GOTO MAIN

JULDAY:

BB% = 0
M1 = MN: Y1 = YR: BB = 0#
IF Y1 < 1# THEN Y1 = Y1 + 1#
IF MN < 3# THEN M1 = MN + 12#: Y1 = Y1 - 1#
IF Y1 > 1582# THEN GOTO GREG
IF Y1 < 1582# THEN GOTO JUL
IF MN < 10# THEN GOTO JUL
IF MN = 10# AND DY < 5# THEN GOTO JUL
IF MN > 10# OR DY >= 15# THEN GOTO GREG
PRINT
PRINT , : AL$ = "Gregorian Calendar abolished dates 5 to 14/10/1582 (inclusive)": GOSUB ALRT

GOSUB SND
WK% = 7: BB% = 1: RETURN

GREG:
AA = FIX(Y1 / 100#): BB = 2# - AA + FIX(AA / 4#)

JUL:
CC = FIX(365.25# * Y1) - 694025#
IF Y1 < 0# THEN CC = FIX((365.25# * Y1) - .75#) - 694025#
DD = FIX(30.6001# * (M1 + 1#))
DJ = BB + CC + DD + DY - .5#
JD = DJ + DJJ
WK% = (INT(JD - .5# - INT((JD - .5#) / 7#) * 7#) + 2#) MOD 7

RETURN


HCALDAY:

CLS : PRINT
TL$ = " Calendar date from Julian day number "
PRINT , : COLOR 0, 15: PRINT TL$: COLOR 15, 0
QQ$ = " full Julian date?" + PY$: GOSUB YESNO
PRINT
IF EE% = 0 THEN
PR$ = " input " + JU$ + "Enter ": GOSUB BLINK
PRINT : PRINT , : QQ$ = " ": GOSUB PUTI: INPUT DJ: JD = DJ + DJJ
GOTO CALD
END IF
PR$ = " input " + JD$ + "Enter ": GOSUB BLINK
PRINT : PRINT , : QQ$ = " ": GOSUB PUTI: INPUT JD: DJ = JD - DJJ

CALD:
PRINT
GOSUB CALDAY
PRINT WD$; WK$(WK%)
GOSUB OUTDAY
PRINT MA$
GOSUB DA

QQ$ = AG$: DX% = 43: GOSUB IFEX
IF EE% = 1 THEN GOTO HCALDAY
GOTO MAIN

CALDAY:

JD = DJ + DJJ
WK% = (INT(JD - .5# - INT((JD - .5#) / 7#) * 7#) + 2#) MOD 7
DD = DJ + .5#: II = INT(DD): FD = DD - II
IF FD = 1# THEN FD = 0#: II = II + 1#
IF II <= -115860# THEN GOTO JULI
AA = INT((II / 36524.25#) + .99835726#) + 14#
II = II + 1# + AA - INT(AA / 4#)

JULI:
BB = INT((II / 365.25#) + .802601#)
CC = II - INT((365.25# * BB) + .750001#) + 416#
GG = INT(CC / 30.6001#): MN = GG - 1#
DY = CC - INT(30.6001# * GG) + FD: YR = BB + 1899#
IF GG > 13.5# THEN MN = GG - 13#
IF MN < 2.5# THEN YR = BB + 1900#
IF YR < 1# THEN YR = YR - 1#
ID = INT(DY)

RETURN


WRK:

QQ$ = " ": GOSUB PUTI
PRINT , : COLOR 31 - VU%, 0: PRINT "Working..."; : COLOR 15, 0: PRINT TIME$

RETURN


SND:

IF QQ% = 1 THEN BEEP: RETURN
FOR i = 1 TO 20
N9 = ABS((ZU + TIMER) * RND) MOD 2000 + 150
D9 = RND + 1
SOUND N9, D9
NEXT

RETURN

 
INFO:

CLS : PRINT
TI$ = QL$: GOSUB TIT
PRINT MA$; "    "; : COLOR 31 - VU%, 0: PRINT "ZODIAC"; : COLOR 15, 0
PRINT " was programmed in QBASIC, then PKLITE compressed,"
RESTORE INFO
DATA"Please refer comments to Dan Censor, Dept. of Electrical and"
DATA"Computer Engineering, Ben-Gurion University of the Negev,"
DATA"Beer-Sheva, Israel. E-mail: CENSOR@EESRV.EE.BGU.AC.IL"
DATA"    Programs are based on P. Duffett-Smith: Practical Astronomy"
DATA"With Your Calculator (3rd. ed., 1988), and Astronomy With Your"
DATA"Personal Computer (2nd. ed.,1990), Cambridge Univ. Press."
DATA"    The Hebrew Calendar is based on (available on request):"
DATA"A Simple Algorithm for A Perpetual Hebrew Calendar Based On"
DATA"A Formula by Gauss, and A. Fraenkel: Calendar, in Vol. 21, the"
DATA"Hebrew Encyclopaedia, and Z. Keren: Calendars (unpublished), all"
DATA"describing the Gauss formula for the first day of the Passover."
DATA"    The Hijra Calendar is based on L.E. Doggett: Calendars,"
DATA"in the Explanatory Supplement to the Astronomical Almanac"
DATA"(revised, 1992, P.K. Seidelmann, editor), Univ. Science Books."
KK% = 14: GOSUB SCR
PRINT
TI$ = " Version 6.7 compiled October 13, 1998": GOSUB TIT
PRINT , : AL$ = "COMMERCIAL OR ORGANIZATIONAL USAGE BY PRIOR ARRANGEMENT ONLY": GOSUB ALRT
                                            
QQ$ = " Comments? (press C=Comments) " + ES$
DX% = 48: GOSUB IFEX
GOTO MAIN
