v17i059: hebcalen - jewish/civil calendar, Part01/02

Richard L. Goerwitz goer at sophist.uchicago.edu
Wed Mar 20 11:39:29 AEST 1991


Submitted-by: Richard L. Goerwitz <goer at sophist.uchicago.edu>
Posting-number: Volume 17, Issue 59
Archive-name: hebcalen/part01

function:  displays both Jewish and Gregorian calendars in parallel
source language:  icon

Many people who read the Bible don't realize that at least three
dating systems are represented there.  There is the old Canaanite
system, represented in month names like Abib, Ziv, Ethnaim, etc.
Then there is the method (most common) of simply calling the months
by their ordinal value (the first, second, third, etc. month).  Fi-
nally, there is the Babylonian system, represented in books such as
Esther, Nehemiah, and Zechariah.  This Babylonian system, inciden-
tally, stretches back into the third and second century B.C. Akka-
dian/Sumerian religions and cultural milieu.

Anyway, Jews today still use the modified Babylonian month names, in
contradistinction to the West, which is pretty much governed by an
offshoot of the old Roman calendar, with added reforms (particularly
by Pope Gregory XIII).  Jews also place year 1 at a different point
than does the Gregorian calendar (which is based on the traditional
dating of the birth of Jesus Christ).

The following shell archive offers a simple disply of Jewish and
Civil calendars, in parallel columns, using either dating system
and either calendar's starting-point.  It was originally written in
Icon for MS-DOS by Alan Corre, but I figured that there would be
many Unix users who, for historical, religious, cultural, or what-
ever other reasons, might want such a calendar online.  This ar-
chive contains both my Unix port, and Alan Corre's original MS-DOS
code.

Enjoy.

-Richard Goerwitz (goer at sophist.uchicago.edu)
----
#! /bin/sh
# This is a shell archive.  Remove anything before this line, then feed it
# into a shell via "sh file" or similar.  To overwrite existing files,
# type "sh file -c".
# The tool that generated this appeared in the comp.sources.unix newsgroup;
# send mail to comp-sources-unix at uunet.uu.net if you want that tool.
# Contents:  README cal.text iolib.icn
# Wrapped by kent at sparky on Tue Mar 19 19:30:43 1991
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
echo If this archive is complete, you will see the following message:
echo '          "shar: End of archive 1 (of 2)."'
if test -f 'README' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'README'\"
else
  echo shar: Extracting \"'README'\" \(3027 characters\)
  sed "s/^X//" >'README' <<'END_OF_FILE'
X----
X
Xprogram name: hebcalen
Xpurpose: display parallel Jewish/Civil calendar for arbitrary dates
Xsource language: icon
X
X----
X
XFor the bold in heart:  Type in "cp Makefile.dist Makefile; make" and
Xwatch the sparks fly.  When done, type "hebcalen."  If you are satis-
Xfied that it works, exit, then su root, and then type "make install."
XIf you can't su root, pick some other place to install, and change the
Xvalue of DATA_DIR in the Makefile to reflect the place you have chosen.
XRemember to set ownership and mode conventions to their appropriate
Xvalues as per the instructions in the Makefile.
X
XNote:  If your system has an stty command that can't write to a pipe
Xor socket, or which lacks a -g option, you'll need to alter the ITLIB
Xline in the makefile.
X
X----
X
XThis archive contains a test Unix port of Alan Corre's Jewish/Civil
Xcalendar for MS-DOS.  My changes to his code are extensive, and yet
Xmundane.  Mainly I just rewrote the input/output routines so that they
Xwould be portable in a Unix environment, and would work with all the
Xnon-cookie terminals I have access to (e.g. VT100, ANSI, IBM 3101).  In
Xparticular, I made sure to eliminate all assumptions about terminal
Xlength, width, and ability to display standout and/or underline modes.
XI also removed all characters which would require an unsigned internal
Xrepresentation (i.e. 8-bits).
X
XProbably the only really substantial changes I made were to add some
Xconvenient defaults.  For instance, if you press CR at the
Xinstructions prompt, you'll move on automatically to the year prompt.
XIf you press CR at the year prompt, hebcalen assumes that you want the
Xcurrent civil year.  Most of the prompts let you type "q" if you want
Xto quit at that point.  Another added default is a search mechanism
Xfor data files.  As long as the hebcalen data files are in your path,
Xyou no longer need to have them in the current directory when hebcalen
Xis invoked.  These changes represent mere conveniences, and do not
Xalter the substance of the original distribution.
X
XFrom a packaging standpoint, the original calendar program has been
Xtotally redone.  The original single file has been broken down into
Xits constituent parts, and renamed "hebcalen" so as to avoid naming
Xconflicts with tickler programs extant on many Unix systems.  I've
Xalso added a Makefile to ease the pains of installation and
Xmaintenance.  Just rename or copy Makefile.dist to Makefile, type
X"make," and then give the program a few trial runs.  When satisfied it
Xworks fine, then type "make install."  Make sure, before you do this,
Xthat you edit the makefile to reflect your local file structure.
X
XThe original distribution is included as cal.text.  Please keep it
Xaround if you plan to do any hacking, or even perusal of the code.
XIt's a nice piece of work.
X
XMany, many thanks to Alan Corre for a well-written and useful contri-
Xbution to the Icon community's code pool.
X
X
X   -Richard L. Goerwitz          goer%sophist at uchicago.bitnet
X   goer at sophist.uchicago.edu     rutgers!oddjob!gide!sophist!goer
END_OF_FILE
  if test 3027 -ne `wc -c <'README'`; then
    echo shar: \"'README'\" unpacked with wrong size!
  fi
  # end of 'README'
fi
if test -f 'cal.text' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'cal.text'\"
else
  echo shar: Extracting \"'cal.text'\" \(29360 characters\)
  sed "s/^X//" >'cal.text' <<'END_OF_FILE'
X#
X# This is the original calendar distribution for MS-DOS, as written
X# and packaged by Alan D. Corre.  Many thanks to him for an extremely
X# useful and well-written piece of software!  - RLG
X#
X
X#A VISUALLY EQUIVALENT JEWISH/CIVIL CALENDAR
X#ALAN D. CORRE, University of Wisonsin-Milwaukee
X#COPYRIGHT (c) 1990
X#Permission is hereby given to all persons to copy, compile and pass to
X#others this code provided that (1) it is not used for monetary gain; 
X#(2) it is not subverted from its original purpose, and is changed only
X#to the extent necessary to make it work on a different computer or terminal.
X#No guarantees are given or implied as to the correctness of information
X#furnished by this program.
X#Written in the beautiful Icon programming language. Further information from
X#icon-project at arizona.edu
X#If my math were longer this program would be shorter. Excuse me.
X#This work is respectfully devoted to the authors of two books consulted
X#with much profit: "A Guide to the Solar-Lunar Calendar" by B. Elihu Rothblatt
X#published by our sister Hebrew Dept. in Madison, Wis., and "Kiddush HaHodesh"
X#by Rabbenu Moses ben Maimon, on whom be peace.
X#The Jewish year harmonizes the solar and lunar cycle, using the 19-year cycle
X#of Meton (c. 432 BCE). It corrects so that certain dates shall not fall on
X#certain days for religious convenience. The Jewish year has six possible
X#lengths, 353,354,355,383,384,385 days, according to day and time of new
X#year lunation and position in Metonic cycle. Time figures from 6pm previous
X#night. 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 year 0,
X#corresponding to 3762 B.C.E. Calculations in this program are figured in
X#the ancient Babylonian unit of halaqim "parts" of the hour = 1/1080 hour.
X#Version given here should work without change under MS-DOS. Hints are given
X#for modifying the code for other systems. Your MS-DOS should be sensitive to
X#ANSI screen controls. On many machines you may achieve this by having the
X#MS-DOS file ansi.sys available at boot time, and also a file called 
X#config.sys which contains the statement DEVICE=ANSI.SYS  Hints are offered
X#in case this is impossible.
X#Material consists of three sections separated by legend CUT HERE. This first
X#section should be placed in a file called calendar.icn. and compiled with
X#icont. Section two should be placed in a file called calendar.hlp.
X#The absence of this file will not impede the program. The information in 
X#this file is unsuitable for the Macintosh. I can supply an alternate file.
X#Section three should be placed in a file called calendar.dat. This file is
X#essential, and must contain no extraneous matter at the beginning.
X#Program is run under MS.DOS by entering the command:
X# iconx calendar
X#which may optionally be followed by the years desired in the form 5750
X#for a Jewish year +1990 or 1990AD or 1990CE or -1990 or 1990BC or
X#1990BCE for a civil year. On some systems iconx can be omitted.
X
Xrecord date(yr,mth,day)
Xrecord molad(day,halaqim)
Xglobal cyr,jyr,days_in_jyr,current_molad,current_day,infolist
X
Xprocedure main(cmd)
Xlocal COPYRIGHT
X#sticks around in memory
X  COPYRIGHT := "Copyright (c) Alan D. Corre 1990"
X#an acute accent on my e will be appreciated if available
X  clear()
X  banner("PERPETUAL JEWISH/CIVIL CALENDAR","","by","","ALAN D. CORRE")
X  write("\n\nCopyright (c) Alan D. Corre 1990")
X  if *cmd = 0 then {
X#putting an asterisk indicates that user might need help
X    n := 1; put(cmd,"*")} else
X    n := *cmd
X    every p := 1 to n do {
X  initialize(cmd[p])
X  process()}
Xend
X
Xprocedure banner(l[])
X#Creates a banner to begin programs. If you don't have the extended ASCII
X#character set, replace each char(n) with some character that you have
X#such as " " or "-"
X#Does not work well if your screen has variable spacing.
Xlocal n
X  write();write();write()
X  writes(char(201)) #top left right angle
X  writes(repl(char(205),78)) #straight line
X  writes(char(187)) #top right right angle
X  writes(char(186)) #upright line at left
X  writes(right(char(186),79)) #upright line at right
X  every n := 1 to *l do {
X    writes(char(186)) #upright line at left
X    writes(center(l[n],78),char(186)) #string centered followed by upright line
X    writes(char(186)) #upright line at left
X    writes(right(char(186),79)) #upright line at right
X}
X  writes(char(200)) #bottom left right angle
X  writes(repl(char(205),78)) #straight line
X  write(char(188)) #bottom right right angle
X  write()
Xreturn
Xend
X
Xprocedure instructions(filename)
X#Gives user access to a help file which is printed out in chunks.
Xlocal filvar,counter,line
X  writes("Do you need instructions? y/n ")
X  if upto('yY',read()) then {
X#The following if-statement fails if the file is not available
X  counter := 0
X  if filvar := open(filename) then
X#Read the help file. 
X    while line := read(filvar) do {
X#Write out a line and increment the counter
X      write(line)
X      counter +:= 1
X#Now we have a screenful; ask if we should continue
X      if counter >22 then {
X        write()
X        writes ("More? y/n ")
X#User has had enough; break out of loop
X        if upto('nN',read()) then break  else
X#User wants more; reset counter and continue
X          counter := 0}} else
X#This else goes with the second if-statement; the attempt to open the
X#help file failed:
X      write("Sorry, instructions not available.")}
X    write ("Press return to continue.")
X    read()
X#Close the file if it existed and was opened. If it was never opened
X#the value of filvar will be null. This check has to be made because
X#an attempt to use close() on a variable NOT valued at a file would
X#cause an error. 
X/filvar | close(filvar)
Xend
X
Xprocedure clear()
X#clears the screen. If you dont have ANSI omit the next line
X  writes("\e[2J")
Xend
X
Xprocedure initialize_list()
X#while user views banner, put info of calendar.dat into a global list
Xlocal infile,n
X  infolist := list(301)
X  if not (infile := open("calendar.dat")) then
X    stop("This program must have the file CALENDAR.DAT on line in order to _
X          function properly.")    
X#the table is arranged arbitrarily at twenty year intervals with 301 entries.
X  every n := 1 to 301 do
X    infolist[n] := read(infile)
X  close(infile)
Xend
X
Xprocedure initialize_variables()
X#get the closest previous year in the table
Xlocal line,quotient
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  line ? { 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#begin at rosh hashana
X  jyr.day := 1
X  jyr.mth := 7
Xreturn
Xend
X
Xprocedure initialize(yr)
Xlocal year
X#initialize global variables
Xinitial {  cyr := date(0,0,0)
X  jyr := date(0,0,0)
X  current_molad := molad(0,0)
X  initialize_list()}
X  clear()
X#user may need help
X  if yr == "*" then {
X  instructions("CALENDAR.HLP")
X  clear()
X  writes("Please enter the year. If you are entering a CIVIL year, precede _
X         by + for \ncurrent era, - (the minus sign) for before current era. ")
X  year := read()} else
X  year := yr
X  while not (jyr.yr := cleanup(year)) do {
X    writes("I do not understand ",year,". Please try again ")
X    year := read()}
X  clear()
X  initialize_variables()
Xreturn
Xend
X
Xprocedure cleanup(str)
X#tidy up the string. Bugs still possible.
X  if (not upto('.+-',str)) & integer(str) & (str > 0) then return str
X  if upto('-bB',str) then return (0 < (3761 - checkstr(str)))
X  if upto('+cCaA',str) then return (checkstr(str) + 3760)
Xfail
Xend
X
Xprocedure checkstr(s)
X#does preliminary work on string before cleanup() cleans it up
Xlocal letter,n,newstr
X  newstr := ""
X  every n := 1 to *s do
X    if integer(s[n]) then
X      newstr ||:= s[n]
X  if (*newstr = 0) | (newstr = 0) then fail
Xreturn newstr
Xend
X
Xprocedure process()
X#gets out the information
Xlocal limit,dj,dc
X#6039 is last year handled by the table in the usual way
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  ans := "y"
X  establish_jyr()
X  every 1 to limit do {
X#tell user something is going on
X    writes(" .")
X#increment the years, establish the type of Jewish year
X    cyr_augment()
X    jyr_augment()
X    establish_jyr()}
X  clear() 
X  while upto('Yy',ans) do {
X  yj := jyr.yr
X  dj := days_in_jyr
X  every n := 1 to 4 do {
X    clear()
X    every 1 to 3 do
X      write_a_month()
X    write("Press the space bar to continue")
X    write()
X    writes(status_line(yj,dj))
X    getch()}
X    if jyr.mth = 6 then {
X      clear()
X      write_a_month()
X      every 1 to 15 do write()
X      write(status_line(yj,dj))}
X    write()
X    writes("Do you wish to continue? Enter y<es> or n<o>. ")
X    ans := getch()}
Xreturn
Xend
X
Xprocedure cyr_augment()
X#Make civil year a year later, we only need consider Aug,Sep,Nov.
Xlocal days,newmonth,newday
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  writes(" .")
X  days := (days + cyr.day-365+days_in_jyr)
X  if isleap(cyr.yr + 1) then days -:= 1
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  cyr.mth := newmonth
X  cyr.day := newday
X  cyr.yr +:= 1
X  if cyr.yr = 0 then cyr.yr := 1
Xreturn
Xend
X
X
Xprocedure header()
X#creates the header for Jewish and English side. If ANSI not available,
X#substitute "S" for "\e[7mS\e[0m" each time.
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
END_OF_FILE
  if test 29360 -ne `wc -c <'cal.text'`; then
    echo shar: \"'cal.text'\" unpacked with wrong size!
  fi
  # end of 'cal.text'
fi
if test -f 'iolib.icn' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'iolib.icn'\"
else
  echo shar: Extracting \"'iolib.icn'\" \(17272 characters\)
  sed "s/^X//" >'iolib.icn' <<'END_OF_FILE'
X########################################################################
X#    
X#	Name:	iolib.icn
X#	
X#	Title:	Icon termlib-type tools for MS-DOS and UNIX
X#	
X#	Author:	Richard L. Goerwitz (with help from Norman Azadian)
X#
X#	Version: 1.9
X#
X#########################################################################
X#
X#  The authors place this and future versions of iolib in the public
X#  domain.
X#
X#########################################################################
X#
X#  The following library represents a series of rough functional
X#  equivalents to the standard Unix low-level termcap routines.  It is
X#  not meant as an exact termlib clone.  Nor is it enhanced to take
X#  care of magic cookie terminals, terminals that use \D in their
X#  termcap entries, or archaic terminals that require padding.  This
X#  library is geared mainly for use with ANSI and VT-100 devices.
X#  Note that this file may, in most instances, be used in place of the
X#  older UNIX-only itlib.icn file.  It essentially replaces the DOS-
X#  only itlibdos routines.  For DOS users not familiar with the whole
X#  notion of generalized screen I/O, I've included extra documentation
X#  below.  Please read it.
X#
X#  The sole disadvantage of this over the old itlib routines is that
X#  iolib.icn cannot deal with archaic or arcane UNIX terminals and/or
X#  odd system file arrangements.  Note that because these routines
X#  ignore padding, they can (unlike itlib.icn) be run on the NeXT and
X#  other systems which fail to implement the -g option of the stty
X#  command.  Iolib.icn is also simpler and faster than itlib.icn.
X#
X#  I want to thank Norman Azadian for suggesting the whole idea of
X#  combining itlib.icn and itlibdos.icn into one distribution, for
X#  suggesting things like letting drive specifications appear in DOS
X#  TERMCAP environment variables, and for finding several bugs (e.g.
X#  the lack of support for %2 and %3 in cm).  Although he is loathe
X#  to accept this credit, I think he deserves it.
X#
X#########################################################################
X#
X#  Contents:
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 include in your program
X#  "iputs(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 completely irrelevant for most
X#  modern terminals, and is supplied here merely for the sake of
X#  backward compatibility with itlib, a UNIX-only version of these
X#  routines (one which handles padding on archaic terminals).
X#
X##########################################################################
X#
X#  Notes for MS-DOS users:
X#
X#	There are two basic reasons for using the I/O routines
X#  contained in this package.  First, by using a set of generalized
X#  routines, your code will become much more readable.  Secondly, by
X#  using a high level interface, you can avoid the cardinal
X#  programming error of hard coding things like screen length and
X#  escape codes into your programs.
X#
X#	To use this collection of programs, you must do two things.
X#  First, you must add the line "device=ansi.sys" (or the name of some
X#  other driver, like zansi.sys, nansi.sys, or nnansi.sys [=new
X#  nansi.sys]) to your config.sys file.  Secondly, you must add two
X#  lines to your autoexec.bat file: 1) "set TERM=ansi-mono" and 2)
X#  "set TERMCAP=\location\termcap."  The purpose of setting the TERM
X#  variable is to tell this program what driver you are using.  If you
X#  have a color system, you could use "ansi-color" instead of
X#  "ansi-mono," although for compatibility with a broader range of
X#  users, it would perhaps be better to stick with mono.  The purpose
X#  of setting TERMCAP is to make it possible to determine where the
X#  termcap database file is located.  The termcap file (which should
X#  have been packed with this library as termcap.dos) is a short
X#  database of all the escape sequences used by the various terminal
X#  drivers.  Set TERMCAP so that it reflects the location of this file
X#  (which should be renamed as termcap, for the sake of consistency
X#  across UNIX and MS-DOS spectra).  If desired, you can also try
X#  using termcap2.dos.  Certain games work a lot better using this
X#  alternate file.  To try it out, rename it to termcap, and set
X#  the environment variable TERMCAP to its location.
X#
X#	Although the authors make no pretense of providing here a
X#  complete introduction to the format of the termcap database file,
X#  it will be useful, we believe, to explain a few basic facts about
X#  how to use this program in conjunction with it.  If, say, you want
X#  to clear the screen, add the line,
X#
X#	iputs(getval("cl"))
X#
X#  to your program.  The function iputs() outputs screen control
X#  sequences.  Getval retrieves a specific sequence from the termcap
X#  file.  The string "cl" is the symbol used in the termcap file to
X#  mark the code used to clear the screen.  By executing the
X#  expression "iputs(getval("cl"))," you are 1) looking up the "cl"
X#  (clear) code in the termcap database entry for your terminal, and
X#  the 2) outputting that sequence to the screen.
X#
X#	Some other useful termcap symbols are "ce" (clear to end of
X#  line), "ho" (go to the top left square on the screen), "so" (begin
X#  standout mode), and "se" (end standout mode).  To output a
X#  boldfaced string, str, to the screen, you would write -
X#
X#	iputs(getval("so"))
X#	writes(str)
X#	iputs(getval("se"))
X#
X#  You can also write "writes(getval("so") || str || getval("se")),
X#  but this would make reimplementation for UNIX terminals that
X#  require padding rather difficult.
X#
X#	It is also heartily to be recommended that MS-DOS programmers
X#  try not to assume that everyone will be using a 25-line screen.
X#  Most terminals are 24-line.  Some 43.  Some have variable window
X#  sizes.  If you want to put a status line on, say, the 2nd-to-last
X#  line of the screen, then determine what that line is by executing
X#  "getval("li")."  The termcap database holds not only string-valued
X#  sequences, but numeric ones as well.  The value of "li" tells you
X#  how many lines the terminal has (compare "co," which will tell you
X#  how many columns).  To go to the beginning of the second-to-last
X#  line on the screen, type in:
X#
X#	iputs(igoto(getval("cm"), 1, getval("li")-1))
X#
X#  The "cm" capability is a special capability, and needs to be output
X#  via igoto(cm,x,y), where cm is the sequence telling your computer
X#  to move the cursor to a specified spot, x is the column, and y is
X#  the row.  The expression "getval("li")-1" will return the number of
X#  the second-to-last line on your screen.
X#
X##########################################################################
X#
X#  Requires: UNIX or MS-DOS, co-expressions
X#
X#  See also: itlib.icn, iscreen.icn
X#
X##########################################################################
X
X
Xglobal tc_table, isDOS
Xrecord true()
X
X
Xprocedure check_features()
X
X    initial {
X
X	if find("UNIX",&features) then
X	    isDOS := &null
X	else if find("MS-DOS", &features) then
X	    isDOS := 1
X	else stop("check_features:  OS not (yet?) supported.")
X
X	find("expressi",&features) |
X	    er("check_features","co-expressions not implemented - &$#!",1)
X    }
X
X    return
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 := table()
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 DOS or
X    # UNIX, and, if so, tries to figure out what the current terminal
X    # type is, checking successively the value of the environment
X    # variable TERM, and then (under UNIX) the output of "tset -".
X    # Terminates with an error message if the terminal type cannot be
X    # ascertained.  DOS defaults to "mono."
X
X    local term, tset_output
X
X    check_features()
X
X    if \isDOS then {
X        term := getenv("TERM") | "mono"
X    }
X    else {
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    }
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, termcap_string)
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 the termcap file 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 isFILE, f, getline, line, nm, ent1, ent2
X    static slash, termcap_names
X    initial {
X	if \isDOS then {
X	    slash := "\\"
X	    termcap_names := ["termcap","termcap.dos","termcap2.dos"]
X	}
X	else {
X	    slash := "/"
X	    termcap_names := ["/etc/termcap"]
X	}
X    }
X
X
X    # You can force getentry() to use a specific termcap file by cal-
X    # ling it with a second argument - the name of the termcap file
X    # to use instead of the regular one, or the one specified in the
X    # termcap environment variable.
X    /termcap_string := getenv("TERMCAP")
X
X    if \isDOS then {
X	if \termcap_string then {
X	    if termcap_string ? (
X		 not ((tab(any(&letters)), match(":")) | match(slash)),
X		 pos(1) | tab(find("|")+1), =name)
X	    then return termcap_string
X	    else isFILE := 1
X	}
X    }
X    else {
X	if \termcap_string then {
X	    if termcap_string ? (
X	        not match(slash), pos(1) | tab(find("|")+1), =name)
X	    then return termcap_string
X	    else isFILE := 1
X	}
X    }
X
X    # The logic here probably isn't clear.  The idea is to try to use
X    # the termcap environment variable successively as 1) a termcap en-
X    # try and then 2) as a termcap file.  If neither works, 3) go to
X    # the /etc/termcap file.  The else clause here does 2 and, if ne-
X    # cessary, 3.  The "\termcap_string ? (not match..." expression
X    # handles 1.
X
X    if \isFILE			# if find(slash, \termcap_string)
X    then f := open(termcap_string)
X    /f := open(!termcap_names) |
X	er("getentry","I can't access your termcap file.  Read iolib.icn.",1)
X    
X    getline := create read_file(f)
X    
X    while line := @getline do {
X	if line ? (pos(1) | tab(find("|")+1), =name, any(':|')) then {
X	    entry := ""
X	    while (\line | @getline) ? {
X		if entry ||:= 1(tab(find(":")+1), pos(0))
X		then {
X		    close(f)
X		    # if entry ends in tc= then add in the named tc entry
X		    entry ?:= tab(find("tc=")) ||
X		    # recursively fetch the new termcap entry
X			(move(3), getentry(tab(find(":"))) ?
X			 # remove the name field from the new entry
X			 (tab(find(":")+1), tab(0)))
X		    return entry
X		}
X		else {
X		    \line := &null # must precede the next line
X		    entry ||:= trim(trim(tab(0),'\\'),':')
X		}
X	    }
X	}
X    }
X
X    close(f)
X    er("getentry","can't find and/or process your termcap entry",3)
X 
Xend
X
X
X
Xprocedure read_file(f)
X
X    # Suspends all non #-initial lines in the file f.
X    # Removes leading tabs and spaces from lines before suspending
X    # them.
X
X    local line
X
X    \f | er("read_tcap_file","no valid termcap file found",3)
X    while line := read(f) do {
X	match("#",line) & next
X	line ?:= (tab(many('\t ')) | &null, tab(0))
X	suspend line
X    }
X
X    fail
X
Xend
X
X
X
Xprocedure maketc_table(entry)
X
X    # Maketc_table(s) (where s is a valid termcap entry for some
X    # terminal-type): Returns a table in which the keys are termcap
X    # capability designators, and the values are the entries in
X    # "entry" for those designators.
X
X    local k, v
X
X    /entry & er("maketc_table","no entry given",8)
X    if entry[-1] ~== ":" then entry ||:= ":"
X    
X    /tc_table := table()
X
X    entry ? {
X
X	tab(find(":")+1)	# tab past initial (name) field
X
X	while tab((find(":")+1) \ 1) ? {
X	    &subject == "" & next
X	    if k := 1(move(2), ="=") then {
X		# Get rid of null padding information.  Iolib can't
X		# handle it (unlike itlib.icn).  Leave star in.  It
X		# indicates a real dinosaur terminal, and will later
X		# prompt an abort.
X		str := ="*" | ""; tab(many(&digits))
X		tc_table[k] := Decode(str || tab(find(":")))
X	    }
X	    else if k := 1(move(2), ="#")
X	    then tc_table[k] := integer(tab(find(":")))
X	    else if k := 1(tab(find(":")), pos(-1))
X	    then tc_table[k] := true()
X	    else er("maketc_table", "your termcap file has a bad entry",3)
X	}
X    }
X
X    return tc_table
X
Xend
X
X
X
Xprocedure getval(id)
X
X    /tc_table := maketc_table(getentry(getname())) |
X	er("getval","can't make a table for your terminal",4)
X
X    return \tc_table[id] | fail
X	# er("getval","the current terminal doesn't support "||id,7)
X
Xend
X
X
X
Xprocedure Decode(s)
X
X    # Does things like turn ^ plus a letter into a genuine control
X    # character.
X
X    new_s := ""
X
X    s ? {
X
X	while new_s ||:= tab(upto('\\^')) do {
X	    chr := move(1)
X	    if chr == "\\" then {
X		new_s ||:= {
X		    case chr2 := move(1) of {
X			"\\" : "\\"
X			"^"  : "^"
X			"E"  : "\e"
X			"b"  : "\b"
X			"f"  : "\f"
X			"n"  : "\n"
X			"r"  : "\r"
X			"t"  : "\t"
X			default : {
X			    if any(&digits,chr2) then {
X				char(integer("8r"||chr2||move(2 to 0 by -1))) |
X				    er("Decode","bad termcap entry",3)
X			    }
X			   else chr2
X			}
X		    }
X		}
X	    }
X	    else new_s ||:= char(ord(map(move(1),&lcase,&ucase)) - 64)
X	}
X	new_s ||:= tab(0)
X    }
X
X    return new_s
X
Xend
X
X
X
Xprocedure igoto(cm,col,line)
X
X    local colline, range, increment, padding, str, outstr, chr, x, y
X
X    if col > (tc_table["co"]) | line > (tc_table["li"]) then {
X	colline := string(\col) || "," || string(\line) | string(\col|line)
X	range := "(" || tc_table["co"]-1 || "," || tc_table["li"]-1 || ")"
X	er("igoto",colline || " out of range " || (\range|""),9)
X    } 
X
X    # Use the Iconish 1;1 upper left corner & not the C-ish 0 offsets
X    increment := -1
X    outstr := ""
X    
X    cm ? {
X	while outstr ||:= tab(find("%")) do {
X	    tab(match("%"))
X	    if padding := integer(tab(any('23')))
X	    then chr := (="d" | "d")
X	    else chr := move(1)
X	    if case \chr of {
X		"." :  outstr ||:= char(line + increment)
X		"+" :  outstr ||:= char(line + ord(move(1)) + increment)
X		"d" :  {
X		    str := string(line + increment)
X		    outstr ||:= right(str, \padding, "0") | str
X		}
X	    }
X	    then line :=: col
X	    else {
X		case chr of {
X		    "n" :  line := ixor(line,96) & col := ixor(col,96)
X		    "i" :  increment := 0
X		    "r" :  line :=: col
X		    "%" :  outstr ||:= "%"
X		    "B" :  line := ior(ishift(line / 10, 4), line % 10)
X		    ">" :  {
X			x := move(1); y := move(1)
X			line > ord(x) & line +:= ord(y)
X			&null
X		    }
X		} | er("goto","bad termcap entry",5)
X	    }
X	}
X    return outstr || tab(0)
X    }
X
Xend
X
X
X
Xprocedure iputs(cp, affcnt)
X
X    # Writes cp to the screen.  Use this instead of writes() for
X    # compatibility with itlib (a UNIX-only version which can handle
X    # albeit inelegantly) terminals that need padding.
X
X    static num_chars
X    initial num_chars := &digits ++ '.'
X
X    type(cp) == "string" |
X	er("iputs","you can't iputs() a non-string value!",10)
X
X    cp ? {
X	if tab(many(num_chars)) & ="*" then
X	    stop("iputs:  iolib can't use terminals that require padding.")
X	writes(tab(0))
X    }
X
X    return
X
Xend
END_OF_FILE
  if test 17272 -ne `wc -c <'iolib.icn'`; then
    echo shar: \"'iolib.icn'\" unpacked with wrong size!
  fi
  # end of 'iolib.icn'
fi
echo shar: End of archive 1 \(of 2\).
cp /dev/null ark1isdone
MISSING=""
for I in 1 2 ; do
    if test ! -f ark${I}isdone ; then
	MISSING="${MISSING} ${I}"
    fi
done
if test "${MISSING}" = "" ; then
    echo You have unpacked both archives.
    rm -f ark[1-9]isdone
else
    echo You still must unpack the following archives:
    echo "        " ${MISSING}
fi
exit 0
exit 0 # Just in case...
-- 
Kent Landfield                   INTERNET: kent at sparky.IMD.Sterling.COM
Sterling Software, IMD           UUCP:     uunet!sparky!kent
Phone:    (402) 291-8300         FAX:      (402) 291-4362
Please send comp.sources.misc-related mail to kent at uunet.uu.net.



More information about the Comp.sources.misc mailing list