' DofY.bas, P Lepkowski, 7/9/2018
' tests function DofY(d$) which finds the numeric day of any year
' run it under MMBasic for DOS

GLOBALS:
Option base 1
Dim m%,d%,y%,day$, year%,LeapYear%
' date$="dd-mm-yyyy", time$="hh:mm:ss"

main:
Do
Print "Enter a day, month and year or '0' (zero) to end!"
Input "day"; d%: If (d%<1 Or d%>31) Then Exit Do
Input "month"; m%: If (m%<1 Or m%>12) Then Exit Do
Input "year"; y%: If y%<100 Then y%=2000+y%
day$=Str$(d%,2,0,"0")+"-"+Str$(m%,2,0,"0")+"-"+Str$(y%,4,0,"0")
Print
Print day$+" is the "+ Str$( DofY%(day$) )+" day of the year."
Loop
Print
Print "Today is "+Date$+" which is the "+ Str$( DofY%(Date$) )+" day of the year."
Print
Print "This displays all years from 2000 to 2500 followed by '1' if it is a leap year or '0' if it is not a leap year."
Print "It verifies that 2100, 2200, 2300 and 2500 are not leap years."
Print "Hint: stretch this window horizontally and vertically until you see 20 columns and 25 rows!."
For year%=2000 To 2500
If (year%\100)=(year%/100) Then
LeapYear%=((year%\400)=(year%/400))
Else
LeapYear%=((year%\4)=(year%/4))
EndIf
Print Str$(year%)+" "+Str$(LeapYear%),
Next year%
End

Function DofY%(DofY.dat$) 'accepts date$() or "dd-mm-yyyy"
Local DofY.i%, DofY.d%, DofY.m%, DofY.y%, DofY.LeapY%, DofY.inMo%(12)
' parse DofY.dat$ passed in
DofY.d%=Val(Mid$(DofY.dat$,1,2))
DofY.m%=Val(Mid$(DofY.dat$,4,2))
DofY.y%=Val(Mid$(DofY.dat$,7,4))
' is DofY.Y% a leap year
If (DofY.y%\100)=(DofY.y%/100) Then
DofY.LeapY%=((DofY.y%\400)=(DofY.y%/400))
Else
DofY.LeapY%=((DofY.y%\4)=(DofY.y%/4))
EndIf
' load DofY.inMo%(12) array
If DofY.LeapY%=1 Then Restore DofYleapData Else Restore DofYData
For DofY.i%=1 To 12:Read DofY.inMo%(DofY.i%):Next DofY.i%
' calculate Day of Year
If DofY.m%=1 Then DofY%=DofY.d% Else DofY%=DofY.d%+DofY.inMo%(DofY.m%-1)
End Function 'DofY%

DofYData:
Data 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365

DofYleapData:
Data 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335, 366

''''''''''''''''''''''''''''eof

DOW$(0)="Sunday":DOW$(1)="Monday":DOW$(2)="Tuesday":DOW$(3)="Wednesday"
DOW$(4)="Thursday":DOW$(5)="Friday":DOW$(6)="Saturday"

function DayOfWeek(year, month, day)
a = int((14-month)/12)
m = month + 12*a - 2
y = year - a
DayOfWeek = (day + y + int(y/4)-int(y/100)+int(y/400)+int(31*m/12)) mod 7
end function

SUB BUILD_DATE
YEAR=val(MID$(DATE$,7,4)):MONTH=VAL(MID$(DATE$,4,2)):DAY=val(MID$(DATE$,1,2))
DOW_DAY$=DOW$(DayOfWeek(YEAR,MONTH,DAY)) + ", " + DATE$
CtrlVal(MM_DAD)="THE DATE TODAY IS: "+DOW_DAY$
END SUB

' return days since 01-01-0001 without Julian calendar correction
Function Days(d, m, y)
Local a
a = Int((14-m)/12)
m = m+12*a
y = y-a
Days = 365*y+Int(y/4)-Int(y/100)+Int(y/400)+Int((153*m-457)/5)+d-306
End Function

' return the weekday of the given date
Function WeekDay$(d, m, y)
Local a,w$
a = 7*(Days(d, m, y) Mod 7)+1
w$ = "Sun Mon Tues Wednes Thurs Fri Satur "
WeekDay$ = Mid$(w$,a,Instr(a,w$," ")-a)+"day"
End Function

option base 1
' return days since 01-01-0001 without Julian calendar correction
Function Days(d, m, y)
Local a
a = Int((14-m)/12)
m = m+12*a
y = y-a
Days = 365*y+Int(y/4)-Int(y/100)+Int(y/400)+Int((153*m-457)/5)+d-306
End Function

' return the weekday of the given date
Function WeekDay$(d, m, y)
Local a,w$(7) length 6 =("Sun","Mon","Tues","Wednes","Thurs","Fri","Satur")
' the entire w$() array might still use 256 bytes instead of 49 bytes
a = 7*(Days(d, m, y) Mod 7)+1
WeekDay$ = w$(a)+"day"
End Function

Dim d%,m%,y%,day$="dd-mm-yyyy",DOY%
d%=11:m%=2:y%=1940:DOY%=DofY%():print DOY%,
day$="11-02-1940":DOY%=DofYs%(day$):print DOY%,
DOY%=DofYs%(DATE$):print DOY%,
END

function DofYs%(d$) ' return dayofyear% given DATE$() or "dd-mm-yyyy"
d%=Val(Mid$(d$,1,2)):m%=Val(Mid$(d$,4,2)):y%=Val(Mid$(d$,7,4)):DofYs%=DofY%()
End function 'DofYs%(d$) ' return dayofyear% given DATE$() or "dd-mm-yyyy"

Function DofY%() ' return dayofyear% given globals d%, m%, y%
DofY%= d% + Int((m%-1)*30.57+0.5)
If m%>2 Then
DofY%=DofY%-1
If (y% Mod 4)>0 Then DofY%= DofY%-1 'not leap year
If (y% Mod 100)=0 Then DofY%= DofY%-1 'not leap century
If (y% Mod 400)=0 Then DofY%= DofY%+1 'leap 4th century
EndIf
End Function 'DofY%() ' return dayofyear% given globals d%, m%, y%

Function DofY%()
Local mm%,yy%,a%
a% = Int((14-m%)/12)
mm% = m%+12*a%
yy% = y%-a%
DofY% = 365*yy%+Int(yy%/4)-Int(yy%/100)+Int(yy%/400)+Int((153*mm%-457)/5)+d%-306
End Function

dim DOW$(6) as string

DOW$(0)="Sun":DOW$(1)="Mon":DOW$(2)="Tue":DOW$(3)="Wed":DOW$(4)="Thu":DOW$(5)="Fri":DOW$(6)="Sat"

Year=Val(Mid$(Date$,7,4)):Month=Val(Mid$(Date$,4,2)):Day=Val(Mid$(Date$,1,2))

'dowx1$=DOW$(DayOfWeek(YEAR,MONTH,DAY)) 'DOESN'T DO ANYTHING BECAUSE dowx1$ IS NEVER USED BELOW
'do 'THIS DO DOESN'T DO ANYTHING BECAUSE THERE IS NO LOOP BELOW
print DOW$(DayOfWeek(YEAR,MONTH,DAY))
pause 2000 'YEAR, MONTH, or DAY don't change during this pause
'DATE$ will change if you pass midnight during the pause
'but YEAR, MONTH and DAY still won't change unless you specifically
'set them again with line #2 above
print DOW$(DayOfWeek(YEAR,MONTH,DAY)) '@print 2nd time to see if it changes the day after a pause
end

function DayOfWeek(year, month, day)
print year 'to check if it's correct
print month 'to check if it's correct
print day 'to check if it's correct
local a,m,y
a = int((14-month)/12)
m = month + 12*a - 2
y = year - a
DayOfWeek = (day + y + int(y/4)-int(y/100)+int(y/400)+int(31*m/12)) mod 7
end function

DIM DOW$
DOW$(1)="test" ' this statement should generate an error