' Various Date Routines
'   by Bill Haesslein on 2008-08-24

/* Date and Easter calculations from Marcos J. Montes */

$main
def version$:string
version$="1.0"

autodefine "off"

$INCLUDE "windowssdk.inc"

def BDate, IDate, SDay, BDay[7]:string
def x:int
DEF s:SYSTEMTIME

BDay[0] = "But the child that is born on the Sabbath day Is bonny and blithe, and good and gay"
BDay[1] = "Monday's child is fair of face"
BDay[2] = "Tuesday's child is full of grace"
BDay[3] = "Wednesday's child is full of woe"
BDay[4] = "Thursday's child has far to go"
BDay[5] = "Friday's child is loving and giving"
BDay[6] = "Saturday's child works hard for its living"

/*
Monday's child is fair of face
Tuesday's child is full of grace
Wednesday's child is full of woe
Thursday's child has far to go
Friday's child is loving and giving
Saturday's child works hard for its living
But the child that is born on the Sabbath day Is bonny and blithe, and good and gay
*/

ENUM days
	Sunday = 0
	Monday
	Tuesday
	Wednesday
	Thursday
	Friday
	Saturday
ENDENUM

ENUM Console_Colors
	BLACK = 0
	BLUE
	GREEN
	CYAN
	RED
	MAGENTA
	BROWN
	WHITE
	GRAY
	LBLUE
	LGREEN
	LCYAN
	LRED
	LMAGENTA
	YELLOW
	HIWHITE
ENDENUM

openconsole

IDate = Date$("yyyy-MM-dd")
x = ISODayOfWeek(IDate)
SDay = StringDay(x)

color LCYAN,BLACK
print IDate, " is ", SDay

' 2016-02-02 is a Tuesday
x = DayOfWeek(2023, 12, 12)
x+=99
IDate = ISODate(2023, 12, 12)

'x = DayOfWeek(2016, 02, 02)
'IDate = ISODate(2016, 02, 02)

Sday = StringDay(x)

color LGREEN,BLACK
print IDate, " is ", SDay

color LRED,BLACK
print IDate, " is ",
PrintDay(x)

color HIWHITE,BLACK
' First Monday of Feb 2016
x = NthDayOfMonth(1, Monday, 2016, 2)
print ISODate(2016,2,x), " is the First Monday of Feb 2016"

color LGREEN,BLACK
' Third Wednesday of Feb 2016
x = NthDayOfMonth(3, Wednesday, 2016, 2)
print ISODate(2016,2,x), " is the Third Wednesday of Feb 2016"

color YELLOW,BLACK
' Fifth Wednesday of Feb 2016 (returns -1, since not possible)
x = NthDayOfMonth(5, Tuesday, 2016, 2)
print x, "there is NO Fifth Monday of Feb 2016"

color LCYAN,BLACK
'Last day of Feb 2016
x = LastDayOfMonth(2016, 02)
print x, "is the last day of Feb 2016"

color LGREEN,BLACK
'Last Monday of Feb 2016
x = LastDay(Monday, 2016, 02)
print x, "is the last Monday of Feb 2016"

color LRED,BLACK
'Determine Easter for 2016-03-27
IDate = Easter(2016)
print IDate, " is Easter for 2016"

'Determine Good Friday (2 days before Easter)
print DateMath(IDate,-2), " is Good Friday for 2016"
PRINT

Color HIWHITE,BLACK

'Determine DaysSince
IDate = Date$("yyyy-MM-dd")
Input "Enter Birth Date: ", BDate
IF BDate = "" THEN BDate = "1947-05-07"

x = ISODayOfWeek(BDate)
SDay = StringDay(x)

color LCYAN,BLACK
print "You were born on ", BDate, " which was a ", SDay
PRINT "    ", BDay[x]
PRINT

print "Today's Date: ", IDate

Color HIWHITE,BLACK

x = DaysSince(BDate,IDate)
print "Days Since ", x, " Weeks ", int(x/7), " Days ", x % 7

'Determine YearMonthDay
s = YearMonthDay(BDate,IDate)
PRINT "Years ", s.wYear, " Months ", s.wMonth, " Days ", s.wDay
PRINT

color LGREEN,BLACK

'Last Monday of May 2016
x = LastDay(Monday, 2016, 05)
print ISODate(2016,05,x), " is the last Monday of May 2016 ",
COLOR LRED,BLACK
PRINT "(Memorial Day)"

COLOR LGREEN,BLACK

' 1st Monday of Sept 2016
x = NthDayOfMonth(1, Monday, 2016, 09)
print ISODate(2016,09,x), " is the First Monday of Sept 2016 ",
COLOR LRED,BLACK
print "(Labor Day)"

COLOR LGREEN,BLACK

' 4th Thursday of Nov 2016
x = NthDayOfMonth(4, Thursday, 2016, 11)
print ISODate(2016,11,x), " is the 4th Thursday of Nov 2016 ",
COLOR LRED,BLACK
PRINT "(Thanksgiving)"

COLOR LCYAN,BLACK
input x

closeconsole
end

'___________________________________
SUB ISODayOfWeek(IDate:string),int
'-----------------------------------
def yyyy, mm, dd:int
yyyy = val(mid$(IDate,1,4))
mm = val(mid$(IDate,6,2))
dd = val(mid$(IDate,9,2))
return DayOfWeek(yyyy, mm, dd)
endsub

'__________________________________________
SUB DayOfWeek(yyyy:int, mm:int, dd:int),int
'------------------------------------------
def a, y, m, d:int
a = (14 - mm) / 12
y = yyyy - a
m = mm + (12 * a) - 2
d = dd + y + y / 4 - y / 100 + y / 400 + (31 * m) / 12
d = d - ((d / 7) * 7)
return d
endsub

'____________________________________________________
SUB NthDayOfMonth(q:int, n:int, yyyy:int, mm:int),int
'----------------------------------------------------
def b, c, d:int
b = n - DayOfWeek(yyyy, mm, 1)
IF b < 0 then b = b + 7
c = b - (b / 7) * 7
d = (7 * (q-1)) - 6 + c + 7
IDate = ISODate(yyyy, mm, d)
b = ValDate(IDate)
if b = False then return -1
return d
endsub

'____________________________
SUB ValDate(IDate:string),int
'----------------------------
def y, m, d, v:int
def mo[12]:int
'     1  2  3  4  5  6  7  8, 9,10,11,12
mo = 31,28,31,30,31,30,31,31,30,31,30,31
d = val(mid$(IDate,9,2))
if d < 28 then return True
if d > 31 then return False
m = val(mid$(IDate,6,2))
if m < 1 or m > 12 then return False
if m = 2
	y = val(mid$(IDate,1,4))
	v = y - (y / 100) * 100
	if v = 0
		v  = y - (y / 400) * 400
		if v = 0
			if d < 30 then return True else return False
		endif
	endif
	v = y - (y / 4) * 4
	if v = 0
		mo[1] = 29
	endif
endif
if d <= mo[m-1] then return True else return False
return False
endsub

'___________________________________________
SUB ISODate(yyyy:int, mm:int, dd:int),string
'-------------------------------------------
return using("0####", yyyy) + "-" + using("0##", mm) + "-" + using("0##", dd)
endsub

'___________________________________
SUB LastDayOfMonth(y:int, m:int),int
'-----------------------------------
def v:int
def mo[12]:int
'     1  2  3  4  5  6  7  8, 9,10,11,12
mo = 31,28,31,30,31,30,31,31,30,31,30,31
if m = 2
	v = y - (y / 100) * 100
	if v = 0
		v  = y - (y / 400) * 400
		if v = 0
			return 29
		endif
	endif
	v = y - (y / 4) * 4
	if v = 0
		return 29
	endif
endif
return mo[m-1]
endsub

'__________________________
SUB StringDay(x:int),string
'--------------------------
select x
	case Sunday
			 return "Sunday"
	case Monday
			 return "Monday"
	case Tuesday
			 return "Tuesday"
	case Wednesday
			 return "Wednesday"
	case Thursday
			 return "Thursday"
	case Friday
			 return "Friday"
	case Saturday
			 return "Saturday"
	default
			 return "Unknown " + str$(x)
endselect
return "Unknown " + str$(x)
endsub

'__________________
SUB PrintDay(x:int)
'------------------
select x
	case Sunday
			 print "Sunday"
	case Monday
			 print "Monday"
	case Tuesday
			 print "Tuesday"
	case Wednesday
			 print "Wednesday"
	case Thursday
			 print "Thursday"
	case Friday
			 print "Friday"
	case Saturday
			 print "Saturday"
	default
			 print "Unknown " + str$(x)
endselect
return
endsub

'___________________________________
SUB LastDay(n:int, y:int, m:int),int
'-----------------------------------
def d, t, v:int
d = LastDayOfMonth(y, m)
v = DayOfWeek(y, m, d)
t = v - n
t = t - (t / 7) * 7
v = d - t
if v > d then v -= 7
return v
endsub

'_______________________
SUB Easter(y:int),string
'-----------------------
def century, g, k, i, j, l, EasterMonth, EasterDay:int
century = y / 100
g = y - (y / 19) * 19
k = (century - 17) / 25
i = century - century / 4 - (century - k) / 3 + 19 * g + 15
i = i - (i / 30) * 30
i = i - (i / 28) * (1 - (i / 28) / (i + 1)) * ((21 - g) / 11)
j = y + y / 4 + i + 2 - century + century / 4
j = j - (j / 7) * 7
l = i - j
EasterMonth = 3 + (l + 40) / 44
EasterDay = L + 28 - 31 * (EasterMonth / 4)
return ISODate(y, EasterMonth, EasterDay)
endsub

'______________________________________
SUB DateMath(id:string,diff:int),string
'--------------------------------------
TYPE DateType
	DEF LowDW:UINT
	DEF HighDW:UINT
END TYPE

UNION uDT
	DEF qVar:UINT64
	DEF dtVar:DateType
END UNION

DEF st:SYSTEMTIME
DEF ft:FILETIME
DEF u:uDT
DEF rtn:INT

' First get the system time so that all the other structure members are filled.
GetSystemTime(st)
'Setup the SYSTEMTIME structure with the original date like so:
st.wYear = val(mid$(id,1,4))
st.wMonth = val(mid$(id,6,2))
st.wDay = val(mid$(id,9,2))
'PRINT USING("Original date = 0##/0##/0####", st.wMonth, st.wDay, st.wYear)

' Convert the system time to file time.
rtn = SystemTimeToFileTime(st, ft)

' Move the FILETIME info into a UINT64 variable
' and add days using the Quad variable. (This is how M$ recommends doing it)
u.dtVar.LowDW = ft.dwLowDateTime
u.dtVar.HighDW = ft.dwHighDateTime

'Add days using the Quad variable.
' 1 day in nano seconds 24 * 60 * 60 * 10000000
u.qVar += ((24 * 60 * 60 * 10000000) * diff)		'<---- diff days

ft.dwLowDateTime = u.dtVar.LowDW
ft.dwHighDateTime = u.dtVar.HighDW

' Convert the file time to system time.
rtn = FileTimeToSystemTime(ft, st)

' Now your new date will be in the SYSTEMTIME structure members.
return ISODate(st.wYear, st.wMonth, st.wDay)

endsub

'___________________________________________
SUB DaysSince(sdate:string,edate:string),INT
'-------------------------------------------
TYPE DateType
	DEF LowDW:UINT
	DEF HighDW:UINT
END TYPE

UNION uDT
	DEF qVar:UINT64
	DEF dtVar:DateType
END UNION

DEF tdate:STRING
DEF st:SYSTEMTIME
DEF ft:FILETIME
DEF s,e,d:uDT
DEF iVar,rtn:INT

' Make sure that edate > sdate
IF edate > sdate
	tdate = ""
else
	tdate = sdate
	sdate = edate
	edate = tdate
endif

' First get the system time so that all the other structure members are filled.
GetSystemTime(st)
'Setup the SYSTEMTIME structure with the original date like so:
st.wYear = val(mid$(sdate,1,4))
st.wMonth = val(mid$(sdate,6,2))
st.wDay = val(mid$(sdate,9,2))
'PRINT USING("Original date = 0##/0##/0####", st.wMonth, st.wDay, st.wYear)

' Convert the system time to file time.
rtn = SystemTimeToFileTime(st, ft)

' Move the FILETIME info into a UINT64 variable
' and add days using the Quad variable. (This is how M$ recommends doing it)
s.dtVar.LowDW = ft.dwLowDateTime
s.dtVar.HighDW = ft.dwHighDateTime

' First get the system time so that all the other structure members are filled.
GetSystemTime(st)
'Setup the SYSTEMTIME structure with the original date like so:
st.wYear = val(mid$(edate,1,4))
st.wMonth = val(mid$(edate,6,2))
st.wDay = val(mid$(edate,9,2))
'PRINT USING("Original date = 0##/0##/0####", st.wMonth, st.wDay, st.wYear)

' Convert the system time to file time.
rtn = SystemTimeToFileTime(st, ft)

' Move the FILETIME info into a UINT64 variable
' and add days using the Quad variable. (This is how M$ recommends doing it)
e.dtVar.LowDW = ft.dwLowDateTime
e.dtVar.HighDW = ft.dwHighDateTime

d.qVar = e.qVar - s.qVar

iVar = d.qVar / (24 * 60 * 60 * 10000000)

return iVar

endsub

'_______________________________________________
SUB YearMonthDay(d1:STRING,d2:STRING),SYSTEMTIME
'-----------------------------------------------
DEF monthDay[13]:INT
DEF st,en,diff:SYSTEMTIME
DEF dt:STRING
DEF increment:INT

'PRINT "d1 ", d1, " d2 ", d2

monthDay = 0, 31, -1, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31

IF d2 > d1
	dt = ""
ELSE
	dt = d2
	d2 = d1
	d1 = dt
ENDIF

'PRINT "d1 ", d1, " d2 ", d2, " dt ", dt

st.wYear = val(mid$(d1,1,4))
st.wMonth = val(mid$(d1,6,2))
st.wDay = val(mid$(d1,9,2))

en.wYear = val(mid$(d2,1,4))
en.wMonth = val(mid$(d2,6,2))
en.wDay = val(mid$(d2,9,2))

increment = 0
IF st.wDay > en.wDay THEN increment = monthDay[st.wMonth - 1]

IF increment = -1
	IF IsLeapYear(st.wYear)
		increment = 29
	ELSE
		increment = 28
	ENDIF
ENDIF

IF increment <> 0
	diff.wDay = (en.wDay + increment) - st.wDay
	increment = 1
ELSE
	diff.wDay = en.wDay - st.wDay
ENDIF

IF (st.wMonth + increment) > en.wMonth
	diff.wMonth = (en.wMonth + 12) - (st.wMonth + increment)
	increment = 1
ELSE
	diff.wMonth = en.wMonth - (st.wMonth + increment)
	increment = 0
ENDIF

diff.wYear = en.wYear - (st.wYear + increment)

RETURN diff
ENDSUB

'___________________________
SUB IsLeapYear(year:INT),INT
'---------------------------
select 0
	case year%400
    RETURN true
  case year%100
    return false
  case year%4
    return true
  default
		return false
endselect
RETURN false
ENDSUB