summaryrefslogtreecommitdiff
path: root/ipl/progs/hcal4unx.icn
diff options
context:
space:
mode:
Diffstat (limited to 'ipl/progs/hcal4unx.icn')
-rw-r--r--ipl/progs/hcal4unx.icn950
1 files changed, 950 insertions, 0 deletions
diff --git a/ipl/progs/hcal4unx.icn b/ipl/progs/hcal4unx.icn
new file mode 100644
index 0000000..80382aa
--- /dev/null
+++ b/ipl/progs/hcal4unx.icn
@@ -0,0 +1,950 @@
+############################################################################
+#
+# File: hcal4unx.icn
+#
+# Subject: Program for Jewish/Civil calendar in UNIX
+#
+# Author: Alan D. Corre (ported to UNIX by Richard L. Goerwitz)
+#
+# Date: January 3, 1994
+#
+############################################################################
+#
+# This file is in the public domain.
+#
+############################################################################
+#
+# Version: 1.16
+#
+############################################################################
+#
+# This work is respectfully devoted to the authors of two books
+# consulted with much profit: "A Guide to the Solar-Lunar Calendar"
+# by B. Elihu Rothblatt published by our sister Hebrew Dept. in
+# Madison, Wis., and "Kiddush HaHodesh" by Rabbenu Moses ben Maimon,
+# on whom be peace.
+#
+# The Jewish year harmonizes the solar and lunar cycle, using the
+# 19-year cycle of Meton (c. 432 BCE). It corrects so that certain
+# dates shall not fall on certain days for religious convenience. The
+# Jewish year has six possible lengths, 353, 354, 355, 383, 384, and
+# 385 days, according to day and time of new year lunation and
+# position in Metonic cycle. Time figures from 6pm previous night.
+# The lunation of year 1 is calculated to be on a Monday (our Sunday
+# night) at ll:11:20pm. Our data table begins with a hypothetical
+# year 0, corresponding to 3762 B.C.E. Calculations in this program
+# are figured in the ancient Babylonian unit of halaqim "parts" of
+# the hour = 1/1080 hour.
+#
+# Startup syntax is simply hebcalen [date], where date is a year
+# specification of the form 5750 for a Jewish year, +1990 or 1990AD
+# or 1990CE or -1990 or 1990BC or 1990BCE for a civil year.
+#
+############################################################################
+#
+# Revised October 25, 1993 by Ralph E. Griswold to use dopen().
+#
+############################################################################
+#
+# Links: io, iolib
+#
+############################################################################
+#
+# Requires: UNIX, hebcalen.dat, hebcalen.hlp
+#
+############################################################################
+#
+# See also: hebcalen.icn
+#
+############################################################################
+
+link io
+link iolib
+
+record date(yr,mth,day)
+record molad(day,halaqim)
+
+global cyr,jyr,days_in_jyr,current_molad,current_day,infolist
+
+
+#------- the following sections of code have been modified - RLG -------#
+
+procedure main(a)
+ local n, p
+
+ iputs(getval("ti"))
+ display_startup_screen()
+
+ if *a = 0 then {
+ #put()'ing an asterisk means that user might need help
+ n := 1; put(a,"*")
+ }
+ else n := *a
+ every p := 1 to n do {
+ initialize(a[p]) | break
+ process() | break
+ }
+ iputs(getval("te"))
+
+end
+
+
+
+procedure display_startup_screen()
+
+ local T
+
+ clear()
+ banner("PERPETUAL JEWISH/CIVIL CALENDAR","by","ALAN D. CORRE")
+ # Use a combination of tricks to be sure it will be up there a sec.
+ every 1 to 10000
+ T := &time; until &time > (T+450)
+
+ return
+
+end
+
+
+
+procedure banner(l[])
+
+ # Creates a banner to begin hebcalen. Leaves it on the screen for
+ # about a second.
+
+ local m, n, CM, COLS, LINES
+
+ CM := getval("cm")
+ COLS := getval("co")
+ LINES := getval("li")
+ (COLS > 55, LINES > 9) |
+ stop("\nSorry, your terminal just isn't big enough.")
+
+ if LINES > 20 then {
+ # Terminal is big enough for banner.
+ iputs(igoto(CM,1,3))
+ writes("+",repl("-",COLS-3),"+")
+ iputs(igoto(CM,1,4))
+ writes("|")
+ iputs(igoto(CM,COLS-1,4))
+ writes("|")
+
+ m := 0
+ every n := 5 to (*l * 3) + 4 by 3 do {
+ iputs(igoto(CM,1,n))
+ writes("|",center(l[m+:=1],COLS-3),"|")
+ every iputs(igoto(CM,1,n+(1|2))) & writes("|")
+ every iputs(igoto(CM,COLS-1,n+(1|2))) & writes("|")
+ }
+
+ iputs(igoto(CM,1,n+3))
+ writes("+",repl("-",COLS-3),"+")
+ iputs(igoto(CM,1,n+4))
+ write(" Copyright (c) Alan D. Corre, 1990")
+ }
+ else {
+ # Terminal is extremely short
+ iputs(igoto(CM,1,(LINES/2)-1))
+ write(center(l[1],COLS))
+ write(center("Copyright (c) Alan D. Corre, 1990",COLS))
+ }
+
+ return
+
+end
+
+
+
+procedure get_paths()
+
+ local paths, p
+
+ suspend "./" | "/usr/local/lib/hebcalen/"
+ paths := getenv("PATH")
+ \paths ? {
+ tab(match(":"))
+ while p := 1(tab(find(":")), move(1))
+ do suspend "" ~== trim(p,'/ ') || "/"
+ return "" ~== trim(tab(0) \ 1,'/ ') || "/"
+ }
+
+end
+
+
+
+procedure instructions(filename)
+
+ # Gives user access to a help file which is printed out in chunks
+ # by "more."
+
+ local helpfile, pager, ans, more_file
+
+ iputs(igoto(getval("cm"),1,2))
+ writes("Do you need instructions? [ny] ")
+ ans := map(read())
+ "q" == ans & fail
+
+ if "y" == ans then {
+ clear()
+ write()
+ dopen(helpfile := filename) |
+ stop("Can't find your hebcalen.hlp file!")
+ iputs(igoto(getval("cm"),1,getval("li")))
+ boldface()
+ writes("Press return to continue.")
+ normal()
+ "q" == map(read()) & fail
+ }
+
+ return \helpfile | "no help"
+
+end
+
+
+
+procedure clear()
+ local i
+
+ # Clears the screen. Tries several methods.
+
+ if not iputs(getval("cl"))
+ then iputs(igoto(getval("cm"),1,1))
+ if not iputs(getval("cd"))
+ then {
+ every i := 1 to getval("li") do {
+ iputs(igoto(getval("cm"),1,i))
+ iputs(getval("ce"))
+ }
+ iputs(igoto(getval("cm"),1,1))
+ }
+
+end
+
+
+
+procedure initialize_list()
+
+ # Put info of hebcalen.dat into a global list
+
+ local infile,n
+
+ infolist := list(301)
+ if not (infile := dopen("hebcalen.dat")) then
+ stop("\nError: cannot open hebcalen.dat")
+
+ # The table is arranged at twenty year intervals with 301 entries.
+ every n := 1 to 301 do
+ infolist[n] := read(infile)
+ close(infile)
+
+end
+
+
+
+procedure initialize_variables()
+
+ # Get the closest previous year in the table.
+
+ local line, quotient
+
+ quotient := jyr.yr / 20 + 1
+ # Only 301 entries. Figure from last if necessary.
+ if quotient > 301 then quotient := 301
+ # Pull the appropriate info, put into global variables.
+ line := infolist[quotient]
+
+ line ? {
+ current_molad.day := tab(upto('%'))
+ move(1)
+ current_molad.halaqim := tab(upto('%'))
+ move(1)
+ cyr.mth := tab(upto('%'))
+ move(1)
+ cyr.day := tab(upto('%'))
+ move(1)
+ cyr.yr := tab(upto('%'))
+ days_in_jyr := line[-3:0]
+ }
+
+ # Begin at rosh hashana.
+ jyr.day := 1
+ jyr.mth := 7
+ return
+
+end
+
+
+
+procedure initialize(yr)
+
+ local year
+ static current_year
+
+ # initialize global variables
+ initial {
+ cyr := date(0,0,0)
+ jyr := date(0,0,0)
+ current_molad := molad(0,0)
+ initialize_list()
+ current_year := get_current_year()
+ }
+
+ clear()
+ #user may need help
+ if yr == "*" then {
+ instructions("hebcalen.hlp") | fail
+ clear()
+ iputs(igoto(getval("cm"),1,2))
+ write("Enter a year. By default, all dates are interpreted")
+ write("according to the Jewish calendar. Civil years should")
+ write("be preceded by a + or - sign to indicate occurrence")
+ write("relative to the beginning of the common era (the cur-")
+ writes("rent civil year, ",current_year,", is the default): ")
+ boldface()
+ year := read()
+ normal()
+ "q" == map(year) & fail
+ }
+ else year := yr
+
+ "" == year & year := current_year
+ until jyr.yr := cleanup(year) do {
+ writes("\nI don't consider ")
+ boldface()
+ writes(year)
+ normal()
+ writes(" a valid date. Try again: ")
+ boldface()
+ year := read()
+ normal()
+ "q" == map(year) & fail
+ "" == year & year := current_year
+ }
+
+ clear()
+ initialize_variables()
+ return
+
+end
+
+
+
+procedure get_current_year()
+ local c_date
+
+ &date ? c_date := tab(find("/"))
+ return "+" || c_date
+end
+
+
+
+procedure cleanup(str)
+
+ # Tidy up the string. Bugs still possible.
+
+ if "" == trim(str) then return ""
+
+ map(Strip(str,~(&digits++'ABCDE+-'))) ? {
+
+ if find("-"|"bc"|"bcd")
+ then return (0 < (3761 - (0 ~= checkstr(str))))
+ else if find("+"|"ad"|"ce")
+ then return ((0 ~= checkstr(str)) + 3760)
+ else if 0 < integer(str)
+ then return str
+ else fail
+
+ }
+
+end
+
+
+
+procedure Strip(s,c)
+ local s2
+
+ s2 := ""
+ s ? {
+ while s2 ||:= tab(upto(c))
+ do tab(many(c))
+ s2 ||:= tab(0)
+ }
+ return s2
+
+end
+
+
+
+procedure checkstr(s)
+
+ # Does preliminary work on string before cleanup() cleans it up.
+
+ local letter,n,newstr
+
+ newstr := ""
+ every newstr ||:= string(integer(!s))
+ if 0 = *newstr | "" == newstr
+ then fail
+ else return newstr
+
+end
+
+
+
+procedure process()
+ local ans, yj, n
+
+ # Extracts information about the specified year.
+
+ local msg, limit, dj, dc, month_count, done
+ static how_many_per_screen, how_many_screens
+ initial {
+ how_many_per_screen := how_many_can_fit()
+ (how_many_screens := seq()) * how_many_per_screen >= 12
+ }
+
+ # 6019 is last year handled by the table in the usual way.
+ if jyr.yr > 6019
+ then msg := "Calculating. Years over 6019 take a long time."
+ else msg := "Calculating."
+ if jyr.yr <= 6019 then {
+ limit := jyr.yr % 20
+ jyr.yr := ((jyr.yr / 20) * 20)
+ }
+ else {
+ limit := jyr.yr - 6000
+ jyr.yr := 6000
+ }
+
+ ans := "y"
+ establish_jyr()
+ iputs(igoto(getval("cm"),1,2))
+ writes(msg)
+ every 1 to limit do {
+ # Increment the years, establish the type of Jewish year
+ cyr_augment()
+ jyr_augment()
+ establish_jyr()
+ }
+
+ clear()
+ while ("y"|"") == map(ans) do {
+
+ yj := jyr.yr
+ dj := days_in_jyr
+
+ month_count := 0
+ # On the variable how_many_screens, see initial { } above
+ every n := 1 to how_many_screens do {
+ clear()
+ every 1 to how_many_per_screen do {
+ write_a_month()
+ (month_count +:= 1) = 12 & break
+ }
+ if month_count < 12 | (12 % (13 > how_many_per_screen)) = 0
+ then {
+
+ iputs(igoto(getval("cm"),1,getval("li")-2))
+ boldface()
+ writes(status_line(yj,dj))
+ normal()
+
+ if month_count < 12 | jyr.mth = 6 then {
+ iputs(igoto(getval("cm"),1,getval("li")-1))
+ writes("Press return to continue. ")
+ "q" == map(read()) & fail
+ }
+ }
+ }
+
+ if jyr.mth = 6 then {
+ if (12 % (13 > how_many_per_screen)) = 0
+ then clear()
+ write_a_month()
+ }
+ iputs(igoto(getval("cm"),1,getval("li")-2))
+ boldface()
+ writes(status_line(yj,dj))
+ normal()
+
+ iputs(igoto(getval("cm"),1,getval("li")-1))
+ writes("Display the next year? [yn] ")
+ ans := read()
+
+ }
+ return
+
+end
+
+
+
+procedure how_many_can_fit()
+
+ local LINES, how_many
+
+ LINES := getval("li") + 1
+ (((8 * (how_many := 1 to 14)) / LINES) = 1)
+
+ return how_many - 1
+
+end
+
+
+
+procedure cyr_augment()
+
+ # Make civil year a year later, we only need consider Aug,Sep,Nov.
+
+ local days,newmonth,newday
+
+ if cyr.mth = 8 then
+ days := 0 else
+ if cyr.mth = 9 then
+ days := 31 else
+ if cyr.mth = 10 then
+ days := 61 else
+ stop("Error in cyr_augment")
+
+ writes(".")
+
+ days := (days + cyr.day-365+days_in_jyr)
+ if isleap(cyr.yr + 1) then days -:= 1
+
+ # Cos it takes longer to get there.
+ if days <= 31 then {newmonth := 8; newday := days} else
+ if days <= 61 then {newmonth := 9; newday := days-31} else
+ {newmonth := 10; newday := days-61}
+
+ cyr.mth := newmonth
+ cyr.day := newday
+ cyr.yr +:= 1
+ if cyr.yr = 0 then cyr.yr := 1
+
+ return
+
+end
+
+
+
+procedure header()
+ local COLS
+
+ # Creates the header for Jewish and English side. Bug: This
+ # routine, as it stands, has to rewrite the entire screen, in-
+ # cluding blank spaces. Many of these could be elminated by
+ # judicious line clears and/or cursor movement commands. Do-
+ # ing so would certainly speed up screen refresh for lower
+ # baud rates. I've utilized the ch command where available,
+ # but in most cases, plain old spaces must be output.
+
+ static make_whitespace, whitespace
+ initial {
+ COLS := getval("co")
+ if getval("ch") then {
+ # Untested, but it would offer a BIG speed advantage!
+ make_whitespace := create |iputs(igoto(getval("ch"),(COLS-53)+25))
+ }
+ else {
+ # Have to do things this way, since we don't know what line
+ # we are on (cm commands usually default to row/col 1).
+ whitespace := repl(" ",COLS-53)
+ make_whitespace := create |writes(whitespace)
+ }
+ }
+
+ writes(repl(" ",7),"S",repl(" ",2),"M",repl(" ",2),"T",repl(" ",2),"W",
+ repl(" ",2),"T",repl(" ",2),"F",repl(" ",2))
+ boldface()
+ writes("S")
+ normal()
+ @make_whitespace
+ writes("S",repl(" ",2),"M",repl(" ",2),"T",repl(" ",2),"W",
+ repl(" ",2),"T",repl(" ",2),"F",repl(" ",2))
+ boldface()
+ writes("S")
+ normal()
+ iputs(getval("ce"))
+ write()
+
+end
+
+
+
+procedure write_a_month()
+
+ # Writes a month on the screen
+
+ header()
+ every 1 to 5 do {
+ writes(make_a_line())
+ iputs(getval("ce"))
+ write()
+ }
+ if jyr.day ~= 1 then {
+ writes(make_a_line())
+ iputs(getval("ce"))
+ write()
+ }
+ iputs(getval("ce"))
+ write()
+
+ return
+
+end
+
+
+
+procedure status_line(a,b)
+
+ # Create the status line at the bottom of screen.
+
+ local sline,c,d
+
+ c := cyr.yr
+ if (cyr.day = 1) & (cyr.mth = 1) then c -:= 1
+ d := { if isleap(c) then 366 else 365 }
+ if getval("co") > 79 then {
+ sline := ("Year of Creation: " || a || " Days in year: " || b ||
+ " Civil year: " || c || " Days in year: " || d)
+ }
+ else {
+ sline := ("Jewish year " || a || " (" || b || " days)," ||
+ " Civil year " || c || " (" || d || " days)")
+ }
+
+ return center(sline,getval("co"))
+
+end
+
+
+
+procedure boldface()
+
+ static bold_str, cookie_str
+ initial {
+ if bold_str := getval("so")
+ then cookie_str := repl(getval("bc") | "\b", getval("sg"))
+ else {
+ if bold_str := getval("ul")
+ then cookie_str := repl(getval("bc") | "\b", getval("ug"))
+ }
+ }
+
+ iputs(\bold_str)
+ iputs(\cookie_str)
+ return
+
+end
+
+
+
+procedure normal()
+
+ static UN_bold_str, cookie_str
+ initial {
+ if UN_bold_str := getval("se")
+ then cookie_str := repl(getval("bc") | "\b", getval("sg"))
+ else {
+ if UN_bold_str := getval("ue")
+ then cookie_str := repl(getval("bc") | "\b", getval("ug"))
+ }
+ }
+
+ iputs(\UN_bold_str)
+ iputs(\cookie_str)
+ return
+
+end
+
+
+#--------------------- end modified sections of code ----------------------#
+
+# Okay, okay a couple of things have been modified below, but nothing major.
+
+procedure make_a_line()
+#make a single line of the months
+local line,blanks1,blanks2,start_point,end_point,flag,fm
+static number_of_spaces
+initial number_of_spaces := getval("co")-55
+
+#consider the first line of the month
+ if jyr.day = 1 then {
+ line := mth_table(jyr.mth,1)
+#setting flag means insert civil month at end of line
+ flag := 1 } else
+ line := repl(" ",3)
+#consider the case where first day of civil month is on Sunday
+ if (cyr.day = 1) & (current_day = 1) then flag := 1
+#space between month name and beginning of calendar
+ line ||:= repl(" ",2)
+#measure indentation for first line
+ line ||:= blanks1 := repl(" ",3*(current_day-1))
+#establish start point for Hebrew loop
+ start_point := current_day
+#establish end point for Hebrew loop and run civil loop
+ every end_point := start_point to 7 do {
+ line ||:= right(jyr.day,3)
+ if not j_augment() then {jyr_augment(); establish_jyr(); current_day -:= 1; if current_day = 0 then current_day := 7}
+ d_augment()
+ if jyr.day = 1 then break }
+#measure indentation for last line
+ blanks2 := repl(" ",3*(7-end_point))
+ line ||:= blanks2; line ||:= repl(" ",number_of_spaces); line ||:= blanks1
+ every start_point to end_point do {
+ line ||:= right(cyr.day,3)
+ if (cyr.day = 1) then flag := 1
+ augment()}
+ line ||:= blanks2 ||:= repl(" ",3)
+ fm := cyr.mth
+ if cyr.day = 1 then
+ if cyr.mth = 1 then fm := 12 else fm := cyr.mth - 1
+ if \flag then line ||:= mth_table(fm,2) else
+ line ||:= repl(" ",3)
+return line
+end
+
+procedure mth_table(n,p)
+#generates the short names of Jewish and Civil months. Get to civil side
+#by adding 13 (=max no of Jewish months)
+static corresp
+initial corresp := ["NIS","IYA","SIV","TAM","AV ","ELU","TIS","HES","KIS",
+"TEV","SHE","ADA","AD2","JAN","FEB","MAR","APR","MAY","JUN","JUL","AUG","SEP",
+"OCT","NOV","DEC"]
+ if (p ~= 1) & (p ~= 2) then stop("ERROR IN MTH-TABLE") else
+ if p = 2 then n +:= 13
+return corresp[n]
+end
+
+procedure d_augment()
+#increment the day of the week
+ current_day +:= 1
+ if current_day = 8 then current_day := 1
+return
+end
+
+procedure augment()
+#increments civil day, modifies month and year if necessary, stores in
+#global variable cyr
+ if cyr.day < 28 then
+ cyr.day +:= 1 else
+ if cyr.day = 28 then {
+ if (cyr.mth ~= 2) | ((cyr.mth = 2) & isleap(cyr.yr)) then
+ cyr.day := 29 else {
+ cyr.mth := 3
+ cyr.day := 1}} else
+ if cyr.day = 29 then {
+ if cyr.mth ~= 2 then
+ cyr.day := 30 else {
+ cyr.mth := 3
+ cyr.day := 1}} else
+ if cyr.day = 30 then {
+ if is_31(cyr.mth) then
+ cyr.day := 31 else {
+ cyr.mth +:= 1
+ cyr.day := 1}} else {
+ cyr.day := 1
+ if cyr.mth ~= 12 then
+ cyr.mth +:= 1 else {
+ cyr.mth := 1
+ cyr.yr +:= 1
+ if cyr.yr = 0
+ then cyr.yr := 1}}
+return
+end
+
+procedure is_31(n)
+#civil months with 31 days
+return n = 1 | n = 3 | n = 5 | n = 7 | n = 8 | n = 10 | n = 12
+end
+
+procedure isleap(n)
+#checks for civil leap year
+ if n > 0 then
+return (n % 400 = 0) | ((n % 4 = 0) & (n % 100 ~= 0)) else
+return (n % 400 = -1) | ((n % 4 = -1) & (n % 100 ~= -1))
+end
+
+procedure j_augment()
+#increments jewish day. months are numbered from nisan, adar sheni is 13.
+#procedure fails at elul to allow determination of type of new year
+ if jyr.day < 29 then
+ jyr.day +:= 1 else
+ if (jyr.day = 30) | always_29(jyr.mth) | ((jyr.mth = 8) &
+ (days_in_jyr % 5 ~= 0)) | ((jyr.mth = 9) & ((days_in_jyr = 353) |
+ (days_in_jyr = 383))) then
+ jyr.mth +:= jyr.day := 1 else
+ if jyr.mth = 6 then fail else
+ if ((jyr.mth = 12) & (days_in_jyr < 383)) | (jyr.mth = 13) then
+ jyr.mth := jyr.day := 1 else
+ jyr.day := 30
+return
+end
+
+procedure always_29(n)
+#uncomplicated jewish months with 29 days
+return n = 2 | n = 4 | n = 10
+end
+
+procedure jyr_augment()
+#determines the current time of lunation, using the ancient babylonian unit
+#of 1/1080 of an hour. lunation of tishri determines type of year. allows
+#for leap year. halaqim = parts of the hour
+local days, halaqim
+ days := current_molad.day + 4
+ if days_in_jyr <= 355 then {
+ halaqim := current_molad.halaqim + 9516
+ days := ((days +:= halaqim / 25920) % 7)
+ if days = 0 then days := 7
+ halaqim := halaqim % 25920} else {
+ days +:= 1
+ halaqim := current_molad.halaqim + 23269
+ days := ((days +:= halaqim / 25920) % 7)
+ if days = 0 then days := 7
+ halaqim := halaqim % 25920}
+ current_molad.day := days
+ current_molad.halaqim := halaqim
+#reset the global variable which holds the current jewish date
+ jyr.yr +:= 1 #increment year
+ jyr.day := 1
+ jyr.mth := 7
+ establish_jyr()
+return
+end
+
+procedure establish_jyr()
+#establish the jewish year from get_rh
+local res
+ res := get_rh(current_molad.day,current_molad.halaqim,no_lunar_yr(jyr.yr))
+ days_in_jyr := res[2]
+ current_day := res[1]
+return
+end
+
+procedure isin1(i)
+#the isin procedures are sets of years in the Metonic cycle
+return i = (1 | 4 | 7 | 9 | 12 | 15 | 18)
+end
+
+procedure isin2(i)
+return i = (2 | 5 | 10 | 13 | 16)
+end
+
+procedure isin3(i)
+return i = (3 | 6 | 8 | 11 | 14 | 17 | 0)
+end
+
+procedure isin4(i)
+return i = (1 | 2 | 4 | 5 | 7 | 9 | 10 | 12 | 13 | 15 | 16 | 18)
+end
+
+procedure isin5(i)
+return i = (1 | 4 | 9 | 12 | 15)
+end
+
+procedure isin6(i)
+return i = (2 | 5 | 7 | 10 | 13 | 16 | 18)
+end
+
+procedure no_lunar_yr(i)
+#what year in the metonic cycle is it?
+return i % 19
+end
+
+procedure get_rh(d,h,yr)
+#this is the heart of the program. check the day of lunation of tishri
+#and determine where breakpoint is that sets the new moon day in parts
+#of the hour. return result in a list where 1 is day of rosh hashana and
+#2 is length of jewish year
+local c,result
+ c := no_lunar_yr(yr)
+ result := list(2)
+ if d = 1 then {
+ result[1] := 2
+ if (h < 9924) & isin4(c) then result[2] := 353 else
+ if (h < 22091) & isin3(c) then result[2] := 383 else
+ if (h > 9923) & (isin1(c) | isin2(c)) then result[2] := 355 else
+ if (h > 22090) & isin3(c) then result[2] := 385
+ } else
+ if d = 2 then {
+ if ((h < 16789) & isin1(c)) |
+ ((h < 19440) & isin2(c)) then {
+ result[1] := 2
+ result[2] := 355
+ } else
+ if (h < 19440) & isin3(c) then {
+ result[1] := 2
+ result[2] := 385
+ } else
+ if ((h > 16788) & isin1(c)) |
+ ((h > 19439) & isin2(c)) then {
+ result[1] := 3
+ result[2] := 354
+ } else
+ if (h > 19439) & isin3(c) then {
+ result[1] := 3
+ result[2] := 384
+ }
+ } else
+ if d = 3 then {
+ if (h < 9924) & (isin1(c) | isin2(c)) then {
+ result[1] := 3
+ result[2] := 354
+ } else
+ if (h < 19440) & isin3(c) then {
+ result[1] := 3
+ result[2] := 384
+ } else
+ if (h > 9923) & isin4(c) then {
+ result[1] := 5
+ result[2] := 354
+ } else
+ if (h > 19439) & isin3(c) then {
+ result[1] := 5
+ result[2] := 383}
+ } else
+ if d = 4 then {
+ result[1] := 5
+ if isin4(c) then result[2] := 354 else
+ if h < 12575 then result[2] := 383 else
+ result[2] := 385
+ } else
+ if d = 5 then {
+ if (h < 9924) & isin4(c) then {
+ result[1] := 5
+ result[2] := 354} else
+ if (h < 19440) & isin3(c) then {
+ result[1] := 5
+ result[2] := 385
+ } else
+ if (9923 < h < 19440) & isin4(c) then {
+ result[1] := 5
+ result[2] := 355
+ } else
+ if h > 19439 then {
+ result[1] := 7
+ if isin3(c) then result[2] := 383 else
+ result[2] := 353
+ }
+ } else
+ if d = 6 then {
+ result[1] := 7
+ if ((h < 408) & isin5(c)) | ((h < 9924) & isin6(c)) then
+ result[2] := 353 else
+ if ((h < 22091) & isin3(c)) then result[2] := 383 else
+ if ((h > 407) & isin5(c)) | ((h > 9923) & isin6(c)) then
+ result[2] := 355 else
+ if (h > 22090) & isin3(c) then result[2] := 385
+ } else
+ if d = 7 then if (h < 19440) & (isin5(c) | isin6(c)) then {
+ result[1] := 7
+ result[2] := 355
+ } else
+ if (h < 19440) & isin3(c) then {
+ result[1] := 7
+ result[2] := 385
+ } else {
+ result[1] := 2
+ if isin4(c) then
+ result[2] := 353 else
+ result[2] := 383}
+return result
+end
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-07 17:16:37 +0000