Source Code 1992 March/Source_Code_CD-ROM_Walnut_Creek_March_1992.iso/usenet/altsrcs/1/1604

Internet Message Format | 1990-12-28 | 54.8 KB

From: [e-mail] (Richard Goerwitz)
Newsgroups: alt.sources
Subject: Jewish/Civil calendar, part 03 of 03
Message-ID: <[e-mail]>
Date: 20 Jul 90 00:12:12 GMT

In article <[e-mail]> [e-mail] (Richard Goerwitz) writes:
>
>This is an experimental posting of a Unix port of an MS-DOS program
>written in Icon.  Icon, for those who do not know, is the successor
>language to Snobol (in fact SL5).  It retains great string handling
>facilities of Snobol, and yet possesses a fully procedural structure.
>It also incorporates data structures such as hash tables and linked
>lists, and provides builtin garbage collection, like most dialects
>of Lisp.  I personally use it for natural language processing, but
>it can also be used for rapid prototying of almost anything except
>low-level bit manipulation and systems programming jobs.  It is popu-
>lar among people doing all varieties of nonnumeric computing.
>
>The program itself - yes, by Jove, there is a program here - is a
>Jewish/Civil calendar display utility.  Lets you view corresponding
>dates for both calendars on screen simultaneously.  I've never un-
>derstood the Jewish calendar, and this seemed a good excuse to learn
>all the month names.  My real reason for porting it was that it was
>the first piece of software posted to comp.lang.icon that seemed a
>good way of testing my rough port of the C/Unix termlib library to
>Icon.  I thank Alan Corre (the original author) for permitting me to
>(ab)use the original MS-DOS program in this way.
>
>Anyone who does not have Icon is without excuse, since it is free,
>and available for many, many popular micros, minis, and some main-
>frames.  Just about anything that calls itself -nix can run Icon
>(Unix, Xenix, etc.).  Ftp it from cs.arizona.edu if you find your
>curiosity aroused, and don't already have it installed.
>
>   -Richard L. Goerwitz              [e-mail]
>   [e-mail]         rutgers!oddjob!gide!sophist!goer
>
>
>---- Cut Here and unpack ----
>#!/bin/sh
># This is a shell archive (shar 3.24)
># made 07/19/1990 22:27 UTC by [e-mail]
># Source directory /u/richard/Hebcalen
>#
># existing files WILL be overwritten
># This format requires very little intelligence at unshar time.
># "echo" and "sed" will be needed.
>#
># This is part 1 of a multipart archive
># do not concatenate these parts, unpack them in order with /bin/sh
>#
># This shar contains:
># length  mode       name
># ------ ---------- ------------------------------------------
>#  23020 -r--r--r-- hebcalen.src
>#  11276 -r--r--r-- itlib.icn
>#   4008 -rw-r--r-- hebcalen.hlp
>#   6490 -rw-r--r-- hebcalen.dat
>#   2475 -rw-r--r-- README
>#   1654 -rw-r--r-- Makefile.dist
>#  29360 -rw-r--r-- cal.text
>#
>if test -r shar3_seq_.tmp; then
>    echo "Must unpack archives in sequence!"
>    next=`cat shar3_seq_.tmp`; echo "Please unpack part $next next"
>    exit 1
>fi
># ============= hebcalen.src ==============
>echo "x - extracting hebcalen.src (Text)"
>sed 's/^X//' << 'SHAR_EOF' > hebcalen.src &&
>X##########################################################################
>X#
>X#    NAME:   hebcalen.icn
>X#
>X#    TITLE:  Combination Jewish/Civil calendar
>X#
>X#    AUTHOR: Alan D. Corre (ported to Unix by Richard Goerwitz)
>X#
>X#    DATE:   7/19/90 (version 1.11)
>X#
>X##########################################################################
>X#
>X#  COPYRIGHT (c) 1990, Alan D. Corre
>X#
>X#  Permission is hereby given to all persons to copy, compile and pass
>X#  to others this code provided that (1) it is not used for monetary
>X#  gain; (2) it is not subverted from its original purpose, and is
>X#  changed only to the extent necessary to make it work on a different
>X#  computer or terminal.  No guarantees are given or implied as to the
>X#  correctness of information furnished by this program.
>X#
>X##########################################################################
>X#
>X#  This work is respectfully devoted to the authors of two books
>X#  consulted with much profit: "A Guide to the Solar-Lunar Calendar"
>X#  by B. Elihu Rothblatt published by our sister Hebrew Dept. in
>X#  Madison, Wis., and "Kiddush HaHodesh" by Rabbenu Moses ben Maimon,
>X#  on whom be peace.
>X#
>X#  The Jewish year harmonizes the solar and lunar cycle, using the
>X#  19-year cycle of Meton (c. 432 BCE). It corrects so that certain
>X#  dates shall not fall on certain days for religious convenience. The
>X#  Jewish year has six possible lengths, 353, 354, 355, 383, 384, and
>X#  385 days, according to day and time of new year lunation and
>X#  position in Metonic cycle.  Time figures from 6pm previous night.
>X#  The lunation of year 1 is calculated to be on a Monday (our Sunday
>X#  night) at ll:11:20pm. Our data table begins with a hypothetical
>X#  year 0, corresponding to 3762 B.C.E.  Calculations in this program
>X#  are figured in the ancient Babylonian unit of halaqim "parts" of
>X#  the hour = 1/1080 hour.
>X#
>X#  Startup syntax is simply hebcalen [date], where date is a year
>X#  specification of the form 5750 for a Jewish year, +1990 or 1990AD
>X#  or 1990CE or -1990 or 1990BC or 1990BCE for a civil year.
>X#
>X#  (Bugs:  Years over 6039 are calculated from scratch (slow).  I've
>X#  also noticed that the dates are incorrect (e.g. hebcalen +7777
>X#  will display civil year 7757).  I have not delved into the pro-
>X#  gram deep enough to pinpoint the cause of the dating discrepancy.
>X#  - RLG)
>X#
>X##########################################################################
>X
>X
>Xrecord date(yr,mth,day)
>Xrecord molad(day,halaqim)
>Xglobal cyr,jyr,days_in_jyr,current_molad,current_day,infolist
>X
>X
>X#------- the following sections of code have been modified  - RLG -------#
>X
>Xprocedure main(a)
>X
>X    iputs(getval("ti"))
>X    display_startup_screen()
>X
>X    if *a = 0 then {
>X    #put()'ing an asterisk means that user might need help
>X    n := 1; put(a,"*")
>X    }
>X    else n := *a
>X    every p := 1 to n do {
>X    initialize(a[p]) | break
>X    process() | break
>X    }
>X    iputs(getval("te"))
>X
>Xend
>X
>X
>X
>Xprocedure display_startup_screen()
>X
>X    local T
>X
>X    clear()
>X    banner("PERPETUAL JEWISH/CIVIL CALENDAR","by","ALAN D. CORRE")
>X    # Use a combination of tricks to be sure it will be up there a sec.
>X    every 1 to 10000
>X    T := &time; until &time > (T+450)
>X
>X    return
>X
>Xend
>X
>X
>X
>Xprocedure banner(l[])
>X
>X    # Creates a banner to begin hebcalen.  Leaves it on the screen for
>X    # about a second.
>X
>X    local m, n, CM, COLS, LINES
>X
>X    CM    := getval("cm")
>X    COLS  := getval("co")
>X    LINES := getval("li")
>X    (COLS > 55, LINES > 9) |
>X    stop("\nSorry, your terminal just isn't big enough.")
>X
>X    if LINES > 20 then {
>X    # Terminal is big enough for banner.
>X    iputs(igoto(CM,1,3))
>X    writes("+",repl("-",COLS-3),"+")
>X    iputs(igoto(CM,1,4))
>X    writes("|")
>X    iputs(igoto(CM,COLS-1,4))
>X    writes("|")
>X
>X    m := 0
>X    every n := 5 to (*l * 3) + 4 by 3 do {
>X        iputs(igoto(CM,1,n))
>X        writes("|",center(l[m+:=1],COLS-3),"|")
>X        every iputs(igoto(CM,1,n+(1|2))) & writes("|")
>X        every iputs(igoto(CM,COLS-1,n+(1|2))) & writes("|")
>X    }
>X
>X    iputs(igoto(CM,1,n+3))
>X    writes("+",repl("-",COLS-3),"+")
>X    iputs(igoto(CM,1,n+4))
>X    write(" Copyright (c) Alan D. Corre, 1990")
>X    }
>X    else {
>X    # Terminal is extremely short
>X    iputs(igoto(CM,1,(LINES/2)-1))
>X    write(center(l[1],COLS))
>X    write(center("Copyright (c) Alan D. Corre, 1990",COLS))
>X    }
>X
>X    return
>X
>Xend
>X
>X
>X
>Xprocedure get_paths()
>X
>X    local paths, p
>X
>X    suspend "./" | "/usr/local/lib/hebcalen/"
>X    paths := getenv("PATH")
>X    \paths ? {
>X    tab(match(":"))
>X    while p := 1(tab(find(":")), move(1))
>X    do suspend "" ~== trim(p,'/ ') || "/"
>X    return "" ~== trim(tab(0) \ 1,'/ ') || "/"
>X    }
>X
>Xend
>X
>X
>X
>Xprocedure instructions(filename)
>X
>X    # Gives user access to a help file which is printed out in chunks
>X    # by "more."
>X
>X    local helpfile, pager, ans
>X
>X    iputs(igoto(getval("cm"),1,2))
>X    writes("Do you need instructions? [ny]  ")
>X    ans := map(read())
>X    "q" == ans & fail
>X
>X    if "y" == ans then {
>X    if close(open(helpfile := (get_paths()||filename)))
>X    then {
>X        # Kludge, kludge, kludge.
>X        close(open(
>X        more_file := (
>X            ("" ~== getenv("PAGER")) |
>X            (("/bin/"|"/usr/ucb/"|"/usr/bin/")||"more"))))
>X        system(more_file || " " || helpfile)
>X    }
>X    else write("Can't find your hebcalen.hlp file!")
>X    iputs(igoto(getval("cm"),1,getval("li")))
>X    boldface()
>X    writes("Press return to continue.")
>X    normal()
>X    "q" == map(read()) & fail
>X    }
>X
>X    return \helpfile | "no help"
>X
>Xend
>X
>X
>X
>Xprocedure clear()
>X
>X    # Clears the screen.  Tries several methods.
>X
>X    if not iputs(getval("cl"))
>X    then iputs(igoto(getval("cm"),1,1))
>X    if not iputs(getval("cd"))
>X    then {
>X    every i := 1 to getval("li") do {
>X        iputs(igoto(getval("cm"),1,i))
>X        iputs(getval("ce"))
>X    }
>X    iputs(igoto(getval("cm"),1,1))
>X    }
>X
>Xend
>X
>X
>X
>Xprocedure initialize_list()
>X
>X    # Put info of hebcalen.dat into a global list
>X
>X    local infile,n
>X
>X    infolist := list(301)
>X    if not (infile := open(get_paths()||"hebcalen.dat")) then
>X    stop("\nError:  hebcalen.dat must be in your path or the current dir.")
>X
>X    # The table is arranged at twenty year intervals with 301 entries.
>X    every n := 1 to 301 do
>X    infolist[n] := read(infile)
>X    close(infile)
>X
>Xend
>X
>X
>X
>Xprocedure initialize_variables()
>X
>X    # Get the closest previous year in the table.
>X
>X    local line, quotient
>X
>X    quotient := jyr.yr / 20 + 1
>X    # Only 301 entries. Figure from last if necessary.
>X    if quotient > 301 then quotient := 301
>X    # Pull the appropriate info, put into global variables.
>X    line := infolist[quotient]
>X
>X    line ? {
>X    current_molad.day := tab(upto('%'))
>X    move(1)
>X    current_molad.halaqim := tab(upto('%'))
>X    move(1)
>X    cyr.mth := tab(upto('%'))
>X    move(1)
>X    cyr.day := tab(upto('%'))
>X    move(1)
>X    cyr.yr := tab(upto('%'))
>X    days_in_jyr := line[-3:0]
>X    }
>X
>X    # Begin at rosh hashana.
>X    jyr.day := 1
>X    jyr.mth := 7
>X    return
>X
>Xend
>X
>X
>X
>Xprocedure initialize(yr)
>X
>X    local year
>X    static current_year
>X
>X    # initialize global variables
>X    initial {
>X    cyr := date(0,0,0)
>X    jyr := date(0,0,0)
>X    current_molad := molad(0,0)
>X    initialize_list()
>X    current_year := get_current_year()
>X    }
>X
>X    clear()
>X    #user may need help
>X    if yr == "*" then {
>X    instructions("hebcalen.hlp") | fail
>X    clear()
>X    iputs(igoto(getval("cm"),1,2))
>X    write("Enter a year.  By default, all dates are interpreted")
>X    write("according to the Jewish calendar.  Civil years should")
>X    write("be preceded by a + or - sign to indicate occurrence")
>X    write("relative to the beginning of the common era (the cur-")
>X    writes("rent civil year, ",current_year,", is the default):  ")
>X    boldface()
>X    year := read()
>X    normal()
>X    "q" == map(year) & fail
>X    }
>X    else year := yr
>X
>X    "" == year & year := current_year
>X    until jyr.yr := cleanup(year) do {
>X    writes("\nI don't consider ")
>X    boldface()
>X    writes(year)
>X    normal()
>X    writes(" a valid date.  Try again:  ")
>X    boldface()
>X    year := read()
>X    normal()
>X    "q" == map(year) & fail
>X    "" == year & year := current_year
>X    }
>X
>X    clear()
>X    initialize_variables()
>X    return
>X
>Xend
>X
>X
>X
>Xprocedure get_current_year()
>X    &date ? c_date := tab(find("/"))
>X    return "+" || c_date
>Xend
>X
>X
>X
>Xprocedure cleanup(str)
>X
>X    # Tidy up the string. Bugs still possible.
>X
>X    if "" == trim(str) then return ""
>X
>X    map(Strip(str,~(&digits++'ABCDE+-'))) ? {
>X
>X    if find("-"|"bc"|"bcd")
>X    then return (0 < (3761 - (0 ~= checkstr(str))))
>X    else if find("+"|"ad"|"ce")
>X    then return ((0 ~= checkstr(str)) + 3760)
>X    else if 0 < integer(str)
>X    then return str
>X    else fail
>X
>X    }
>X
>Xend
>X
>X
>X
>Xprocedure Strip(s,c)
>X
>X    s2 := ""
>X    s ? {
>X    while s2 ||:= tab(upto(c))
>X    do tab(many(c))
>X    s2 ||:= tab(0)
>X    }
>X    return s2
>X
>Xend
>X
>X
>X
>Xprocedure checkstr(s)
>X
>X    # Does preliminary work on string before cleanup() cleans it up.
>X
>X    local letter,n,newstr
>X
>X    newstr := ""
>X    every newstr ||:= string(integer(!s))
>X    if 0 = *newstr | "" == newstr
>X    then fail
>X    else return newstr
>X
>Xend
>X
>X
>X
>Xprocedure process()
>X
>X    # Extracts information about the specified year.
>X
>X    local msg, limit, dj, dc, month_count, done
>X    static how_many_per_screen, how_many_screens
>X    initial {
>X    how_many_per_screen := how_many_can_fit()
>X    (how_many_screens := seq()) * how_many_per_screen >= 12
>X    }
>X
>X    # 6039 is last year handled by the table in the usual way.
>X    if jyr.yr > 6039
>X    then msg := "Calculating.  Years over 6039 take a long time."
>X    else msg := "Calculating."
>X    if jyr.yr <= 6039 then {
>X    limit := jyr.yr % 20
>X    jyr.yr := ((jyr.yr / 20) * 20)} else {
>X            # Otherwise figure from 6020 and good luck
>X        limit := jyr.yr - 6020
>X        jyr.yr := 6020
>X    }
>X
>X    ans := "y"
>X    establish_jyr()
>X    iputs(igoto(getval("cm"),1,2))
>X    writes(msg)
>X    every 1 to limit do {
>X    # Increment the years, establish the type of Jewish year
>X    cyr_augment()
>X    jyr_augment()
>X    establish_jyr()
>X    }
>X
>X    clear()
>X    while ("y"|"") == map(ans) do {
>X
>X    yj := jyr.yr
>X    dj := days_in_jyr
>X
>X    month_count := 0
>X    # On the variable how_many_screens, see initial { } above
>X    every n := 1 to how_many_screens do {
>X        clear()
>X        every 1 to how_many_per_screen do {
>X        write_a_month()
>X        (month_count +:= 1) = 12 & break
>X        }
>X        if month_count < 12 | (12 % (13 > how_many_per_screen)) = 0
>X        then {
>X
>X        iputs(igoto(getval("cm"),1,getval("li")-2))
>X        boldface()
>X        writes(status_line(yj,dj))
>X        normal()
>X
>X        if month_count < 12 | jyr.mth = 6 then {
>X            iputs(igoto(getval("cm"),1,getval("li")-1))
>X            writes("Press return to continue.  ")
>X            "q" == map(read()) & fail
>X        }
>X        }
>X    }
>X
>X    if jyr.mth = 6 then {
>X        if (12 % (13 > how_many_per_screen)) = 0
>X        then clear()
>X        write_a_month()
>X    }
>X    iputs(igoto(getval("cm"),1,getval("li")-2))
>X    boldface()
>X    writes(status_line(yj,dj))
>X    normal()
>X
>X    iputs(igoto(getval("cm"),1,getval("li")-1))
>X    writes("Display the next year? [yn]  ")
>X    ans := read()
>X
>X    }
>X    return
>X
>Xend
>X
>X
>X
>Xprocedure how_many_can_fit()
>X
>X    local LINES, how_many
>X
>X    LINES := getval("li") + 1
>X    (((8 * (how_many := 1 to 14)) / LINES) = 1)
>X
>X    return how_many - 1
>X
>Xend
>X
>X
>X
>Xprocedure cyr_augment()
>X
>X    # Make civil year a year later, we only need consider Aug,Sep,Nov.
>X
>X    local days,newmonth,newday
>X
>X    if cyr.mth = 8 then
>X    days := 0 else
>X    if cyr.mth = 9 then
>X    days := 31 else
>X    if cyr.mth = 10 then
>X    days := 61 else
>X    stop("Error in cyr_augment")
>X
>X    writes(".")
>X
>X    days := (days + cyr.day-365+days_in_jyr)
>X    if isleap(cyr.yr + 1) then days -:= 1
>X
>X    # Cos it takes longer to get there.
>X    if days <= 31 then {newmonth := 8; newday := days} else
>X    if days <= 61 then {newmonth := 9; newday := days-31} else
>X    {newmonth := 10; newday := days-61}
>X
>X    cyr.mth := newmonth
>X    cyr.day := newday
>X    cyr.yr +:= 1
>X    if cyr.yr = 0 then cyr.yr := 1
>X
>X    return
>X
>Xend
>X
>X
>X
>Xprocedure header()
>X
>X    # Creates the header for Jewish and English side.  Bug:  This
>X    # routine, as it stands, has to rewrite the entire screen, in-
>X    # cluding blank spaces.  Many of these could be elminated by
>X    # judicious line clears and/or cursor movement commands.  Do-
>X    # ing so would certainly speed up screen refresh for lower
>X    # baud rates.  I've utilized the ch command where available,
>X    # but in most cases, plain old spaces must be output.
>X
>X    static make_whitespace, whitespace
>X    initial {
>X    COLS := getval("co")
>X    if getval("ch") then {
>X        # Untested, but it would offer a BIG speed advantage!
>X        make_whitespace := create |iputs(igoto(getval("ch"),(COLS-53)+25))
>X    }
>X    else {
>X        # Have to do things this way, since we don't know what line
>X        # we are on (cm commands usually default to row/col 1).
>X        whitespace := repl(" ",COLS-53)
>X        make_whitespace := create |writes(whitespace)
>X    }
>X    }
>X
>X    writes(repl(" ",7),"S",repl(" ",2),"M",repl(" ",2),"T",repl(" ",2),"W",
>X       repl(" ",2),"T",repl(" ",2),"F",repl(" ",2))
>X    boldface()
>X    writes("S")
>X    normal()
>X    @make_whitespace
>X    writes("S",repl(" ",2),"M",repl(" ",2),"T",repl(" ",2),"W",
>X        repl(" ",2),"T",repl(" ",2),"F",repl(" ",2))
>X    boldface()
>X    writes("S")
>X    normal()
>X    iputs(getval("ce"))
>X    write()
>X
>Xend
>X
>X
>X
>Xprocedure write_a_month()
>X
>X    # Writes a month on the screen
>X
>X    header()
>X    every 1 to 5 do {
>X    writes(make_a_line())
>X    iputs(getval("ce"))
>X    write()
>X    }
>X    if jyr.day ~= 1 then {
>X    writes(make_a_line())
>X    iputs(getval("ce"))
>X    write()
>X    }
>X    iputs(getval("ce"))
>X    write()
>X
>X    return
>X
>Xend
>X
>X
>X
>Xprocedure status_line(a,b)
>X
>X    # Create the status line at the bottom of screen.
>X
>X    local sline,c,d
>X
>X    c := cyr.yr
>X    if (cyr.day = 1) & (cyr.mth = 1) then c -:= 1
>X    d := { if isleap(c) then 366 else 365 }
>X    if getval("co") > 79 then {
>X    sline := ("Year of Creation: " || a || "  Days in year: " || b ||
>X          "  Civil year: " || c || "  Days in year: " || d)
>X    }
>X    else {
>X    sline := ("Jewish year " || a || " (" || b || " days)," ||
>X          " Civil year " || c || " (" || d || " days)")
>X    }
>X
>X    return center(sline,getval("co"))
>X
>Xend
>X
>X
>X
>Xprocedure boldface()
>X
>X    static bold_str, cookie_str
>X    initial {
>X    if bold_str := getval("so")
>X    then cookie_str := repl(getval("bc") | "\b", getval("sg"))
>X    else {
>X        if bold_str := getval("ul")
>X        then cookie_str := repl(getval("bc") | "\b", getval("ug"))
>X    }
>X    }
>X
>X    iputs(\bold_str)
>X    iputs(\cookie_str)
>X    return
>X
>Xend
>X
>X
>X
>Xprocedure normal()
>X
>X    static UN_bold_str, cookie_str
>X    initial {
>X    if UN_bold_str := getval("se")
>X    then cookie_str := repl(getval("bc") | "\b", getval("sg"))
>X    else {
>X        if UN_bold_str := getval("ue")
>X        then cookie_str := repl(getval("bc") | "\b", getval("ug"))
>X    }
>X    }
>X
>X    iputs(\UN_bold_str)
>X    iputs(\cookie_str)
>X    return
>X
>Xend
>X
>X
>X#--------------------- end modified sections of code ----------------------#
>X
>X# Okay, okay a couple of things have been modified below, but nothing major.
>X
>Xprocedure make_a_line()
>X#make a single line of the months
>Xlocal line,blanks1,blanks2,start_point,end_point,flag,fm
>Xstatic number_of_spaces
>Xinitial number_of_spaces := getval("co")-55
>X
>X#consider the first line of the month
>X  if jyr.day = 1 then {
>X    line := mth_table(jyr.mth,1)
>X#setting flag means insert civil month at end of line
>X    flag := 1 } else
>X    line := repl(" ",3)
>X#consider the case where first day of civil month is on Sunday
>X  if (cyr.day = 1) & (current_day = 1) then flag := 1
>X#space between month name and beginning of calendar
>X  line ||:= repl(" ",2)
>X#measure indentation for first line
>X  line ||:= blanks1 := repl(" ",3*(current_day-1))
>X#establish start point for Hebrew loop
>X  start_point := current_day
>X#establish end point for Hebrew loop and run civil loop
>X  every end_point := start_point to 7 do {
>X    line ||:= right(jyr.day,3)
>X    if not j_augment() then {jyr_augment(); establish_jyr(); current_day -:= 1; if current_day = 0 then current_day := 7}
>X    d_augment()
>X    if jyr.day = 1 then break }
>X#measure indentation for last line
>X  blanks2 := repl(" ",3*(7-end_point))
>X  line ||:= blanks2; line ||:= repl(" ",number_of_spaces); line ||:= blanks1
>X  every start_point to end_point do {
>X    line ||:= right(cyr.day,3)
>X    if (cyr.day = 1) then flag := 1
>X    augment()}
>X  line ||:= blanks2 ||:= repl(" ",3)
>X  fm := cyr.mth
>X  if cyr.day = 1 then
>X    if cyr.mth = 1 then fm := 12 else fm := cyr.mth - 1
>X  if \flag then line ||:= mth_table(fm,2) else
>X    line ||:= repl(" ",3)
>Xreturn line
>Xend
>X
>Xprocedure mth_table(n,p)
>X#generates the short names of Jewish and Civil months. Get to civil side
>X#by adding 13 (=max no of Jewish months)
>Xstatic corresp
>Xinitial corresp := ["NIS","IYA","SIV","TAM","AV ","ELU","TIS","HES","KIS",
>X"TEV","SHE","ADA","AD2","JAN","FEB","MAR","APR","MAY","JUN","JUL","AUG","SEP",
>X"OCT","NOV","DEC"]
>X  if (p ~= 1) & (p ~= 2) then stop("ERROR IN MTH-TABLE") else
>X    if p = 2 then n +:= 13
>Xreturn corresp[n]
>Xend
>X
>Xprocedure d_augment()
>X#increment the day of the week
>X  current_day +:= 1
>X  if current_day = 8 then current_day := 1
>Xreturn
>Xend
>X
>Xprocedure augment()
>X#increments civil day, modifies month and year if necessary, stores in
>X#global variable cyr
>X  if cyr.day < 28 then
>X    cyr.day +:= 1 else
>X  if cyr.day = 28 then {
>X    if (cyr.mth ~= 2) | ((cyr.mth = 2) & isleap(cyr.yr)) then
>X      cyr.day := 29 else {
>X        cyr.mth := 3
>X    cyr.day  := 1}} else
>X  if cyr.day = 29 then {
>X    if cyr.mth ~= 2 then
>X      cyr.day := 30 else {
>X      cyr.mth := 3
>X      cyr.day := 1}} else
>X  if cyr.day = 30 then {
>X    if is_31(cyr.mth) then
>X      cyr.day := 31 else {
>X      cyr.mth +:= 1
>X      cyr.day := 1}} else {
>X      cyr.day := 1
>X      if cyr.mth ~= 12 then
>X        cyr.mth +:= 1 else {
>X        cyr.mth := 1
>X        cyr.yr +:= 1
>X        if cyr.yr = 0
>X      then cyr.yr := 1}}
>Xreturn
>Xend
>X
>Xprocedure is_31(n)
>X#civil months with 31 days
>Xreturn n = 1 | n = 3 | n = 5 | n = 7 | n = 8 | n = 10 | n = 12
>Xend
>X
>Xprocedure isleap(n)
>X#checks for civil leap year
>X  if n > 0 then
>Xreturn (n % 400 = 0) | ((n % 4 = 0) & (n % 100 ~= 0)) else
>Xreturn (n % 400 = -1) | ((n % 4 = -1) & (n % 100 ~= -1))
>Xend
>X
>Xprocedure j_augment()
>X#increments jewish day. months are numbered from nisan, adar sheni is 13.
>X#procedure fails at elul to allow determination of type of new year
>X  if jyr.day < 29 then
>X    jyr.day +:= 1 else
>X  if (jyr.day = 30) | always_29(jyr.mth) | ((jyr.mth = 8) &
>X    (days_in_jyr % 5 ~= 0)) | ((jyr.mth = 9) & ((days_in_jyr = 353) |
>X    (days_in_jyr = 383))) then
>X    jyr.mth +:= jyr.day := 1 else
>X  if jyr.mth = 6 then fail else
>X  if ((jyr.mth = 12) & (days_in_jyr < 383)) | (jyr.mth = 13) then
>X    jyr.mth := jyr.day := 1 else
>X  jyr.day := 30
>Xreturn
>Xend
>X
>Xprocedure always_29(n)
>X#uncomplicated jewish months with 29 days
>Xreturn n = 2 | n = 4 | n = 10
>Xend
>X
>Xprocedure jyr_augment()
>X#determines the current time of lunation, using the ancient babylonian unit
>X#of 1/1080 of an hour. lunation of tishri determines type of year. allows
>X#for leap year. halaqim = parts of the hour
>Xlocal days, halaqim
>X  days := current_molad.day + 4
>X  if days_in_jyr <= 355 then {
>X    halaqim :=  current_molad.halaqim + 9516
>X    days := ((days +:= halaqim / 25920) % 7)
>X    if days = 0 then days := 7
>X    halaqim := halaqim % 25920} else {
>X    days +:= 1
>X    halaqim := current_molad.halaqim + 23269
>X    days := ((days +:= halaqim / 25920) % 7)
>X    if days = 0 then days := 7
>X    halaqim := halaqim % 25920}
>X  current_molad.day := days
>X  current_molad.halaqim := halaqim
>X#reset the global variable which holds the current jewish date
>X  jyr.yr +:= 1 #increment year
>X  jyr.day := 1
>X  jyr.mth := 7
>X  establish_jyr()
>Xreturn
>Xend
>X
>Xprocedure establish_jyr()
>X#establish the jewish year from get_rh
>Xlocal res
>X  res := get_rh(current_molad.day,current_molad.halaqim,no_lunar_yr(jyr.yr))
>X  days_in_jyr := res[2]
>X  current_day := res[1]
>Xreturn
>Xend
>X
>Xprocedure isin1(i)
>X#the isin procedures are sets of years in the Metonic cycle
>Xreturn i = (1 | 4 | 7 | 9 | 12 | 15 | 18)
>Xend
>X
>Xprocedure isin2(i)
>Xreturn i = (2 | 5 | 10 | 13 | 16)
>Xend
>X
>Xprocedure isin3(i)
>Xreturn i = (3 | 6 | 8 | 11 | 14 | 17 | 0)
>Xend
>X
>Xprocedure isin4(i)
>Xreturn i = (1 | 2 | 4 | 5 | 7 | 9 | 10 | 12 | 13 | 15 | 16 | 18)
>Xend
>X
>Xprocedure isin5(i)
>Xreturn i = (1 | 4 | 9 | 12 | 15)
>Xend
>X
>Xprocedure isin6(i)
>Xreturn i = (2 | 5 | 7 | 10 | 13 | 16 | 18)
>Xend
>X
>Xprocedure no_lunar_yr(i)
>X#what year in the metonic cycle is it?
>Xreturn i % 19
>Xend
>X
>Xprocedure get_rh(d,h,yr)
>X#this is the heart of the program. check the day of lunation of tishri
>X#and determine where breakpoint is that sets the new moon day in parts
>X#of the hour. return result in a list where 1 is day of rosh hashana and
>X#2 is length of jewish year
>Xlocal c,result
>X  c := no_lunar_yr(yr)
>X  result := list(2)
>X  if d = 1 then {
>X          result[1] := 2
>X                if (h < 9924) & isin4(c) then result[2] := 353 else
>X        if (h < 22091) & isin3(c) then result[2] := 383 else
>X        if (h > 9923) & (isin1(c) | isin2(c)) then result[2] := 355 else
>X        if (h > 22090) & isin3(c) then result[2] := 385
>X        } else
>X  if d = 2 then {
>X          if ((h < 16789) & isin1(c)) |
>X           ((h < 19440) & isin2(c)) then {
>X                                 result[1] := 2
>X                             result[2] := 355
>X                             } else
>X        if (h < 19440) & isin3(c) then  {
>X                                 result[1] := 2
>X                             result[2] := 385
>X                             } else
>X          if ((h > 16788) & isin1(c)) |
>X           ((h > 19439) & isin2(c)) then {
>X                                 result[1] := 3
>X                             result[2] := 354
>X                             } else
>X                if (h > 19439) & isin3(c) then  {
>X                                 result[1] := 3
>X                             result[2] := 384
>X                             }
>X        } else
>X  if d = 3 then {
>X          if (h < 9924) & (isin1(c) | isin2(c)) then {
>X                               result[1] := 3
>X                               result[2] := 354
>X                               } else
>X        if (h < 19440) & isin3(c) then {
>X                           result[1] := 3
>X                           result[2] := 384
>X                           } else
>X        if (h > 9923) & isin4(c) then {
>X                          result[1] := 5
>X                          result[2] := 354
>X                          } else
>X        if (h > 19439) & isin3(c) then {
>X                           result[1] := 5
>X                           result[2] := 383}
>X        } else
>X  if d = 4 then {
>X          result[1] := 5
>X        if isin4(c) then result[2] := 354 else
>X        if h < 12575 then result[2] := 383 else
>X        result[2] := 385
>X        } else
>X  if d = 5 then {
>X                if (h < 9924) & isin4(c) then {
>X                          result[1] := 5
>X                          result[2] := 354} else
>X        if (h < 19440) & isin3(c) then {
>X                           result[1] := 5
>X                           result[2] := 385
>X                           } else
>X        if (9923 < h < 19440) & isin4(c) then {
>X                              result[1] := 5
>X                              result[2] := 355
>X                              } else
>X        if h > 19439 then {
>X                    result[1] := 7
>X                          if isin3(c) then result[2] := 383 else
>X                            result[2] := 353
>X                  }
>X        } else
>X  if d = 6 then {
>X            result[1] := 7
>X            if ((h < 408) & isin5(c)) | ((h < 9924) & isin6(c)) then
>X                              result[2] := 353 else
>X            if ((h < 22091) & isin3(c)) then result[2] := 383 else
>X            if ((h > 407) & isin5(c)) | ((h > 9923) & isin6(c)) then
>X                              result[2] := 355 else
>X            if (h > 22090) & isin3(c) then result[2] := 385
>X            } else
>X  if d = 7 then    if (h < 19440) & (isin5(c) | isin6(c)) then {
>X                              result[1] := 7
>X                              result[2] := 355
>X                              } else
>X        if (h < 19440) & isin3(c) then {
>X                           result[1] := 7
>X                           result[2] := 385
>X                           } else {
>X                                  result[1] := 2
>X                              if isin4(c) then
>X                                result[2] := 353 else
>X                            result[2] := 383}
>Xreturn result
>Xend
>SHAR_EOF
># ============= itlib.icn ==============
>echo "x - extracting itlib.icn (Text)"
>sed 's/^X//' << 'SHAR_EOF' > itlib.icn &&
>X########################################################################
>X#
>X#    Name:    itlib.icn
>X#
>X#    Title:    Icon termlib-type tools
>X#
>X#    Author:    Richard L. Goerwitz
>X#
>X#    Date:    7/19/90 (version 1.3)
>X#
>X########################################################################
>X#
>X#  Copyright (c) 1990, Richard L. Goerwitz, III
>X#
>X#  This software is intended for free and unrestricted distribution.
>X#  I place only two conditions on its use:  1) That you clearly mark
>X#  any additions or changes you make to the source code, and 2) that
>X#  you do not delete this message therefrom.  In order to protect
>X#  myself from spurious litigation, it must also be stated here that,
>X#  because this is free software, I, Richard Goerwitz, make no claim
>X#  about the applicability or fitness of this software for any
>X#  purpose, and expressly disclaim any responsibility for any damages
>X#  that might be incurred in conjunction with its use.
>X#
>X########################################################################
>X#
>X#  The following library represents a series of rough functional
>X#  equivalents to the standard Unix low-level termcap routines.  They
>X#  are not meant as exact termlib clones.  Nor are they enhanced to
>X#  take care of magic cookie terminals, terminals that use \D in their
>X#  termcap entries, or, in short, anything I felt would not affect my
>X#  normal, day-to-day work with ANSI and vt100 terminals.
>X#
>X#  Requires:  A unix platform & co-expressions.  Certainly the
>X#  package could be altered for use with MS-DOS and other systems.
>X#  Please contact me if advice on how to do this is needed.
>X#
>X#  setname(term)
>X#    Use only if you wish to initialize itermlib for a terminal
>X#  other than what your current environment specifies.  "Term" is the
>X#  name of the termcap entry to use.  Normally this initialization is
>X#  done automatically, and need not concern the user.
>X#
>X#  getval(id)
>X#    Works something like tgetnum, tgetflag, and tgetstr.  In the
>X#  spirit of Icon, all three have been collapsed into one routine.
>X#  Integer valued caps are returned as integers, strings as strings,
>X#  and flags as records (if a flag is set, then type(flag) will return
>X#  "true").  Absence of a given capability is signalled by procedure
>X#  failure.
>X#
>X#  igoto(cm,destcol,destline) - NB:  default 1 offset (*not* zero)!
>X#    Analogous to tgoto.  "Cm" is the cursor movement command for
>X#  the current terminal, as obtained via getval("cm").  Igoto()
>X#  returns a string which, when output via iputs, will cause the
>X#  cursor to move to column "destcol" and line "destline."  Column and
>X#  line are always calculated using a *one* offset.  This is far more
>X#  Iconish than the normal zero offset used by tgoto.  If you want to
>X#  go to the first square on your screen, then input
>X#  "igoto(getval("cm"),1,1)."
>X#
>X#  iputs(cp,affcnt)
>X#    Equivalent to tputs.  "Cp" is a string obtained via getval(),
>X#  or, in the case of "cm," via igoto(getval("cm"),x,y).  Affcnt is a
>X#  count of affected lines.  It is only relevant for terminals which
>X#  specify proportional (starred) delays in their termcap entries.
>X#
>X##########################################################################
>X
>X
>Xglobal tc_table, tty_speed
>Xrecord true()
>X
>X
>Xprocedure check_features()
>X
>X    local in_params, yes_tabs, line
>X    # global tty_speed
>X
>X    initial {
>X    find("unix",map(&features)) |
>X        er("check_features","unix system required",1)
>X    find("o-expres",&features) |
>X        er("check_features","co-expressions not implemented - &$#!",1)
>X    system("/bin/stty tabs") |
>X        er("check_features","can't set tabs option",1)
>X    }
>X
>X    # clumsy, clumsy, clumsy, and probably won't work on all systems
>X    in_params := open("/bin/stty 2>&1","pr") |
>X    (ospeed := &null, fail)
>X    every line := !in_params do {
>X    yes_tabs := find("tabs",line)
>X    line ? {
>X        tty_speed := (tab(find("speed")+5), tab(many(' ')),
>X               integer(tab(many(&digits))))
>X    }
>X    }
>X    close(in_params)
>X    return "term characteristics reset; features check out"
>X
>Xend
>X
>X
>X
>Xprocedure setname(name)
>X
>X    # Sets current terminal type to "name" and builds a new termcap
>X    # capability database (residing in tc_table).  Fails if unable to
>X    # find a termcap entry for terminal type "name."  If you want it
>X    # to terminate with an error message under these circumstances,
>X    # comment out "| fail" below, and uncomment the er() line.
>X
>X    #tc_table is global
>X
>X    check_features()
>X
>X    tc_table := maketc_table(getentry(name)) | fail
>X    # er("setname","no termcap entry found for "||name,3)
>X    return "successfully reset for terminal " || name
>X
>Xend
>X
>X
>X
>Xprocedure getname()
>X
>X    # Getname() first checks to be sure we're running under Unix, and,
>X    # if so, tries to figure out what the current terminal type is,
>X    # checking successively the value of the environment variable
>X    # TERM, and then the output of "tset -".  Terminates with an error
>X    # message if the terminal type cannot be ascertained.
>X
>X    local term, tset_output
>X
>X    check_features()
>X
>X    if not (term := getenv("TERM")) then {
>X    tset_output := open("/bin/tset -","pr") |
>X        er("getname","can't find tset command",1)
>X    term := !tset_output
>X    close(tset_output)
>X    }
>X    return \term |
>X    er("getname","can't seem to determine your terminal type",1)
>X
>Xend
>X
>X
>X
>Xprocedure er(func,msg,errnum)
>X
>X    # short error processing utility
>X    write(&errout,func,":  ",msg)
>X    exit(errnum)
>X
>Xend
>X
>X
>X
>Xprocedure getentry(name)
>X
>X    # "Name" designates the current terminal type.  Getentry() scans
>X    # the current environment for the variable TERMCAP.  If the
>X    # TERMCAP string represents a termcap entry for a terminal of type
>X    # "name," then getentry() returns the TERMCAP string.  Otherwise,
>X    # getentry() will check to see if TERMCAP is a file name.  If so,
>X    # getentry() will scan that file for an entry corresponding to
>X    # "name."  If the TERMCAP string does not designate a filename,
>X    # getentry() will scan /etc/termcap for the correct entry.
>X    # Whatever the input file, if an entry for terminal "name" is
>X    # found, getentry() returns that entry.  Otherwise, getentry()
>X    # fails.
>X
>X    local termcap_string, f, getline, line, nm, ent1, ent2
>X
>X    termcap_string := getenv("TERMCAP")
>X
>X    if \termcap_string ? (not match("/"), pos(0) | tab(find("|")+1), =name)
>X    then return termcap_string
>X    else {
>X
>X    if find("/",\termcap_string)
>SHAR_EOF
>echo "End of  part 1"
>echo "File itlib.icn is continued in part 2"
>echo "2" > shar3_seq_.tmp
>exit 0
>
>   -Richard L. Goerwitz              [e-mail]
>   [e-mail]         rutgers!oddjob!gide!sophist!goer

---- Cut Here and unpack ----
#!/bin/sh
# this is hebcalen.03 (part 3 of a multipart archive)
# do not concatenate these parts, unpack them in order with /bin/sh
# file cal.text continued
#
if test ! -r shar3_seq_.tmp; then
    echo "Please unpack part 1 first!"
    exit 1
fi
(read Scheck
 if test "$Scheck" != 3; then
    echo "Please unpack part $Scheck next!"
    exit 1
 else
    exit 0
 fi
) < shar3_seq_.tmp || exit 1
echo "x - Continuing file cal.text"
sed 's/^X//' << 'SHAR_EOF' >> cal.text &&
X  write(repl(" ",7),"S",repl(" ",2),"M",repl(" ",2),"T",repl(" ",2),"W",
X        repl(" ",2),"T",repl(" ",2),"F",repl(" ",2),"\e[7mS\e[0m",repl(" ",27),
X        "S",repl(" ",2),"M",repl(" ",2),"T",repl(" ",2),"W",
X        repl(" ",2),"T",repl(" ",2),"F",repl(" ",2),"\e[7mS\e[0m")
Xend
X
Xprocedure write_a_month()
X#writes a month on the screen
X  header()
X  every 1 to 5 do
X    write(make_a_line())
X  if jyr.day ~= 1 then
X    write(make_a_line())
X  write()
Xreturn
Xend
X
Xprocedure status_line(a,b)
X#create the status line at the bottom of screen
Xlocal sline,c,d
X  c := cyr.yr
X  if (cyr.day = 1) & (cyr.mth = 1) then c -:= 1
X  d := 365
X  if isleap(c) then d := 366
X#if ANSI not available omit "\e[7m" and "|| "\e[0m""
X  sline := ("\e[7mYear of Creation: " || a || "  Days in year: " || b ||
X    "  Civil year: " || c || "  Days in year: " || d || "\e[0m")
Xreturn sline
Xend
X
Xprocedure make_a_line()
X#make a single line of the months
Xlocal line,blanks1,blanks2,start_point,end_point,flag,fm
X
X#consider the first line of the month
X  if jyr.day = 1 then {
X    line := mth_table(jyr.mth,1)
X#setting flag means insert civil month at end of line
X    flag := 1 } else
X    line := repl(" ",3)
X#consider the case where first day of civil month is on Sunday
X  if (cyr.day = 1) & (current_day = 1) then flag := 1
X#space between month name and beginning of calendar
X  line ||:= repl(" ",2)
X#measure indentation for first line
X  line ||:= blanks1 := repl(" ",3*(current_day-1))
X#establish start point for Hebrew loop
X  start_point := current_day
X#establish end point for Hebrew loop and run civil loop
X  every end_point := start_point to 7 do {
X    line ||:= right(jyr.day,3)
X    if not j_augment() then {jyr_augment(); establish_jyr(); current_day -:= 1; if current_day = 0 then current_day := 7}
X    d_augment()
X    if jyr.day = 1 then break }
X#measure indentation for last line
X  blanks2 := repl(" ",3*(7-end_point))
X  line ||:= blanks2; line ||:= repl(" ",25); line ||:= blanks1
X  every start_point to end_point do {
X    line ||:= right(cyr.day,3)
X    if (cyr.day = 1) then flag := 1
X    augment()}
X  line ||:= blanks2 ||:= repl(" ",3)
X  fm := cyr.mth
X  if cyr.day = 1 then
X    if cyr.mth = 1 then fm := 12 else fm := cyr.mth - 1
X  if \flag then line ||:= mth_table(fm,2) else
X    line ||:= repl(" ",3)
Xreturn line
Xend
X
Xprocedure mth_table(n,p)
X#generates the short names of Jewish and Civil months. Get to civil side
X#by adding 13 (=max no of Jewish months)
Xstatic corresp
Xinitial corresp := ["NIS","IYA","SIV","TAM","AV ","ELU","TIS","HES","KIS",
X"TEV","SHE","ADA","AD2","JAN","FEB","MAR","APR","MAY","JUN","JUL","AUG","SEP",
X"OCT","NOV","DEC"]
X  if (p ~= 1) & (p ~= 2) then stop("ERROR IN MTH-TABLE") else
X    if p = 2 then n +:= 13
Xreturn corresp[n]
Xend
X
Xprocedure d_augment()
X#increment the day of the week
X  current_day +:= 1
X  if current_day = 8 then current_day := 1
Xreturn
Xend
X
Xprocedure augment()
X#increments civil day, modifies month and year if necessary, stores in
X#global variable cyr
X  if cyr.day < 28 then
X    cyr.day +:= 1 else
X  if cyr.day = 28 then {
X    if (cyr.mth ~= 2) | ((cyr.mth = 2) & isleap(cyr.yr)) then
X      cyr.day := 29 else {
X        cyr.mth := 3
X    cyr.day  := 1}} else
X  if cyr.day = 29 then {
X    if cyr.mth ~= 2 then
X      cyr.day := 30 else {
X      cyr.mth := 3
X      cyr.day := 1}} else
X  if cyr.day = 30 then {
X    if is_31(cyr.mth) then
X      cyr.day := 31 else {
X      cyr.mth +:= 1
X      cyr.day := 1}} else {
X      cyr.day := 1
X      if cyr.mth ~= 12 then
X        cyr.mth +:= 1 else {
X        cyr.mth := 1
X        cyr.yr +:= 1
X        if cyr.yr = 0
X      then cyr.yr := 1}}
Xreturn
Xend
X
Xprocedure is_31(n)
X#civil months with 31 days
Xreturn n = 1 | n = 3 | n = 5 | n = 7 | n = 8 | n = 10 | n = 12
Xend
X
Xprocedure isleap(n)
X#checks for civil leap year
X  if n > 0 then
Xreturn (n % 400 = 0) | ((n % 4 = 0) & (n % 100 ~= 0)) else
Xreturn (n % 400 = -1) | ((n % 4 = -1) & (n % 100 ~= -1))
Xend
X
Xprocedure j_augment()
X#increments jewish day. months are numbered from nisan, adar sheni is 13.
X#procedure fails at elul to allow determination of type of new year
X  if jyr.day < 29 then
X    jyr.day +:= 1 else
X  if (jyr.day = 30) | always_29(jyr.mth) | ((jyr.mth = 8) &
X    (days_in_jyr % 5 ~= 0)) | ((jyr.mth = 9) & ((days_in_jyr = 353) |
X    (days_in_jyr = 383))) then
X    jyr.mth +:= jyr.day := 1 else
X  if jyr.mth = 6 then fail else
X  if ((jyr.mth = 12) & (days_in_jyr < 383)) | (jyr.mth = 13) then
X    jyr.mth := jyr.day := 1 else
X  jyr.day := 30
Xreturn
Xend
X
Xprocedure always_29(n)
X#uncomplicated jewish months with 29 days
Xreturn n = 2 | n = 4 | n = 10
Xend
X
Xprocedure jyr_augment()
X#determines the current time of lunation, using the ancient babylonian unit
X#of 1/1080 of an hour. lunation of tishri determines type of year. allows
X#for leap year. halaqim = parts of the hour
Xlocal days, halaqim
X  days := current_molad.day + 4
X  if days_in_jyr <= 355 then {
X    halaqim :=  current_molad.halaqim + 9516
X    days := ((days +:= halaqim / 25920) % 7)
X    if days = 0 then days := 7
X    halaqim := halaqim % 25920} else {
X    days +:= 1
X    halaqim := current_molad.halaqim + 23269
X    days := ((days +:= halaqim / 25920) % 7)
X    if days = 0 then days := 7
X    halaqim := halaqim % 25920}
X  current_molad.day := days
X  current_molad.halaqim := halaqim
X#reset the global variable which holds the current jewish date
X  jyr.yr +:= 1 #increment year
X  jyr.day := 1
X  jyr.mth := 7
X  establish_jyr()
Xreturn
Xend
X
Xprocedure establish_jyr()
X#establish the jewish year from get_rh
Xlocal res
X  res := get_rh(current_molad.day,current_molad.halaqim,no_lunar_yr(jyr.yr))
X  days_in_jyr := res[2]
X  current_day := res[1]
Xreturn
Xend
X
Xprocedure isin1(i)
X#the isin procedures are sets of years in the Metonic cycle
Xreturn i = (1 | 4 | 7 | 9 | 12 | 15 | 18)
Xend
X
Xprocedure isin2(i)
Xreturn i = (2 | 5 | 10 | 13 | 16)
Xend
X
Xprocedure isin3(i)
Xreturn i = (3 | 6 | 8 | 11 | 14 | 17 | 0)
Xend
X
Xprocedure isin4(i)
Xreturn i = (1 | 2 | 4 | 5 | 7 | 9 | 10 | 12 | 13 | 15 | 16 | 18)
Xend
X
Xprocedure isin5(i)
Xreturn i = (1 | 4 | 9 | 12 | 15)
Xend
X
Xprocedure isin6(i)
Xreturn i = (2 | 5 | 7 | 10 | 13 | 16 | 18)
Xend
X
Xprocedure no_lunar_yr(i)
X#what year in the metonic cycle is it?
Xreturn i % 19
Xend
X
Xprocedure get_rh(d,h,yr)
X#this is the heart of the program. check the day of lunation of tishri
X#and determine where breakpoint is that sets the new moon day in parts
X#of the hour. return result in a list where 1 is day of rosh hashana and
X#2 is length of jewish year
Xlocal c,result
X  c := no_lunar_yr(yr)
X  result := list(2)
X  if d = 1 then {
X          result[1] := 2
X                if (h < 9924) & isin4(c) then result[2] := 353 else
X        if (h < 22091) & isin3(c) then result[2] := 383 else
X        if (h > 9923) & (isin1(c) | isin2(c)) then result[2] := 355 else
X        if (h > 22090) & isin3(c) then result[2] := 385
X        } else
X  if d = 2 then {
X          if ((h < 16789) & isin1(c)) |
X           ((h < 19440) & isin2(c)) then {
X                                 result[1] := 2
X                             result[2] := 355
X                             } else
X        if (h < 19440) & isin3(c) then  {
X                                 result[1] := 2
X                             result[2] := 385
X                             } else
X          if ((h > 16788) & isin1(c)) |
X           ((h > 19439) & isin2(c)) then {
X                                 result[1] := 3
X                             result[2] := 354
X                             } else
X                if (h > 19439) & isin3(c) then  {
X                                 result[1] := 3
X                             result[2] := 384
X                             }
X        } else
X  if d = 3 then {
X          if (h < 9924) & (isin1(c) | isin2(c)) then {
X                               result[1] := 3
X                               result[2] := 354
X                               } else
X        if (h < 19440) & isin3(c) then {
X                           result[1] := 3
X                           result[2] := 384
X                           } else
X        if (h > 9923) & isin4(c) then {
X                          result[1] := 5
X                          result[2] := 354
X                          } else
X        if (h > 19439) & isin3(c) then {
X                           result[1] := 5
X                           result[2] := 383}
X        } else
X  if d = 4 then {
X          result[1] := 5
X        if isin4(c) then result[2] := 354 else
X        if h < 12575 then result[2] := 383 else
X        result[2] := 385
X        } else
X  if d = 5 then {
X                if (h < 9924) & isin4(c) then {
X                          result[1] := 5
X                          result[2] := 354} else
X        if (h < 19440) & isin3(c) then {
X                           result[1] := 5
X                           result[2] := 385
X                           } else
X        if (9923 < h < 19440) & isin4(c) then {
X                              result[1] := 5
X                              result[2] := 355
X                              } else
X        if h > 19439 then {
X                    result[1] := 7
X                          if isin3(c) then result[2] := 383 else
X                            result[2] := 353
X                  }
X        } else
X  if d = 6 then {
X            result[1] := 7
X            if ((h < 408) & isin5(c)) | ((h < 9924) & isin6(c)) then
X                              result[2] := 353 else
X            if ((h < 22091) & isin3(c)) then result[2] := 383 else
X            if ((h > 407) & isin5(c)) | ((h > 9923) & isin6(c)) then
X                              result[2] := 355 else
X            if (h > 22090) & isin3(c) then result[2] := 385
X            } else
X  if d = 7 then    if (h < 19440) & (isin5(c) | isin6(c)) then {
X                              result[1] := 7
X                              result[2] := 355
X                              } else
X        if (h < 19440) & isin3(c) then {
X                           result[1] := 7
X                           result[2] := 385
X                           } else {
X                                  result[1] := 2
X                              if isin4(c) then
X                                result[2] := 353 else
X                            result[2] := 383}
Xreturn result
Xend
X
X
X#If the following help file doesnt quite look right try throwing in a
X#few blank lines here or there, or take them out.
X#End of section one------------CUT HERE----------------------------------
X
XThis program accepts a year of the Jewish calendar, for example
X"5750", and produces on the screen a calendar of that year with a
Xvisually equivalent civil calendar opposite it for easy conversion of
Xdates. The months of the civil year are abbreviated to
X
XJAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC
X
Xand of the Jewish calendar to
X
XNIS IYA SIV TAM AV ELU TIS HES KIS TEV SHE ADA AD2.
X
XMonths are normally displayed three at a time. You call up the next
Xthree by hitting return. At the end of the year you can indicate if
Xyou wish the program to conclude, by hitting return again. If in
Xresponse to the question, Do you wish to continue? you enter "y" and
Xhit return, the next year will be displayed.
X
XEach Jewish month has its name on the left. The corresponding secular
Xdates will have the name of the month on the right, and when the month
Xchanges it will be indicated on the right also.
X
X
X
X
XIf you wish, you may enter a civil year in the form -70 for BCE dates
Xand +70 for CE dates. The Jewish year beginning prior to Jan 1 of that
Xyear will be displayed, and you can continue with the next Jewish year
Xif you wish to complete the desired civil year.
X
XYou may enter CE or AD instead of + or BC or BCE instead of the minus
Xsign if you wish. It is best to avoid spaces, so enter 1987AD, for
Xexample.
X
XThe year 0 is not meaningful in either calendar. No date prior to 1
Xin the Jewish calendar should be entered. The program will calculate
Xany future year, but will take longer for years much beyond the year
X6020 in the Jewish reckoning. For example, the year 7000 will take
Xthree minutes or so to appear. Earlier years should appear in a few
Xseconds.
X
XA status line at the bottom of the screen indicates the civil and
XJewish year, and the number of days in each. Jewish years may contain
X354, 355, 356, 384, 385 or 386 days according to circumstances.
X
X
X
X
XWhen you are familiar with this program you can enter the years you
Xwish to see on the command line. For example, if you call the program
X           iconx calendar 5704 +1987 1BC
Xyou will see in turn the Jewish year 5704, the Jewish year commencing
Xin 1986 and the Jewish year commencing in 2 B.C.E. You still have the
Xoption of seeing the years subsequent to these years if you wish. Just
Xenter "y" when asked if you want to continue. When you enter "n", you
Xwill get the next year of your list.
X
XAll civil dates are according to the Gregorian Calendar which first
Xcame into use in 1582 and was accepted in different places at
Xdifferent times. Prior to that date the Julian calendar was in use. At
Xthe present time the Julian calendar is 13 days behind the Gregorian
XCalendar, so that March 15 1917 in our reckoning is March 2 in the
XJulian Calendar. The following table shows the number of days that
Xmust be subtracted from the Gregorian date given here to find the Julian
Xdate. In the early centuries of this table and before the calendar was
Xintercalated erratically, so a simple subtraction is not possible. Note that
Xthe change in the number to subtract applies from March 1 in the century
Xyear, since in the Julian Calendar that will be February 29 except in years
Xdivisible by 400 which are leap years in the Gregorian calendar also.
X
XCentury        # to subtract        Century        # to subtract
X  21            13          11            6
X  20            13          10            5
X  19            12           9            4
X  18            11           8            4
X  17            10           7            3
X  16            10           6            2
X  15             9           5            1
X  14             8           4            1
X  13             7           3            0
X  12             7           2               -1
X                         1               -2
X#End of section two-----------CUT HERE----------------------------------
X3%8255%8%20%-3762%384
X4%23479%9%8%-3742%354
X4%24950%8%28%-3722%354
X5%501%8%17%-3702%385
X6%15725%9%6%-3682%355
X6%17196%8%26%-3662%355
X6%18667%8%15%-3642%383
X1%7971%9%3%-3622%353
X1%9442%8%23%-3602%383
X2%24666%9%10%-3582%354
X3%217%8%30%-3562%354
X3%1688%8%19%-3542%384
X4%16912%9%7%-3522%354
X4%18383%8%27%-3502%354
X4%19854%8%17%-3482%385
X6%9158%9%5%-3462%355
X6%10629%8%25%-3442%355
X6%12100%8%14%-3422%383
X1%1404%9%2%-3402%353
X1%2875%8%23%-3382%383
X2%18099%9%10%-3362%354
X2%19570%8%30%-3342%354
X2%21041%8%19%-3322%384
X4%10345%9%7%-3302%354
X4%11816%8%28%-3282%354
X4%13287%8%17%-3262%385
X6%2591%9%5%-3242%353
X6%4062%8%25%-3222%383
X7%19286%9%11%-3202%355
X7%20757%9%2%-3182%353
X7%22228%8%22%-3162%383
X2%11532%9%8%-3142%355
X2%13003%8%28%-3122%355
X2%14474%8%17%-3102%385
X4%3778%9%7%-3082%354
X4%5249%8%27%-3062%354
X4%6720%8%16%-3042%383
X5%21944%9%4%-3022%353
X5%23415%8%24%-3002%383
X7%12719%9%11%-2982%355
X7%14190%8%31%-2962%355
X7%15661%8%20%-2942%385
X2%4965%9%8%-2922%355
X2%6436%8%28%-2902%355
X2%7907%8%18%-2882%385
X3%23131%9%7%-2862%354
X3%24602%8%27%-2842%383
X5%13906%9%13%-2822%355
X5%15377%9%2%-2802%355
X5%16848%8%22%-2782%385
X7%6152%9%10%-2762%355
X7%7623%8%30%-2742%355
X7%9094%8%19%-2722%385
X1%24318%9%7%-2702%355
X1%25789%8%28%-2682%355
X2%1340%8%17%-2662%385
X3%16564%9%6%-2642%354
X3%18035%8%24%-2622%384
X5%7339%9%12%-2602%354
X5%8810%9%2%-2582%354
X5%10281%8%22%-2562%385
X6%25505%9%10%-2542%355
X7%1056%8%30%-2522%355
X7%2527%8%19%-2502%385
X1%17751%9%8%-2482%355
X1%19222%8%28%-2462%383
X3%8526%9%15%-2442%354
X3%9997%9%6%-2422%354
X3%11468%8%24%-2402%384
X5%772%9%12%-2382%354
X5%2243%9%1%-2362%354
X5%3714%8%21%-2342%385
X6%18938%9%9%-2322%355
X6%20409%8%29%-2302%355
X6%21880%8%19%-2282%383
X1%11184%9%7%-2262%355
X1%12655%8%27%-2242%383
X3%1959%9%14%-2222%354
X3%3430%9%3%-2202%354
X3%4901%8%24%-2182%384
X4%20125%9%12%-2162%354
X4%21596%9%1%-2142%354
X4%23067%8%21%-2122%385
X6%12371%9%9%-2102%355
X6%13842%8%30%-2082%383
X1%3146%9%18%-2062%353
X1%4617%9%7%-2042%353
X1%6088%8%27%-2022%383
X2%21312%9%14%-2002%354
X2%22783%9%3%-1982%354
X2%24254%8%23%-1962%384
X4%13558%9%11%-1942%354
X4%15029%8%31%-1922%354
X4%16500%8%20%-1902%385
X6%5804%9%9%-1882%353
X6%7275%8%29%-1862%383
X7%22499%9%17%-1842%353
X7%23970%9%6%-1822%353
X7%25441%8%26%-1802%383
X2%14745%9%13%-1782%355
X2%16216%9%2%-1762%355
X2%17687%8%22%-1742%385
X4%6991%9%11%-1722%354
X4%8462%8%31%-1702%383
X5%23686%9%20%-1682%353
X5%25157%9%9%-1662%353
X6%708%8%29%-1642%383
X7%15932%9%15%-1622%355
X7%17403%9%4%-1602%355
X7%18874%8%24%-1582%385
X2%8178%9%12%-1562%355
X2%9649%9%1%-1542%355
X2%11120%8%21%-1522%385
X4%424%9%10%-1502%354
X4%1895%8%31%-1482%383
X5%17119%9%17%-1462%355
X5%18590%9%6%-1442%355
X5%20061%8%28%-1422%383
X7%9365%9%14%-1402%355
X7%10836%9%4%-1382%355
X7%12307%8%24%-1362%385
X2%1611%9%12%-1342%355
X2%3082%9%1%-1322%385
X3%18306%9%21%-1302%354
X3%19777%9%11%-1282%354
X3%21248%8%31%-1262%383
X5%10552%9%17%-1242%355
X5%12023%9%6%-1222%355
X5%13494%8%26%-1202%385
X7%2798%9%14%-1182%355
X7%4269%9%3%-1162%355
X7%5740%8%23%-1142%385
X1%20964%9%11%-1122%355
X1%22435%8%31%-1102%385
X3%11739%9%21%-1082%354
X3%13210%9%10%-1062%354
X3%14681%8%28%-1042%384
X5%3985%9%16%-1022%354
X5%5456%9%5%-1002%354
X5%6927%8%26%-982%385
X6%22151%9%14%-962%355
X6%23622%9%3%-942%385
X1%12926%9%22%-922%355
X1%14397%9%11%-902%355
X1%15868%9%1%-882%383
X3%5172%9%19%-862%354
X3%6643%9%8%-842%354
X3%8114%8%28%-822%384
X4%23338%9%16%-802%354
X4%24809%9%5%-782%354
X5%360%8%25%-762%385
X6%15584%9%13%-742%355
X6%17055%9%2%-722%383
X1%6359%9%21%-702%353
X1%7830%9%11%-682%353
X1%9301%8%31%-662%383
X2%24525%9%18%-642%354
X3%76%9%7%-622%354
X3%1547%8%27%-602%384
X4%16771%9%16%-582%354
X4%18242%9%5%-562%385
X6%7546%9%24%-542%355
X6%9017%9%13%-522%353
X6%10488%9%2%-502%383
X7%25712%9%22%-482%353
X1%1263%9%11%-462%353
X1%2734%8%31%-442%383
X2%17958%9%18%-422%354
X2%19429%9%6%-402%355
X2%20900%8%27%-382%384
X4%10204%9%15%-362%354
X4%11675%9%4%-342%383
X6%979%9%23%-322%355
X6%2450%9%12%-302%353
X6%3921%9%2%-282%383
X7%19145%9%19%-262%355
X7%20616%9%10%-242%353
X7%22087%8%30%-222%383
X2%11391%9%16%-202%355
X2%12862%9%6%-182%385
X4%2166%9%26%-162%354
X4%3637%9%15%-142%354
X4%5108%9%4%-122%383
X5%20332%9%23%-102%353
X5%21803%9%13%-82%353
X5%23274%9%2%-62%383
X7%12578%9%19%-42%355
X7%14049%9%8%-22%355
X7%15520%8%28%-2%385
X2%4824%9%16%19%355
X2%6295%9%5%39%385
X3%21519%9%25%59%354
X3%22990%9%14%79%354
X3%24461%9%3%99%383
X5%13765%9%21%119%355
X5%15236%9%10%139%355
X5%16707%8%30%159%385
X7%6011%9%18%179%355
X7%7482%9%7%199%385
X1%22706%9%27%219%355
X1%24177%9%16%239%355
X1%25648%9%5%259%385
X3%14952%9%25%279%354
X3%16423%9%14%299%354
X3%17894%9%2%319%384
X5%7198%9%21%339%354
X5%8669%9%10%359%354
X5%10140%8%30%379%385
X6%25364%9%18%399%355
X7%915%9%7%419%385
X1%16139%9%26%439%355
X1%17610%9%15%459%355
X1%19081%9%4%479%383
X3%8385%9%22%499%354
X3%9856%9%12%519%354
X3%11327%9%1%539%384
X5%631%9%20%559%354
X5%2102%9%9%579%385
X6%17326%9%28%599%355
X6%18797%9%18%619%355
X6%20268%9%7%639%383
X1%9572%9%26%659%353
X1%11043%9%15%679%355
X1%12514%9%4%699%383
X3%1818%9%23%719%354
X3%3289%9%12%739%354
X3%4760%9%1%759%384
X4%19984%9%20%779%354
X4%21455%9%9%799%385
X6%10759%9%28%819%355
X6%12230%9%17%839%355
X6%13701%9%6%859%383
X1%3005%9%25%879%353
X1%4476%9%14%899%353
X1%5947%9%4%919%383
X2%21171%9%22%939%354
X2%22642%9%11%959%384
X4%11946%9%30%979%354
X4%13417%9%19%999%354
X4%14888%9%9%1019%385
X6%4192%9%28%1039%355
X6%5663%9%17%1059%353
X6%7134%9%6%1079%383
X7%22358%9%25%1099%353
X7%23829%9%15%1119%353
X7%25300%9%4%1139%383
X2%14604%9%21%1159%355
X2%16075%9%10%1179%385
X4%5379%9%30%1199%354
X4%6850%9%19%1219%354
X4%8321%9%8%1239%383
X5%23545%9%27%1259%353
X5%25016%9%16%1279%353
X6%567%9%5%1299%383
X7%15791%9%23%1319%355
X7%17262%9%12%1339%385
X2%6566%10%1%1359%355
X2%8037%9%20%1379%355
X2%9508%9%9%1399%385
X3%24732%9%30%1419%354
X4%283%9%19%1439%354
X4%1754%9%8%1459%383
X5%16978%9%25%1479%355
X5%18449%9%14%1499%355
X5%19920%9%6%1519%383
X7%9224%9%23%1539%355
X7%10695%9%12%1559%385
X1%25919%10%1%1579%355
X2%1470%9%20%1599%355
X2%2941%9%9%1619%385
X3%18165%9%29%1639%354
X3%19636%9%18%1659%354
X3%21107%9%7%1679%383
X5%10411%9%24%1699%355
X5%11882%9%14%1719%385
X7%1186%10%3%1739%355
X7%2657%9%22%1759%355
X7%4128%9%11%1779%385
X1%19352%9%30%1799%355
X1%20823%9%20%1819%355
X1%22294%9%9%1839%385
X3%11598%9%29%1859%354
X3%13069%9%18%1879%354
X3%14540%9%5%1899%384
X5%3844%9%25%1919%354
X5%5315%9%14%1939%385
X6%20539%10%3%1959%355
X6%22010%9%22%1979%355
X6%23481%9%11%1999%385
X1%12785%9%30%2019%355
X1%14256%9%19%2039%355
X1%15727%9%8%2059%383
X3%5031%9%26%2079%354
X3%6502%9%15%2099%384
X4%21726%10%5%2119%354
X4%23197%9%24%2139%354
X4%24668%9%13%2159%385
X6%13972%10%2%2179%355
X6%15443%9%21%2199%355
X6%16914%9%11%2219%383
X1%6218%9%30%2239%353
X
X
X
SHAR_EOF
echo "File cal.text is complete" &&
rm -f shar3_seq_.tmp
echo "You have unpacked the last part"
exit 0

   -Richard L. Goerwitz              [e-mail]
   [e-mail]         rutgers!oddjob!gide!sophist!goer