62 lines
1.7 KiB
Plaintext
62 lines
1.7 KiB
Plaintext
' version 23-06-2015
|
|
' compile with: fbc -s console
|
|
|
|
Function wd(m As Integer, d As Integer, y As Integer) As Integer
|
|
' Zellerish
|
|
' 0 = Sunday, 1 = Monday, 2 = Tuesday, 3 = Wednesday
|
|
' 4 = Thursday, 5 = Friday, 6 = Saturday
|
|
|
|
If m < 3 Then ' If m = 1 Or m = 2 Then
|
|
m += 12
|
|
y -= 1
|
|
End If
|
|
Return (y + (y \ 4) - (y \ 100) + (y \ 400) + d + ((153 * m + 8) \ 5)) Mod 7
|
|
End Function
|
|
|
|
' ------=< MAIN >=------
|
|
' only months with 31 day can have five weekends
|
|
' these months are: January, March, May, July, August, October, December
|
|
' in nr: 1, 3, 5, 7, 8, 10, 12
|
|
' the 1e day needs to be on a friday (= 5)
|
|
|
|
Dim As String month_names(1 To 12) => {"January","February","March",_
|
|
"April","May","June","July","August",_
|
|
"September","October","November","December"}
|
|
Dim As Integer m, yr, total, i, j, yr_without(200)
|
|
Dim As String answer
|
|
|
|
For yr = 1900 To 2100 ' Gregorian calendar
|
|
answer = ""
|
|
For m = 1 To 12 Step 2
|
|
If m = 9 Then m = 8
|
|
If wd(m , 1 , yr) = 5 Then
|
|
answer = answer + month_names(m) + ", "
|
|
total = total + 1
|
|
End If
|
|
Next
|
|
If answer <> "" Then
|
|
Print Using "#### | "; yr;
|
|
Print Left(answer, Len(answer) -2) ' get rid of extra " ,"
|
|
Else
|
|
i = i + 1
|
|
yr_without(i) = yr
|
|
End If
|
|
Next
|
|
|
|
Print
|
|
Print "nr of month for 1900 to 2100 that has five weekends";total
|
|
Print
|
|
Print i;" years don't have months with five weekends"
|
|
|
|
For j = 1 To i
|
|
Print yr_without(j); " ";
|
|
If j Mod 8 = 0 Then Print
|
|
Next
|
|
Print
|
|
|
|
' empty keyboard buffer
|
|
While InKey <> "" : Wend
|
|
Print : Print "hit any key to end program"
|
|
Sleep
|
|
End
|