' History:
' v0.0 1986/??/?? Created as F-BASIC program
' v0.1 2010/02/08 Converted to Small Basic Program (107 lines)
' v0.2 2011/05/03 Rewrote for Edo clock (123 lines)
' v0.3 2012/07/28 Rewrote for Sundial (123 lines)
' Main
Cal_Init()
lRestart:
TextWindow.Write("Year,month? ")
sBuf = TextWindow.Read()
Command_GetArgs()
iYear = sArg[1]
if iYear = "" Then
Goto lEnd
Endif
If iYear < 1 Then
Goto lRestart
Endif
If Math.Remainder(iYear, 4) = 0 And Math.Remainder(iYear, 100) > 0 Or Math.Remainder(iYear, 400) = 0 Then
iDoM[2] = iDoM[2] + 1
Endif
iNoL = Math.Floor((iYear - 1) / 4) - Math.Floor((iYear - 1) / 100) + Math.Floor((iYear - 1) / 400) ' number of leap year
iWoY = Math.Remainder((iYear + iNoL), 7) ' week of year
iMonth = sArg[2]
If iMonth = "" Then
iM0 = 1
iM1 = 12
Else
If iMonth < 1 Or iMonth > 12 Then
Goto lRestart
EndIf
iM0 = iMonth
iM1 = iMonth
Endif
iDoY = 0 ' days of year
iNoM = 1 ' number of month
For iM = iM0 To iM1
While iNoM < iM
iDoY = iDoY + iDoM[iNoM]
iNoM = iNoM + 1
EndWhile
Cal_PrintMonth()
EndFor
lEnd:
Sub Cal_Init
' Calender | Initialize days of month
iDoM = "1=31;2=28;3=31;4=30;5=31;6=30;7=31;8=31;9=30;10=31;11=30;12=31;"
EndSub
Sub Cal_PrintMonth
' Calender | Print month
' param iM - month
' param iDoY - days of year
' param iWoY - week of year
iW = Math.Remainder((iDoY + iWoY), 7)
TextWindow.Write(" ")
If iYear < 10 Then
TextWindow.Write(" " + iYear)
ElseIf iYear < 100 Then
TextWindow.Write(" " + iYear)
ElseIf iYear < 1000 Then
TextWindow.Write(" " + iYear)
Else
TextWindow.Write(iYear)
EndIf
TextWindow.Write(" ")
If iM < 10 Then
TextWindow.WriteLine(" " + iM)
Else
TextWindow.WriteLine(iM)
EndIf
TextWindow.WriteLine("")
TextWindow.WriteLine("SUN MON TUE WED THU FRI SAT")
iWoM = 0
While iWoM < iW
TextWindow.Write(" ")
iWoM = iWoM + 1
EndWhile
For iD = 1 To iDoM[iM]
If iD < 10 Then
TextWindow.Write(" " + iD + " ")
Else
TextWindow.Write(" " + iD + " ")
EndIf
If Math.Remainder(iWoM, 7) = 6 Then
TextWindow.WriteLine("")
EndIf
iWoM = iWoM + 1
EndFor
If Math.Remainder(iWoM, 7) > 0 Then
TextWindow.WriteLine("")
EndIf
TextWindow.WriteLine("")
EndSub
Sub Command_GetArgs
' Command line | Get arguments
' param sBuf - input buffer
' return sArg[] - arguments
' return iN - number of arguments
iP = 1 ' buffer pointer
iN = 1 ' number of args
iC = Text.GetIndexOf(sBuf, ",") ' index of comma
While iC > iP
sArg[iN] = Text.GetSubText(sBuf, iP, iC - iP)
iP = iC + 1
iN = iN + 1
iC = Text.GetIndexOf(sBuf, ",")
EndWhile
iE = Text.GetLength(sBuf) + 1 ' end of buffer
sArg[iN] = Text.GetSubText(sBuf, iP, iE - iP)
EndSub
Program Listing: MTW971