126 lines
3.3 KiB
Plaintext
126 lines
3.3 KiB
Plaintext
' 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
|