-----------------------------------------------------------------------------
--                                                                         --
--  DateTime.e - Routines for handling Date and Time - (c) 2003 CyrekSoft  --
--                                                                         --
-----------------------------------------------------------------------------

-- include machine.e -- segment:
constant M_CRASH_MESSAGE = 37

procedure crash_message(sequence msg)
    machine_proc(M_CRASH_MESSAGE, msg & "\n--> see ex.err\n")
end procedure

-- Constants and Type Declarations ------------------------------------------

-- Change this to 1 for extended leap year rules
global integer XLEAP
    XLEAP = 0

constant--s
    Gregorian_Reformation   = 1752,
    Gregorian_Reformation00 = 1700,

    DaysPerMonth = {
	31,         28,         31,         30,
	31,         30,         31,         31,
	30,         31,         30,         31
    },

    AverageDaysPerMonth = 30.43687604,
    AverageDaysPerYear  = 12 * AverageDaysPerMonth

global constant--s
-- Zero Date -- 1 Jan 1AD
    Date_0 = {1, 1, 1},

-- Zero Time (or possibly Midnight)
    Time_0 = {0, 0, 0},

-- Zero DateTime
    DateTime_0 = {Date_0, Time_0},

-- Date/Time/DateTime datatype indices
    DT_DATE = 1, YEAR  = 1, MONTH   = 2, DAY     = 3, JDAY = 2,
    DT_TIME = 2, HOURS = 1, MINUTES = 2, SECONDS = 3,

-- 1970 Epoch DateTime
    EPOCH_1970 = { { 1970, 1, 1 }, Time_0 },

-- Number of Seconds in larger units
    DayLengthInSeconds = 86400

-- Dates
    type year_(object y) if integer(y) and
	-2500000 <= y and y <= 2500000
    then return 1 end if  return 0  end type

    type month_(object m) if integer(m) and
	1 <= m and m <= 12
    then return 1 end if  return 0  end type

    type day_(object d) if integer(d) and
	1 <= d and d <= 31
    then return 1 end if  return 0  end type

    type jday_(object d) if integer(d) and
	1 <= d and d <= 366
    then return 1 end if  return 0  end type

global type Date(object ymd) if sequence(ymd) and length(ymd) = 3 and
    year_(ymd[YEAR]) and month_(ymd[MONTH]) and day_(ymd[DAY])
then return 1 end if  return 0  end type

global type JDate(object ymd) if sequence(ymd) and length(ymd) = 2 and
    year_(ymd[YEAR]) and jday_(ymd[JDAY])
then return 1 end if  return 0  end type

-- Times
    type hour_(object h) if integer(h) and
	0 <= h and h <= 23
    then return 1 end if  return 0  end type

    type minute_(object m) if integer(m) and
	0 <= m and m <= 59
    then return 1 end if  return 0  end type

    type seconds_(object s) if atom(s) and
	0 <= s and s <  60
    then return 1 end if  return 0  end type

global type Time(object hms) if sequence(hms) and length(hms) = 3 and
    hour_(hms[HOURS]) and minute_(hms[MINUTES]) and seconds_(hms[SECONDS])
then return 1 end if  return 0  end type

-- Date and Time combined data type

global type DateTime(object dt) if sequence(dt) and length(dt) = 2 and
    Date(dt[DT_DATE]) and Time(dt[DT_TIME])
then return 1 end if  return 0  end type

-- Time calculations --------------------------------------------------------

-- 'Now'

global function nowTime() -- returns a Time
    sequence now now = date()
    return now[4..6]
end function

-- Conversions to and from seconds

global function hmsToSeconds(Time hms) -- returns an atom
    return (hms[HOURS] * 60 + hms[MINUTES]) * 60 + hms[SECONDS]
end function

global function secondsToHms(atom in) -- returns a Time
    integer hours, minutes
    atom secs

    in = remainder(in, DayLengthInSeconds)
    if in < 0 then in += DayLengthInSeconds end if

    secs = remainder(in, 60)

    in = floor(in / 60)
    minutes = remainder(in, 60)

    hours = remainder(floor(in / 60), 24)

    return {hours, minutes, secs}
end function

global function dayFractionToSeconds(atom df) -- returns an atom
    df -= floor(df)
    return df * DayLengthInSeconds
end function

global function dayFractionToHms(atom df) -- returns a Time
    return secondsToHms(dayFractionToSeconds(df))
end function

global function secondsToDayFraction(atom secs) -- returns an atom
    return secs / DayLengthInSeconds
end function

global function hmsToDayFraction(Time hms) -- returns an atom
    return hmsToSeconds(hms) / DayLengthInSeconds
end function

-- Time Math I -- See DateTime Math I

-- Time Math II

global function addToTime(object a, object b) -- returns a Time
    if Time(a) then a = hmsToSeconds(a) end if
    if Time(b) then b = hmsToSeconds(b) end if
    if atom(a) and atom(b) then
	return secondsToHms(a + b)
    end if
    crash_message("Expected atoms or Times as parameters to addToTime()")
end function

global function subFromTime(object a, object b) -- returns a Time
    if Time(a) then a = hmsToSeconds(a) end if
    if Time(b) then b = hmsToSeconds(b) end if
    if atom(a) and atom(b) then
	return secondsToHms(a - b)
    end if
    crash_message("Expected atoms or Times as parameters to subFromTime()")
end function

-- Date Handling ------------------------------------------------------------

-- 'Now'

global function nowDate() -- returns a Date
    sequence now now = date() now[1] += 1900
    return now[1..3]
end function

-- Basic functions

global function isLeap(year_ year) -- returns integer (0 or 1)
    sequence ly
    ly = (remainder(year, {4, 100, 400, 3200, 80000})=0)

    if not ly[1] then return 0 end if

    if year <= Gregorian_Reformation then
	return 1 -- ly[1] can't possibly be 0 here so set shortcut as '1'.

    elsif XLEAP then
	return ly[1] - ly[2] + ly[3] - ly[4] + ly[5]

    else -- Standard Gregorian Calendar
	return ly[1] - ly[2] + ly[3]

    end if
end function

global function daysInMonth(year_ year, month_ month) -- returns a month_
    if year = Gregorian_Reformation and month = 9 then
	return 19
    elsif month != 2 then
	return DaysPerMonth[month]
    else
	return DaysPerMonth[month] + isLeap(year)
    end if
end function

global function daysInYear(year_ year) -- returns a jday_ (355, 365 or 366)
    if year = Gregorian_Reformation then
	return 355
    end if
    return 365 + isLeap(year)
end function

-- Functions using the new data-types

function julianDayOfYear(Date ymd) -- returns an integer
    integer year, month, day
    integer d

    year = ymd[YEAR]
    month = ymd[MONTH]
    day = ymd[DAY]

    if month = 1 then return day end if

    d = 0
    for i = 1 to month - 1 do
	d += daysInMonth(year, i)
    end for

    d += day

    if year = Gregorian_Reformation and month = 9 then
	if day > 13 then
	    d -= 11
	elsif day > 2 then
	    return 0
	end if
    end if

    return d
end function

global function julianDateInYear(JDate yd) -- returns a Date
    integer year, d
    year = yd[YEAR]
    d = yd[JDAY]

    -- guess month
    if d <= daysInMonth(year, 1) then
	return {year, 1, d}
    end if
    for month = 2 to 12 do
	d -= daysInMonth(year, month-1)
	if d <= daysInMonth(year, month) then
	    return {year, month, d}
	end if
    end for

    -- Skip to the next year on overflow
    -- The alternative is a crash, listed below
    return {year+1,1,d-31}

--     crash_message(
--         "julianDateInYear(): Attempt to reference day " &
--             sprintf("%d", yd[JDAY]) &
--         " of " &
--             sprintf("%d", daysInYear(year)) &
--         "-day year " &
--             sprintf("%d", year) &
--         "!"
--     )
end function

global function JDateToDate(object o) -- Converts a JDate to a Date
    return julianDateInYear(o) -- we're just aliasing jDIY here
end function

global function DateToJDate(Date d) -- Converts a Date to a JDate
    return d[YEAR] & julianDayOfYear(d)
end function

global function julianDay(Date ymd) -- returns an integer
    integer year
    integer j, greg00

    year = ymd[YEAR]
    j = julianDayOfYear(ymd)

    year  -= 1
    greg00 = year - Gregorian_Reformation00

    j += (
	365 * year
	+ floor(year/4)
	+ (greg00 > 0)
	    * (
		- floor(greg00/100)
		+ floor(greg00/400+.25)
	    )
	- 11 * (year >= Gregorian_Reformation)
    )

    if XLEAP then
	j += (
	    - (year >=  3200) * floor(year/ 3200)
	    + (year >= 80000) * floor(year/80000)
	)
    end if

    return j
end function

global function julianDayDT(DateTime dt) -- returns an atom
    return julianDay(dt[DT_DATE]) + hmsToDayFraction(dt[DT_TIME])
end function

global function julianDate(integer j) -- returns a Date
    integer year, doy

    -- Take a guesstimate at the year -- this is usually v.close
    if j >= 0 then
	year = floor(j / AverageDaysPerYear) + 1
    else
	year = -floor(-j / 365.25) + 1
    end if

    -- Calculate the day in the guessed year
    doy = j - (julianDay({year, 1, 1}) - 1) -- = j - last day of prev year

    -- Correct any errors

    -- The guesstimate is usually so close that these whiles could probably
    -- be made into ifs, but I haven't checked all possible dates yet... ;)

    while doy <= 0 do -- we guessed too high for the year
	year -= 1
	doy += daysInYear(year)
    end while

    while doy > daysInYear(year) do -- we guessed too low
	doy -= daysInYear(year)
	year += 1
    end while

    return julianDateInYear({year, doy})
end function

global function julianDateTime(atom j) -- returns a DateTime
    atom fj fj = floor(j) j -= fj
    return {julianDate(fj), dayFractionToHms(j)}
end function

-- Date Math I

global function daysDifference(Date past, Date future) -- returns an atom (integer)
    return julianDay(future) - julianDay(past)
end function

global function daysSince(Date past) -- returns an atom (integer)
    Date now now = nowDate()
    return daysDifference(past, now)
end function

global function daysUntil(Date future) -- returns an integer
    return -daysSince(future)
end function

-- Date Math II

global function addToDate(Date a, integer b) -- returns a Date
    return julianDate(julianDay(a) + b)
end function

global function subFromDate(Date a, integer b) -- returns a Date
    return julianDate(julianDay(a) - b)
end function

-- Super-strict types -- also usable as boolean functions

global type ValidDate(object d) if Date(d) and
    equal(d, julianDate(julianDay(d)))
then return 1 end if  return 0  end type

global type ValidDateTime(object dt) if DateTime(dt) and
    ValidDate(dt[DT_DATE]) -- and Time(dt[DT_TIME])
then return 1 end if  return 0  end type

-- Day of week

function clock7(integer number) -- returns an integer (1..7)
    return remainder(number+4094, 7)+1
    -- modulo(number-1, 7)+1 would be better. Hence adding a few multiples
    --   of 7 to the -1 in the remainder() call
end function

global function dayOfWeek(Date ymd) -- returns an integer
    --if DateTime(ymd) then ymd = ymd[DT_DATE] end if
    return clock7(julianDay(ymd)-1)
    -- Sun..Sat = 1..7
end function

global function validDayOfWeek(Date ymd) -- returns an integer
    --if DateTime(ymd) then ymd = ymd[DT_DATE] end if
    if not ValidDate(ymd) then
	return -1
    end if
    return clock7(julianDay(ymd)-1)
    -- Sun..Sat = 1..7
end function

-- DateTime Calculations ----------------------------------------------------

-- 'Now'

global function nowDateTime()
    sequence now now = date() now[1] += 1900
    return {now[1..3], now[4..6]}
end function

-- Conversions to and from seconds

global function DateTimeToSeconds(DateTime dt) -- returns an atom
    return
	+ julianDay(dt[DT_DATE]) * DayLengthInSeconds
	+ hmsToSeconds(dt[DT_TIME])
end function

global function secondsToDateTime(atom seconds) -- returns a DateTime
    integer days

    days = floor(seconds / DayLengthInSeconds)
    seconds = remainder(seconds, DayLengthInSeconds)

    return {julianDate(days), secondsToHms(seconds)}
end function

-- Conversions to and from Dates

global function DateToDateTime(Date d) -- returns a DateTime
    return {d, Time_0}
end function

global function DateTimeToDate(DateTime dt) -- returns a Date
    return dt[DT_DATE] -- Warning! Loss of DT_TIME information!
end function

-- DateTime Math I

global function secondsDifference(object past, object future)
    if Time(past) and Time(future) then
	return hmsToSeconds(future) - hmsToSeconds(past)
    elsif DateTime(past) and DateTime(future) then
	return DateTimeToSeconds(future) - DateTimeToSeconds(past)
    end if
    crash_message("Expected matching DateTimes or Times in secondsDifference()")
end function

global function daysDifferenceDT(DateTime past, DateTime future) -- returns an atom
    return julianDayDT(future) - julianDayDT(past)
end function

global function daysSinceDT(DateTime past) -- returns an atom
    DateTime now now = nowDateTime()
    return daysDifferenceDT(past, now)
end function

global function daysUntilDT(DateTime future) -- returns an atom
    return -daysSinceDT(future)
end function

-- DateTime Math II

global function addSecondsToDateTime(DateTime a, object b) -- returns a DateTime
    if Time(b) then b = hmsToSeconds(b) end if
    if atom(b) then return secondsToDateTime(DateTimeToSeconds(a) + b) end if
    crash_message("Expected an atom or a Time as second parameter in addSecondsToDateTime()")
end function

global function subSecondsFromDateTime(DateTime a, object b) -- returns a DateTime
    if Time(b) then b = hmsToSeconds(b) end if
    if atom(b) then return secondsToDateTime(DateTimeToSeconds(a) - b) end if
    crash_message("Expected an atom or a Time as second parameter in subSecondsFromDateTime()")
end function

global function addToDateTime(object a, object b)
    return addSecondsToDateTime(a,b)
end function

global function subFromDateTime(object a, object b)
    return subSecondsFromDateTime(a,b)
end function

global function addDaysToDateTime(DateTime a, atom b) -- returns a DateTime
    return julianDateTime(julianDayDT(a) + b)
end function

global function subDaysFromDateTime(DateTime a, atom b) -- returns a DateTime
    return julianDateTime(julianDayDT(a) - b)
end function

-- Variable Epoch calculations ----------------------------------------------

global DateTime Epoch
    Epoch = EPOCH_1970 -- set default

global function secondsSinceEpoch(atom seconds) -- returns an atom
    return seconds - DateTimeToSeconds(Epoch)
end function

global function EpochTimeTo1ADTime(atom eseconds) -- returns an atom
    return eseconds + DateTimeToSeconds(Epoch)
end function

-- Generic Booleans ---------------------------------------------------------

function is_(object a, object b)
    if Date(a) then a = {a, Time_0} end if
    if Date(b) then b = {b, Time_0} end if
    return secondsDifference(b, a)
end function

global function isEquivalent(object a, object b)
    return is_(a,b) = 0
end function

global function isBefore(object a, object b)
    return is_(a,b) < 0
end function

global function isAfter(object a, object b)
    return is_(a,b) > 0
end function

-- Generic Conversion Routines ----------------------------------------------

global function ToSeconds(object o) -- returns an atom
    atom secs

    -- Just a number?
    if atom(o) then return o end if

    -- Badly formatted DateTime perhaps?
    if length(o) = 6 then o = {o[1..3],o[4..6]} end if

    -- Maybe a recognised type?
    if Time(o)     then return hmsToSeconds(o) end if
    if Date(o)     then return DateTimeToSeconds({o, Time_0}) end if
    if DateTime(o) then return DateTimeToSeconds(o) end if

    -- Add it all together
    secs = 0
    for i = 1 to length(o) do
	secs += ToSeconds(o[i])
    end for
    return secs
end function

global function ToDateTime(object o) -- returns a DateTime
    return secondsToDateTime(ToSeconds(o))
end function

-- Debug Output -------------------------------------------------------------

global function sDumpDT(object o)
    if Time(o) then
	return sprintf("%02d:%02d:%05.2f", o)
    elsif Date(o) then
	return sprintf("%d-%02d-%02d", o)
    elsif DateTime(o) then
	return sprintf("%d-%02d-%02d @ %02d:%02d:%05.2f", o[DT_DATE] & o[DT_TIME])
    else
	return sDumpDT(ToDateTime(o))
    end if
end function