############################################################################
#
#	File:     datetime.icn
#
#	Subject:  Procedures for date and time operations
#
#	Author:   Robert J. Alexander and Ralph E. Griswold
#
#	Date:     August 9, 2000
#
############################################################################
#
#   This file is in the public domain.
#
############################################################################
#
#	Notes:
#		- the default value for function parameters named
#		  "hoursFromGmt" is the value of global variable
#		  "HoursFromGmt" if nonnull, or environment variable
#		  "HoursFromGmt" if set, or 0.
#		- The base year from which the "seconds" representation
#		  of a date is calculated is by default 1970 (the ad hoc
#		  standard used by both Unix and MS-Windows), but can be
#		  changed by either setting the global variable
#		  "DateBaseYear" or environment variable "DateBaseYear".
#		- There are some procedures not mentioned in this summary
#		  that are useful: DateRecToSec(), SecToDateRec(). See the
#		  source code for details.
#
#	ClockToSec(seconds)
#		converts a time in the format of &clock to seconds past
#		midnight.
#
#	DateLineToSec(dateline,hoursFromGmt)
#		converts a date in &dateline format to seconds since start of
#		dateBaseYear.
#
#	DateToSec(date,hoursFromGmt)
#		converts a date string in Icon &date format (yyyy/mm/dd)
#		to seconds past DateBaseYear.
#
#	SecToClock(seconds)
#		converts seconds past midnight to a string in the format of
#		&clock.
#
#	SecToDate(seconds,hoursFromGmt)
#		converts seconds past DateBaseYear to a string in Icon
#		&date format (yyyy/mm/dd).
#
#	SecToDateLine(seconds,hoursFromGmt)
#		produces a date in the same format as Icon's &dateline.
#
#	SecToUnixDate(seconds,hoursFromGmt)
#		returns a date and time in typical UNIX format:
#		Jan 14 10:24 1991.
#
#	IsLeapYear(year)
#		succeeds if year is a leap year, otherwise fails.
#
#	calendat(j)
#		returns a record with the month, day, and year corresponding
#		to the Julian Date Number j.
#
#	date()	natural date in English.
#
#	dayoweek(day, month, year)
#		produces the day of the week for the given date.
#		Note carefully the parameter order.
#
#	full13th(year1, year2)
#		generates records giving the days on which a full moon occurs
#		on Friday the 13th in the range from year1 though year2.
#
#	julian(m, d, y)
#		returns the Julian Day Number for the specified
#		month, day, and year.
#
#	pom(n, phase)
#		returns record with the Julian Day number of fractional
#		part of the day for which the nth such phase since
#		January, 1900.  Phases are encoded as:
#
#			0 - new moon
#			1 - first quarter
#			2 - full moon
#			3 - last quarter#
#
#		GMT is assumed.
#
#	saytime()
#		computes the time in natural English.  If an argument is
#		supplied it is used as a test value to check the operation
#		 the program.
#
#	walltime()
#		produces the number of seconds since midnight.  Beware
#		wrap-around when used in programs that span midnight.
#
############################################################################
#
#  See also:  datefns.icn
#
############################################################################
#
#  Acknowledgement:  Some of these procedures are based on an algorithm
#  given in "Numerical Recipes; The Art of Scientific Computing";
#  William H. Press, Brian P. Flannery, Saul A. Teukolsky, and William
#  T. Vetterling;#  Cambridge University Press, 1986.
#
############################################################################

record date1(month, day, year)
record date2(month, year, fraction)
record jdate(number, fraction)
record DateRec(year,month,day,hour,min,sec,weekday)

global Months,Days,DateBaseYear,HoursFromGmt

procedure ClockToSec(seconds)			#: convert &date to seconds
#
#  Converts a time in the format of &clock to seconds past midnight.
#
    seconds ? return (
	 (1(tab(many(&digits)),move(1)) * 60 +
	 1(tab(many(&digits)),move(1) | &null)) * 60 +
	 (tab(many(&digits)) | 0)
	 )
end

procedure DateInit()
#
#  Initialize the date globals -- done automatically by calls to date
#  procedures.
#
   initial {
      Months := ["January","February","March","April","May","June",
	    "July","August","September","October","November","December"]
      Days := ["Sunday","Monday","Tuesday","Wednesday","Thursday",
	    "Friday","Saturday"]
      /DateBaseYear := integer(getenv("DateBaseYear")) | 1970
      /HoursFromGmt := integer(getenv("HoursFromGmt")) | 0
      }
   return
end


procedure DateLineToSec(dateline,hoursFromGmt)	#: convert &dateline to seconds
#
#  Converts a date in long form to seconds since start of DateBaseYear.
#
   local day,halfday,hour,min,month,sec,year
   static months
   initial {
      DateInit()
      months := table()
      months["jan"] := 1
      months["feb"] := 2
      months["mar"] := 3
      months["apr"] := 4
      months["may"] := 5
      months["jun"] := 6
      months["jul"] := 7
      months["aug"] := 8
      months["sep"] := 9
      months["oct"] := 10
      months["nov"] := 11
      months["dec"] := 12
      }
   map(dateline) ? {
      tab(many(' \t'))
      =("sun" | "mon" | "tue" | "wed" | "thu" | "fri" | "sat") &
	    tab(many(&letters)) | &null & tab(many(' \t,')) | &null
      month := 1(tab(many(&letters)),tab(many('  \t')) | &null)
      day <- integer(1(tab(many(&digits)),tab(many(' \t,')) | &null)) | &null &
      year <- integer(1(tab(many(&digits)),tab(many(' \t')) | &null)) | &null &
      (hour <- integer(tab(many(&digits))) &
	    ((=":" & min <- integer(tab(many(&digits)))) &
	    ((=":" & sec <- integer(tab(many(&digits)))) | &null) | &null) &
	    tab(many(' \t')) | &null & halfday := =("am" | "pm") | &null &
	    tab(many(' \t')) | &null) | &null & pos(0)
      }
   \month :=  \months[month[1+:3]] | fail
   if not /(halfday | hour) then {
      if hour = 12 then hour := 0
      if halfday == "pm" then
	    hour +:= 12
      }
   return DateRecToSec(DateRec(year,month,day,hour,min,sec),hoursFromGmt)
end

procedure DateRecToSec(dateRec,hoursFromGmt)
#
#  Converts a DateRec to seconds since start of DateBaseYear.
#
   local day,hour,min,month,sec,secs,year,yr
   static days
   initial {
      DateInit()
      days := [
	 0,
	 2678400,
	 5097600,
	 7776000,
	 10368000,
	 13046400,
	 15638400,
	 18316800,
	 20995200,
	 23587200,
	 26265600,
	 28857600
      ]
      }
   /hoursFromGmt := HoursFromGmt
   hoursFromGmt := integer(hoursFromGmt) | runerr(101,hoursFromGmt)
   year := \dateRec.year | +&date[1+:4]
   month := \dateRec.month | +&date[6+:2]
   day := \dateRec.day | +&date[9+:2]
   hour := \dateRec.hour | 0
   min := \dateRec.min | 0
   sec := \dateRec.sec | 0
   secs := 0
   every yr := DateBaseYear to year - 1  do {
      secs +:= if IsLeapYear(yr) then 31622400 else 31536000
      }
   if month > 2 & IsLeapYear(year) then secs +:= 86400
   return secs + days[month] + (day - 1) * 86400 +
	 (hour - hoursFromGmt) * 3600 + min * 60 + sec
end

procedure DateToSec(date,hoursFromGmt)	#: convert &date to seconds
#
#  Converts a date in Icon &date format (yyyy/mm/dd) do seconds
#  past DateBaseYear.
#
    date ? return DateRecToSec(DateRec(+1(tab(find("/")),move(1)),
	+1(tab(find("/")),move(1)),+tab(0)),hoursFromGmt)
end

procedure SecToClock(seconds)		#: convert seconds to &clock
#
#  Converts seconds past midnight to a string in the format of &clock.
#
    local sec
    sec := seconds % 60
    seconds /:= 60
    return right(seconds / 60,2,"0") || ":" || right(seconds % 60,2,"0") ||
	     ":" || right(sec,2,"0")
end

procedure SecToDate(seconds,hoursFromGmt) #: convert seconds to &date
#
#  Converts seconds past DateBaseYear to a &date in Icon date format
#  (yyyy,mm,dd).
#
    local r
    r := SecToDateRec(seconds,hoursFromGmt)
    return right(r.year,4,"0") || "/" || right(r.month,2,"0") || "/" ||
	     right(r.day,2,"0")
end

procedure SecToDateLine(seconds,hoursFromGmt) #: convert seconds to &dateline
#
#  Produces a date in the same format as Icon's &dateline.
#
   local d,hour,halfday
   d := SecToDateRec(seconds,hoursFromGmt)
   if (hour := d.hour) < 12 then {
      halfday := "am"
      }
   else {
      halfday := "pm"
      hour -:= 12
      }
   if hour = 0 then hour := 12
   return Days[d.weekday] || ", " || Months[d.month] || " " || d.day ||
	 ", " || d.year || "  " || hour || ":" || right(d.min,2,"0") || " " ||
	 halfday
end

procedure SecToDateRec(seconds,hoursFromGmt)
#
#  Produces a date record computed from the seconds since the start of
#  DateBaseYear.
#
   local day,hour,min,month,secs,weekday,year
   initial DateInit()
   seconds := integer(seconds) | runerr(101,seconds)
   /hoursFromGmt := HoursFromGmt
   hoursFromGmt := integer(hoursFromGmt) | runerr(101,hoursFromGmt)
   seconds +:= hoursFromGmt * 3600
   weekday := (seconds / 86400 % 7 + 4) % 7 + 1
   year := DateBaseYear
   repeat {
      secs := if IsLeapYear(year) then 31622400 else 31536000
      if seconds < secs then break
      year +:= 1
      seconds -:= secs
      }
   month := 1
   every secs :=
	 2678400 |
	 (if IsLeapYear(year) then 2505600 else 2419200) |
	 2678400 |
	 2592000 |
	 2678400 |
	 2592000 |
	 2678400 |
	 2678400 |
	 2592000 |
	 2678400 |
	 2592000 |
	 2678400 do {
      if seconds < secs then break
      month +:= 1
      seconds -:= secs
      }
   day := seconds / 86400 + 1
   seconds %:= 86400
   hour := seconds / 3600
   seconds %:= 3600
   min := seconds / 60
   seconds %:= 60
   return DateRec(year,month,day,hour,min,seconds,weekday)
end

procedure SecToUnixDate(seconds,hoursFromGmt)	#: convert seconds to UNIX time
#
#  Returns a date and time in UNIX format: Jan 14 10:24 1991
#
   local d
   d := SecToDateRec(seconds,hoursFromGmt)
   return Months[d.month][1+:3] || " " || d.day || " " ||
	 d.hour || ":" || right(d.min,2,"0") || " " || d.year
end

procedure IsLeapYear(year)			#: determine if year is leap
   #
   # Fails unless year is a leap year.
   #
   return year % 4 = 0 & (year % 100 ~= 0 | year % 400 = 0) & &null
end

procedure calendat(julian)			#: Julian date
   local ja, jalpha, jb, jc, jd, je, gregorian
   local month, day, year

   gregorian := 2299161

   if julian >= gregorian then {
      jalpha := integer(((julian - 1867216) - 0.25) / 36524.25)
      ja := julian + 1 + jalpha - integer(0.25 * jalpha)
      }
   else ja := julian

   jb := ja + 1524
   jc := integer(6680.0 + ((jb - 2439870) - 122.1) / 365.25)
   jd := 365 * jc + integer(0.25 * jc)
   je := integer((jb - jd) / 30.6001)
   day := jb - jd - integer(30.6001 * je)
   month := je - 1
   if month > 12 then month -:= 12
   year := jc - 4715
   if month > 2 then year -:= 1
   if year <= 0 then year -:= 1

   return date1(month, day, year)

end

procedure date()			#: date in natural English

   &dateline ? {
      tab(find(", ") + 2)
      return tab(find("  "))
      }

end

procedure dayoweek(day, month, year)	#: day of the week
#
#  The method used was adapted from a Web page by Mark Dettinger.
#  URL as of 7 August 2000 was:
#  http://www.informatik.uni-ulm.de/pm/mitarbeiter/mark/day_of_week.html
#
   static d_code, c_code, m_code, ml_code, y, C, M, Y

   initial {
      d_code := ["Saturday", "Sunday", "Monday", "Tuesday", "Wednesday",
         "Thursday", "Friday"]

      c_code := table()
      c_code[16] := c_code[20] := 0
      c_code[17] := c_code[21] := 6
      c_code[18] := c_code[22] := 4
      c_code[19] := c_code[23] := 2

      m_code := table()
      m_code[1] := m_code["January"] := 1
      m_code[2] := m_code["February"] := 4
      m_code[3] := m_code["March"] := 4
      m_code[4] := m_code["April"] := 0
      m_code[5] := m_code["May"] := 2
      m_code[6] := m_code["June"] := 5
      m_code[7] := m_code["July"] := 0
      m_code[8] := m_code["August"] := 3
      m_code[9] := m_code["September"] := 6
      m_code[10] := m_code["October"] := 1
      m_code[11] := m_code["November"] := 4
      m_code[12] := m_code["December"] := 6

      ml_code := copy(m_code)
      ml_code[1] := ml_code["January"] := 0
      ml_code[2] := ml_code["February"] := 3
      }

   #  This can be fixed to go back to October 15, 1582.

   if year < 1600 then stop("*** can't compute day of week that far back")

   #  This can be fixed to go indefinitely far into the future; the day of
   #  of the week repeats every 400 years.

   if year > 2299 then stop("*** can't compute day of week that far ahead")

   C := c_code[(year / 100) + 1]
   y := year % 100
   Y := (y / 12) + (y % 12) + ((y % 12) / 4)
   month := integer(month)
   M := if (year % 4) = 0 then ml_code[month] else m_code[month]

   return d_code[(C + Y + M + day) % 7 + 1] 
   
end

procedure full13th(year1, year2)	#: full moons on Friday 13ths
   local time_zone, jd, jday, fraction, jul
   local year, month, julday, n, icon, day_of_week, c

   time_zone :=  -5.0 / 24.0

   every year := year1 to year2 do {
      every month := 1 to 12 do {
         jday := julian(month, 13, year)
         day_of_week := (jday + 1) % 7
         if day_of_week = 5 then {
            n := integer(12.37 * (year - 1900 + integer((month - 0.5) / 12.0)))
            icon := 0
            repeat {
               jul := pom(n,2)
               jd := jul.number
               fraction := 24.0 * (jul.fraction + time_zone)
               if (fraction < 0.0) then {
                  jd  -:= 1
                  fraction  +:= 24.0
                  }
               if fraction > 12.0 then {
                  jd +:= 1
                  fraction -:= 12.0
                  }
               else fraction  +:= 12.0
               if jd = jday then {
                  suspend date2(month, year, fraction)
                  break
                  }
               else {
                  c := if jday >= jd then 1 else -1
                  if c = -icon then break
                  icon := c
                  n +:= c
                  }
               }
            }
         }
      }

end

procedure julian(month, day, year)	#: Julian date
   local jul, gregorian, ja, julian_year, julian_month

   gregorian := (15 + 31 * (10 + 12 * 1582))

   if year = 0 then fail
   if year < 0 then year +:= 1
   if month > 2 then  {
      julian_year := year
      julian_month := month + 1
      } else {
      julian_year := year - 1
      julian_month := month + 13
      }
   jul := (integer(365.25 * julian_year) + integer(30.6001 * julian_month) +
      day + 1720995)
   if day + 31 * (month + 12 * year) >= gregorian then  {
      ja := integer(0.01 * julian_year)
      jul +:= 2 - ja + integer(0.25 * ja)
      }

   return jul

end

procedure pom(n, nph)			#: phase of moon
   local i, jd, fraction, radians
   local am, as, c, t, t2, extra

   radians := &pi / 180

   c := n + nph / 4.0
   t := c / 1236.85
   t2 := t * t
   as := 359.2242 + 29.105356 * c
   am := 306.0253 + 385.816918 * c + 0.010730 * t2
   jd := 2415020 + 28 * n + 7 * nph
   extra := 0.75933 + 1.53058868 * c + ((1.178e-4) - (1.55e-7) * t) * t2

   if nph = (0 | 2) then
      extra +:=  (0.1734 - 3.93e-4 * t) * sin(radians * as) - 0.4068 *
          sin(radians * am)
   else if nph = (1 | 3) then
      extra +:= (0.1721 - 4.0e-4 * t) * sin(radians * as) - 0.6280 *
        sin(radians * am)
   else fail

   if extra >= 0 then i := integer(extra)
   else i := integer(extra - 1.0)
   jd  +:=  i
   fraction := extra - i

   return jdate(integer(jd), fraction)

end

procedure saytime(time)			#: time in natural English
   local hour,min,mod,near,numbers,out,sec
   #
   # Extract the hours, minutes, and seconds from the time.
   #
   /time := &clock
   time ? {
      hour := integer(tab(find(":") | 0)) | fail
      move(1)
      min := tab(find(":") | 0)
      move(1)
      sec := tab(0)
      }
   min := integer(min) | 0
   sec := integer(sec) | 0
   #
   # Now start the processing in earnest.
   #
   near := ["just gone","just after","nearly","almost"]
   if sec > 29 then min +:= 1    # round up minutes
   mod := min % 5                # where we are in 5 minute bracket
   out := near[mod] || " " | ""  # start building the result
   if min > 32 then hour +:= 1   # we are TO the hour
   min +:= 2             # shift minutes to straddle the 5-minute point
   #
   # Now special-case the result for Noon and Midnight hours.
   #
   if hour % 12 = 0 & min % 60 <= 4 then {
      return if hour = 12 then out || "noon"
				    else out || "midnight"
      }
   min -:= min % 5               # find the nearest 5 mins
   if hour > 12 then hour -:= 12 # get rid of 25-hour clock
   else if hour = 0 then hour := 12 # .. and allow for midnight
   #
   # Determine the phrase to use for each 5-minute segment.
   #
   case min of {
       0: {}                      # add "o'clock" later
      60: min=0                   # ditto
       5: out ||:= "five past"
      10: out ||:= "ten past"
      15: out ||:= "a quarter past"
      20: out ||:= "twenty past"
      25: out ||:= "twenty-five past"
      30: out ||:= "half past"
      35: out ||:= "twenty five to"
      40: out ||:= "twenty to"
      45: out ||:= "a quarter to"
      50: out ||:= "ten to"
      55: out ||:= "five to"
      }
   numbers := ["one","two","three","four","five","six",
		     "seven","eight","nine","ten","eleven","twelve"]
   out ||:= (if *out = 0 then "" else " ") || numbers[hour]
				 # add the hour number
   if min = 0 then out ||:= " o'clock" # .. and o'clock if exact
   return out                    # return the final result
end
 
procedure walltime()			#: time since midnight
   local seconds

   &clock ? {
      seconds := tab(upto(':')) * 3600		# seconds in a hour
      move(1)
      seconds +:= tab(upto(':')) * 60		# seconds in a minute
      move(1)
      return seconds + tab(0)
      }

end