############################################################################ # # File: datefns.icn # # Subject: Procedure for dates # # Author: Charles Hethcoat # # Date: August 14, 1995 # ############################################################################ # # This file is in the public domain. # ############################################################################ # # datefns.icn - a collection of date functions # # Adaptor: Charles L Hethcoat III # June 12, 1995 # Taken from various sources as attributed below. # # All date and calendar functions use the "date_rec" structure defined # below. # # Note: I adapted the procedures "julian" and "unjulian" sometime in 1994 # from "Numerical Recipes in C." Some time later I discovered them # (under slightly different names) in Version 9 of the Icon Library # (Ralph Griswold, author). I am including mine for what they are worth. # That'll teach me to wait! # ############################################################################ record date_rec(year, month, day, yearday, monthname, dayname) global monthlist # Maps month numbers into month names global monthtbl # Maps month names into numbers 1-12 global dow # Maps 1-7 into Sunday-Saturday global cum_days # Cum. day counts for month end, leap & non-leap yrs. # initdate - call to initialize the global data before using other fns. # See "The C Programming Language," by Kernighan and Richie (Wylie, # 1978) procedure initdate() monthlist := ["January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December"] monthtbl := table() monthtbl["January"] := 1 monthtbl["February"] := 2 monthtbl["March"] := 3 monthtbl["April"] := 4 monthtbl["May"] := 5 monthtbl["June"] := 6 monthtbl["July"] := 7 monthtbl["August"] := 8 monthtbl["September"] := 9 monthtbl["October"] := 10 monthtbl["November"] := 11 monthtbl["December"] := 12 dow := ["Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday"] cum_days := [ [0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365], [0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335, 366] ] return end # today - obtain computationally-useful values for today's date procedure today() local junk, datestruct datestruct := date_rec() &dateline ? { # &dateline is in a fixed format: junk := tab(upto(&letters)) datestruct.dayname := tab(many(&letters)) junk := tab(upto(&letters)) datestruct.monthname := tab(many(&letters)) junk := tab(upto(&digits)) datestruct.day := tab(many(&digits)) junk := tab(upto(&digits)) datestruct.year := tab(many(&digits)) } datestruct.month := monthtbl[datestruct.monthname] datestruct.yearday := doy(datestruct.year, datestruct.month, datestruct.day) return datestruct end # The next two routines have been adapted from "Numerical Recipes in C," # by Press, Flannery, Teukolsky, and Vetterling (Cambridge, 1988). The # following quote is from page 10: # Astronomers number each 24-hour period, starting and ending at noon, # with a unique integer, the Julian Day Number. Julian Day Zero was # a very long time ago; a convenient reference point is that Julian # Day 2440000 began at noon of May 23, 1968. If you know the Julian # Day Number that began at noon of a given calendar date, then the day # of the week of that date is obtained by adding 1 and taking the result # modulo base 7; a zero answer corresponds to Sunday, 1 to Monday, ..., # 6 to Saturday. # The C code presented in that book heavily uses the automatic conversion # of real (floating point) numbers to integers by truncation. Since Icon # doesn't do this, explicit type conversions are required. # julian - convert a date_rec to a Julian day number procedure julian(date) local jul local ja, jy, jm, z1, z2 if date.year = 0 then fail if date.year < 0 then date.year +:= 1 if date.month > 2 then { jy := date.year jm := date.month + 1 } else { jy := date.year - 1 jm := date.month + 13 } z1 := real(integer(365.25*jy)) z2 := real(integer(30.6001*jm)) jul := integer(z1 + z2 + date.day + 1720995) if date.day + 31*(date.month + 12*date.year) >= 588829 then { ja := integer(0.01*jy) jul +:= 2 - ja + integer(0.25*ja) } return jul end # unjulian - produce a date from the Julian day number procedure unjulian(julianday) local ja, jalpha, jb, jc, jd, je # integers all local datestruct datestruct := date_rec() if julianday >= 2299161 then { jalpha := integer((real(julianday - 1867216) - 0.25)/36524.25) ja := julianday + 1 + jalpha - integer(0.25*jalpha) } else ja := julianday jb := ja + 1524 jc := integer(6680.0 + (real(jb - 2439870) - 122.1)/365.25) jd := 365*jc + integer(0.25*jc) je := integer((jb - jd)/30.6001) datestruct.day := jb - jd - integer(30.6001*je) datestruct.month := je - 1 if datestruct.month > 12 then datestruct.month -:= 12 datestruct.year := jc - 4715 if datestruct.month > 2 then datestruct.year -:= 1 if datestruct.year <= 0 then datestruct.year -:= 1 # Get the day number in the year: datestruct.yearday := doy(datestruct.year, datestruct.month, datestruct.day) # Get the name of the month: datestruct.monthname := monthlist[datestruct.month] # Calculate the day of the week: datestruct.dayname := dow[(julianday + 1) % 7 + 1] return datestruct end # doy - return day-of-year from (year, month, day) # Adapted from K&R procedure doy(year, month, day) local leap, y, m, d y := integer(year) m := integer(month) d := integer(day) leap := if (y % 4 = 0 & y % 100 ~= 0) | y % 400 = 0 then 2 # leap year else 1 # non-leap year return cum_days[leap][m] + d end # wrdate - write out a basic date string with a leadin string procedure wrdate(leadin, date) write(leadin, " ", date.year, " ", date.monthname, " ", date.day) end