' version 17-02-2016
' compile with: fbc -s console

' TRUE/FALSE are built-in constants since FreeBASIC 1.04
' For older versions they have to be defined.
#Ifndef TRUE
    #Define FALSE 0
    #Define TRUE Not FALSE
#EndIf

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

Function LEAPYEAR(y As Integer) As Integer
    If (y Mod 4) <> 0 Then Return FALSE
    If (y Mod 100) = 0 AndAlso (y Mod 400) <> 0 Then Return FALSE
    Return TRUE
End Function

' ------=< main >=------

Dim As String wdn = "Mo Tu We Th Fr Sa Su"  ' weekday names
Dim As String mo(1 To 12) => {"January", "February", "March", "April", _
                         "May", "June", "July", "August", "September", _
                                    "October", "November", "December"}
Dim As String tmp1, tmp2, d(1 To 12)

Dim As UInteger ml(1 To 12) => {31,28,31,30,31,30,31,31,30,31,30,31}
Dim As UInteger i, i1, j, k, y = 1969
Dim As UInteger m_row = 6

Do
    While InKey <> "" : Wend  ' clear keyboard buffer
    Print : Print " For wich year do want a calendar"
    Print " Year must be greater then 1752"
    Input " Input year (enter = 1969)";tmp1
    If tmp1 = "" Then Exit Do
    i = Val(tmp1)
    If i < 1752 Then
        Print
        Print " Can only make a calendar for a year after 1752"
        Beep : Sleep 5000, 1 : Print
    Else
        y = i : Exit Do
    End If
Loop

Cls
Do
    While InKey <> "" : Wend  ' clear keyboard buffer
    Print : Print " Make device choice"
    Print " 132 characters Line printer, 6x2 months (Enter or 1)"
    Print " 80x43 display,               3x4 months          (2)"
    Do
        tmp1 = InKey
        If tmp1 = Chr(13) Or tmp1 = "1" Then Exit Do, Do
        If tmp1 = "2" Then
            m_row = 3
            Exit Do, Do
        End If
    Loop Until tmp1 <> ""
    Print : Print " Enter, 1 or 2 only"
    Beep : Sleep 5000, 1 : Print
Loop
Cls

Dim As UInteger char_line = m_row * 22 - 1
If LEAPYEAR(y) = TRUE Then ml(2) = 29

tmp1 = ""
For i = 1 To 31
    tmp1 = tmp1 + Right(("  " + Str(i)), 3)
Next

For i = 1 To 12
    tmp2 = ""
    j = WD(i,1, y)
    If j = 0 Then j = 7
    j = j - 1
    tmp2 = Space(j * 3) + Left(tmp1, ml(i) * 3) + Space(21)
    d(i) = tmp2
Next

Print
tmp1 = Str(y)
Print Space((char_line + (char_line And 1) - Len(tmp1)) \ 2); tmp1
Print

tmp2 = " "    ' make the weekday names line
For i = 1 To m_row
    tmp2 = tmp2 + wdn
    If i < m_row Then tmp2 = tmp2 + "  "
Next

For i = 1 To 12 Step m_row
    tmp1 = ""
    For j = i To i + m_row -2 ' make the month names line
        tmp1 = tmp1 + Left(Space((22 - Len(mo(j))) \ 2) + mo(j) + Space(21), 22)
    Next
    tmp1 = tmp1 + Space((22 - Len(mo(i + m_row -1))) \ 2) + mo(i + m_row -1)
    Print tmp1
    Print tmp2
    For j = 1 To 85 Step 21
        For k = i To i + m_row -2
            Print Mid(d(k), j ,21); " ";
        Next
        Print Mid(d(i + m_row -1), j ,21)
    Next
    Print
Next

' empty keyboard buffer
While InKey <> "" : Wend
'Print : Print "hit any key to end program
Sleep
End