Microsoft Small Basic

Program Listing: HRT547-3
' Edo Clock v0.5 - (C) 2011 Nonki Takahashi

' History:
' v0.1 2011/04/27 Created from Analog Clock v0.1 SGP929 (236 lines HRT547)
' v0.2 2011/04/07 Online version (236 lines HRT547-0)
' v0.3 2011/06/03 Implemented temporal hour system (234 lines HRT547-1)
' v0.4 2011/06/05 Created Edo_AlphaToAke6AndKure6() (278 lines HRT547-2)
' v0.5 2011/06/06 Supported calculation from date to Alpha (646 lines HRT547-3)

' Reference:
' [1] Ichiro Oda "Tokei No Daikenkyu" 2004 PHP Institute
' 織田一朗『時計の大研究』2004 PHP研究所
' [2] National Astronomical Observatory of Japan "Rika Nenpyo Heisei 23 Nen" 2010 Maruzen
' 国立天文台編『理科年表 平成23年』2010 丸善
' [3] Koyomi No Kai "Encyclopedia of Calender" 1986 Shinjinbutsu Ourai Sha
' 暦の会編『暦の百科事典』1986 新人物往来社

' Main
sVersion = "v0.5"
GraphicsWindow.Title = "Edo Clock " + sVersion
rLocal = 9 ' local time for Japan
Cal_Init() ' calender initialization
Lex_Init() ' lex initialization
Astron_Init() ' astronomy initialization
Cal_GetDate()
Astron_DateToAlpha()
Edo_Init() ' Edo clock initialization
Edo_AlphaToAke6AndKure6()
Clock_Init() ' clock initialization
Digital_Init() ' digital clock initialization
Alarm_Init() ' alarm initialization
Analog_Init() ' analog clock initializaton
Analog_DrawHourNumerals()
While "True"
If bTick Then
Digital_ShowTime()
Digital_ShowDate()
Analog_RotateHourHand()
Alarm_Ring()
bTick = "False"
Else
Program.Delay(500)
EndIf
EndWhile

' Alarm | Initialization
Sub Alarm_Init
iAX = 18 ' character size for alarm
iAY = 26
iAL0 = 11 ' alarm y position in line
GraphicsWindow.FontSize = iAY
GraphicsWindow.BrushColor = sFGColor
GraphicsWindow.BackgroundColor = sBGColor
GraphicsWindow.DrawText(iAX * 3, iAY * iAL0, "ALARM:")
GraphicsWindow.DrawText(iAX * 21, iAY * iAL0, ":")
GraphicsWindow.BrushColor = "Black"
oHour = Controls.AddTextBox(iAX * 11, iAY * iAL0)
oMin = Controls.AddTextBox(iAX * 23, iAY * iAL0)
GraphicsWindow.Height = iAY * (iAL0 + 2.5)
EndSub

' Alarm | Ring
Sub Alarm_Ring
iAHour = Controls.GetTextBoxText(oHour)
iAMin = Controls.GetTextBoxText(oMin)
If (iHour = iAHour) And (iMin = iAMin) Then
Sound.PlayChimesAndWait()
EndIf
EndSub

' Analog | Draw hour numerals
' in: rAke6, rKure6 - ake 6 and kure 6 [JST hour]
' in: iHX, iHY - font size for hour numerals
Sub Analog_DrawHourNumerals
GraphicsWindow.BrushColor = sFGColor
GraphicsWindow.FontSize = iHY
For iHour = 0 To 22 Step 2
If iHour > 9 Then
idX = - iHX
Else
idX = - iHX / 2
EndIf
rHour = iHour
Edo_HourToRadian()
iX = iXC - Math.Round(iR * 1.1 * Math.Sin(rEdoRadian) - idX)
iY = iYC + Math.Round(iR * 1.1 * Math.Cos(rEdoRadian) - iHY / 2)
GraphicsWindow.DrawText(iX, iY, iHour)
EndFor
EndSub

' Analog | Initialization
Sub Analog_Init
' time table initialization
sCity[9] = "Tokyo"
rDelta[9] = 9
iCities = 24
' selected city
iCity = 9
GraphicsWindow.BrushColor = sFGColor
If rDelta[iCity] > 0 Then
sSign = "+"
Else
sSign = ""
EndIf
GraphicsWindow.DrawText(iAX * 3 + iTX0, iAY * 7, sCity[iCity] + " (" + sSign + rDelta[iCity] + ")")
' show clock face
iR = 100 ' radius for analog clock face
iXC = 50 + iR ' center of analog clock
iYC = 40 + iR
uDialPlate = uFolder + "EdoDialPlate.png"
GraphicsWindow.DrawImage(uDialPlate, iXC - iR, iYC - iR)
' add hour hand as shape
uHour = uFolder + "EdoHourHand.png"
oHour = Shapes.AddImage(uHour)
Shapes.Move(oHour, iXC - iR, iYC - iR)
EndSub

' Analog | Rotate hour hand
' in: iHour, iMin, iSec - current hour, minute, second [JST]
Sub Analog_RotateHourHand
rHour = iHour + iMin / 60 + iSec / 3600
Edo_HourToRadian()
rEdoDegree = Math.GetDegrees(rEdoRadian)
rDegree = rEdoDegree + 12 * 360 / 24
Shapes.Rotate(oHour, rDegree)
EndSub

' Astronomy | Convert date to alpha (heriocentric longitude)[degree]
' in: sDate - "yyyy/mm/dd" (JST)
' work: rAreaVelocity - area velocity [km^2]
' out: rAlphaDegree - sun angle 0..360 [degree]
' 0[degree] - the vernal equinox
' 90[degree] - the summer solstice
' 180[degree] - the autumnal equinox
' 270[degree] - the winter solstice
Sub Astron_DateToAlpha
sBuf = sDate
iBufPtr = 1
Parse_GetDate() ' get iDaysIn2011
rDays = iDaysIn2011 + 0.5 - rNearDate
rAreaVelocity = rAreaPerYear * rDays / rDaysPerYear
' rThetaC is calculated as if Earth orbit is circle
rThetaC = rDays * 360 / rDaysPerYear
' rDegree is calculated as if Earth orbit is circle
rDegree = rThetaC
rAlphaDegree = rDegree - rSEDegree
EndSub

' Astronomy | Initialization
' out: rA - Earth orbit major radius (mean radius) [km]
' out: rB - Earth orbit minor radius [km]
' out: rE - eccentricity of Earth orbit
' out: rL - distance between Sun and orbit on line parallel to minor axis [km]
' out: rAreaPerYear - velocity area / solar year [km^2/year]
' out: rDaysPerYear - days / solar year [day/year]
' work: rNearDegree - perihelion degree from spring equinox (nearest point)
' out: rNearDays - days between winter solistice and perihelion [day]
' work: rSEDate - "2011/03/21 08:21:00" spring equinox date (JST) [day]
' out: rNearDate - perihelion date and time (JST) [day]
Sub Astron_Init
rA = 1.496 * Math.Power(10, 8)
rE = 0 ' assumes circle orbit (real ellipse orbit case: 0.0167)
rB = rA * Math.SquareRoot(1 - Math.Power(rE, 2))
rL = rA * (1 - Math.Power(rE, 2))
rAreaPerYear = rA * rB * Math.Pi
rDaysPerYear = 365.24219
rNearDegree = 180 + 102.976
rSEDegree = 360 - rNearDegree
rSERadian = Math.GetRadians(rSEDegree)
rRSE = rL / (1 + rE * Math.Cos(rSERadian)) ' distance between Sun and Earth in spring equinox
rNumarator = rA * rRSE * Math.Sin(rSERadian) / rB
rDenominator = rA * rE + rRSE * Math.Cos(rSERadian)
rTanCSE = rNumarator / rDenominator
rCSERadian = Math.ArcTan(rTanCSE) ' center angle of spring equinox
rCSEDegree = Math.GetDegrees(rCSERadian)
rAFanECN = rA * rB * rCSERadian / 2 ' area of fan ECN
rATriECS = rA * rE * rRSE * Math.Sin(rSERadian) / 2 ' area of triangle ECS
rSEArea = rAFanECN - rATriECS
rSEDays = rSEArea * rDaysPerYear / rAreaPerYear
sBuf = "2011/03/21" ' spiring equinox date in 2011
iBufPtr = 1
Parse_GetDate()
sBuf = "08:21:00" ' spring equinox time in 2011
iBufPtr = 1
Parse_GetTime()
rSEDate = iDaysIn2011 + rDays
rNearDate = rSEDate - rSEDays
EndSub

' Calender | Format date
Sub Cal_FormatDate
sDate = iYear + "/"
If iMonth < 10 Then
sDate = sDate + "0"
EndIf
sDate = sDate + iMonth + "/"
If iDay < 10 Then
sDate = sDate + "0"
EndIf
sDate = sDate + iDay
EndSub

' Caleder | Get date today
' out: sDate - "yyyy/mm/dd" today
Sub Cal_GetDate
iYear = Clock.Year
iMonth = Clock.Month
iDay = Clock.Day
Cal_FormatDate()
EndSub

' Calender | Get leap from year
Sub Cal_GetLeapFromYear
If Math.Remainder(iYear, 4) = 0 And Math.Remainder(iYear, 100) > 0 Or Math.Remainder(iYear, 400) = 0 Then
iDoM[2] = 29
Else
iDoM[2] = 28
Endif
iNoL = Math.Floor((iYear - 1) / 4) - Math.Floor((iYear - 1) / 100) + Math.Floor((iYear - 1) / 400) ' number of leap year
EndSub

' Calender | Initialize days of month
Sub Cal_Init
iDoM[1] = 31
iDoM[2] = 28
iDoM[3] = 31
iDoM[4] = 30
iDoM[5] = 31
iDoM[6] = 30
iDoM[7] = 31
iDoM[8] = 31
iDoM[9] = 30
iDoM[10] = 31
iDoM[11] = 30
iDoM[12] = 31
EndSub

' Clock | Initialization
Sub Clock_Init
sBGColor = "Sienna" ' background color
sFGColor = "White" ' foreground color
sHourHandColor = "DarkGoldenrod" ' hour hand color
sHourHandFrame = "Goldenrod" ' hour hand frame color
Timer.Interval = 1000
Timer.Tick = Clock_OnTick
bTick = "False"
iDaySec = 24 * 60 * 60
iHourSec = 60 * 60
uFolder = "http://homepage2.nifty.com/nobukit/smallbasic.files/"
uWood = uFolder + "Wood.png"
GraphicsWindow.DrawImage(uWood, 0, 0)
EndSub

' Clock | Event processing on tick
Sub Clock_OnTick
iHour = Clock.Hour
iMin = Clock.Minute
iSec = Clock.Second
iYear = Clock.Year
iMonth = Clock.Month
iDay = Clock.Day
bTick = "True"
EndSub

' Clock | Format time
Sub Clock_FormatTime
sTime = iHour
If iHour < 10 Then
sTime = Text.Append("0", sTime)
EndIf
sTime = Text.Append(sTime, ":")
If iMin < 10 Then
sTime = sTime + "0"
EndIf
sTime = sTime + iMin + ":"
If iSec < 10 Then
sTime = sTime + "0"
EndIf
sTime = sTime + iSec
EndSub

' Digital | Initialization
Sub Digital_Init
iTX = 6 * 6 ' character size for time
iTY = 10 * 6
iTX0 = 260
iHX = 9 ' character size for hour numerals
iHY = 13
iDX = 18 ' character size for date
iDY = 26
Clock_OnTick()
Cal_FormatDate()
GraphicsWindow.FontSize = iDY
GraphicsWindow.BrushColor = sFGColor
oDate = Shapes.AddText(sDate)
Shapes.Move(oDate, iDX * 3 + iTX0, iDY * 5 - 3)
Clock_FormatTime()
GraphicsWindow.FontSize = iTY
oTime = Shapes.AddText(sTime)
Shapes.Move(oTime, iTX * 1.4 + iTX0, iTY - 3)
EndSub

' Digital | Show date
Sub Digital_ShowDate
Cal_FormatDate()
Shapes.SetText(oDate, sDate)
EndSub

' Digital | Show time
Sub Digital_ShowTime
Clock_FormatTime()
Shapes.SetText(oTime, sTime)
EndSub

' Edo | Convert alpha to ake 6 and kure 6
' in: rAlphaDegree - ecliptic longitude [degree]
' out: rAke6 - Edo ake (morning) 6 [JST hour]
' out: rKure6 - Edo kure (evening) 6 [JST hour]
Sub Edo_AlphaToAke6AndKure6
rCosT = Math.Cos(Math.GetRadians(rTiltDegree))
rTanA = Math.Tan(Math.GetRadians(rAlphaDegree))
rADashRadian = Math.ArcTan(rTanA * rCosT)
If rAlphaDegree > 270 Then
rADashRadian = rADashRadian + 2 * Math.Pi
ElseIf rAlphaDegree >= 90 Then
rADashRadian = rADashRadian + Math.Pi
EndIf
rAlphaDash = Math.GetDegrees(rADashRadian) ' north pole view of ecliptic longitude [degree]
rNorth = Math.Sin(Math.GetRadians(rTiltDegree)) ' distance from north pole to ecliptic latitude 90 degree [equatorial radius]
rNumerator = 1 - Math.Power(Math.Cos(rADashRadian), 2)
rDenominator = 1 / Math.Power(rNorth, 2) - Math.Power(Math.Cos(rADashRadian), 2)
rSquareB = rNumerator / rDenominator ' b^2 (while b = semiminor axis of shadow)
rShadowE = Math.SquareRoot(1 - rSquareB) ' eccentricity of shadow
rRadiusTokyo = Math.Cos(Math.GetRadians(rLatTokyo)) ' radius for same latitude of Tokyo [equatorial radius]
rNumerator = Math.SquareRoot(1 - rSquareB / Math.Power(rRadiusTokyo, 2))
rQuotient = rNumerator / rShadowE
rSunriseRadian = Math.ArcCos(rQuotient) ' sunrise angle from 6 a.m. [degree]
If rAlphaDash > 180 Then
rSunriseRadian = (-1) * rSunriseRadian
EndIf
rSunriseDegree = Math.GetDegrees(rSunriseRadian) ' sunrise angle from 6 a.m. [degree]
rAke6Degree = 90 - rSunriseDegree - rFactor - (rLongTokyo - rLongAkashi)
rKure6Degree = 270 + rSunriseDegree + rFactor - (rLongTokyo - rLongAkashi)
rAke6 = rAke6Degree * 24 / 360
rKure6 = rKure6Degree * 24 / 360
EndSub

' Edo | Convert JST hour to Edo radians
' in: rHour - [0..24) [JST hour]
' in: rAke6 - Edo ake (morning) 6 [JST hour]
' in: rKure6 - Edo kure (evening) 6 [JST hour]
' work: rAkatsuki9 - Edo akatsuki (before dawn) 9 (midnight) [JST hour]
' work: rHiru9 - Edo hiru (noon) 9 [JST hour]
' out: rEdoRadian - Edo clock radian for given JST hour
Sub Edo_HourToRadian
rHiru9 = (rAke6 + rKure6) / 2
rAkatsuki9 = rHiru9 + 12
If rAkatsuki9 >=24 Then
rAkatsuki9 = rAkatsuki9 - 24
EndIf
rYoruHanToki = (rAke6 + 24 - rKure6) / 12 ' Yoru (night) han (half) toki = about 1 hour
rHiruHanToki = (rKure6 - rAke6) / 12 ' Hiru (day) han (half) toki = about 1 hour
If rHour < rAke6 Then
rEdoHour = (rHour - rAkatsuki9 + 24) / rYoruHanToki
ElseIf rHour = rAke6 Then
rEdoHour = 6
ElseIf rHour > rAke6 And rHour < rKure6 Then
rEdoHour = 6 + (rHour - rAke6) / rHiruHanToki
ElseIf rHour = rKure6 Then
rEdoHour = 18
ElseIf rHour > rKure6 Then
rEdoHour = 18 + (rHour - rKure6) / rYoruHanToki
EndIf
rEdoRadian = (rEdoHour - 1) * 2 * 3.14159 / 24
EndSub

' Edo | Initialize constants
Sub Edo_Init
rFactor = 2.5 * 360 / 100 ' angle between sunrise and ake 6 [degree]
rTiltDegree = 23.44 ' inclination of equator to orbit [degree]
rLatTokyo = 35 + 39 / 60 + 29.1572 / 3600 ' latitude of Tokyo [degree]
rLongTokyo = 139 + 44 / 60 + 28.8759 / 3600 ' longitude of Tokyo [degree]
rLongAkashi = 135 ' longitude of Akashi (Japan Standard Time) [degree]
EndSub

' Lex | Get digit
' in: sBuf - buffer
' in/out: iBufPtr - buffer pointer
' out: cDigit - digit
' out: bMatched - is digit
Sub Lex_GetDigit
cDigit = Text.GetSubText(sBuf, iBufPtr, 1)
iCode = Text.GetCharacterCode(cDigit)
If iCode >= DIGIT0 And iCode <= DIGIT9 Then
bMatched = "True"
iBufPtr = iBufPtr + 1
Else
bMatched = "False"
EndIf
EndSub

' Lex | Get colon
' in: sBuf - buffer
' in/out: iBufPtr - buffer pointer
' work: c - colon
' out: bMatched - is colon
Sub Lex_GetColon
c = Text.GetSubText(sBuf, iBufPtr, 1)
If c = ":" Then
bMatched = "True"
iBufPtr = iBufPtr + 1
Else
bMatched = "False"
EndIf
EndSub

' Lex | Get slash
' in: sBuf - buffer
' in/out: iBufPtr - buffer pointer
' work: c - slash
' out: bMatched - is slash
Sub Lex_GetSlash
c = Text.GetSubText(sBuf, iBufPtr, 1)
If c = "/" Then
bMatched = "True"
iBufPtr = iBufPtr + 1
Else
bMatched = "False"
EndIf
EndSub

' Lex | Initialization
' out: DIGIT0, DIGIT9 - char code for "0", "9"
Sub Lex_Init
DIGIT0 = Text.GetCharacterCode("0")
DIGIT9 = Text.GetCharacterCode("9")
EndSub

' Parse | Get two digits
' in: sBuf - buffer
' in/out: iBufPtr - buffer pointer
' work: iSavedPtr - saved buffer pointer
' out: iNum - two digits
' out: bMatched - is two digits
Sub Parse_Get2Digits
iSavedPtr = iBufPtr
Lex_GetDigit() ' 10
If bMatched = "False" Then
Goto lGet2DigitsExit
EndIf
iNum = cDigit
Lex_GetDigit() ' 1
If bMatched = "False" Then
iBufPtr = iSavedPtr
Goto lGet2DigitsExit
EndIf
iNum = iNum * 10 + cDigit
lGet2DigitsExit:
EndSub

' Parse | Get date
' in: sBuf - buffer
' in/out: iBufPtr - buffer pointer
' work: iDatePtr - saved buffer pointer
' out: iDaysIn2011 - days from 2011/01/01 00:00:00
' out: bMatced - is date
Sub Parse_GetDate
iDatePtr = iBufPtr
Parse_GetYear()
If bMatched = "False" Then
Goto lGetDateExit
EndIf
Lex_GetSlash()
If bMatched = "False" Then
iBufPtr = iDatePtr
Goto lGetDateExit
EndIf
Parse_GetMonth()
If bMatched = "False" Then
iBufPtr = iDatePtr
Goto lGetDateExit
EndIf
Lex_GetSlash()
If bMatched = "False" Then
iBufPtr = iDatePtr
Goto lGetDateExit
EndIf
Parse_GetDay()
If bMatched = "False" Then
iBufPtr = iDatePtr
Goto lGetDateExit
EndIf
Cal_GetLeapFromYear()
iNoL2011 = Math.Floor((2011 - 1) / 4) - Math.Floor((2011 - 1) / 100) + Math.Floor((2011 - 1) / 400) ' number of leap year
iDaysIn2011 = (iYear - 2011) * 365 + iNoL2011 - iNoL
For iM = 1 To iMonth - 1
iDaysIn2011 = iDaysIn2011 + iDoM[iM]
EndFor
iDaysIn2011 = iDaysIn2011 + iDay - 1
lGetDateExit:
EndSub

' Parse | Get year
' in: sBuf - buffer
' in/out: iBufPtr - buffer pointer
' work: iSavedPtr - saved buffer pointer
' out: iYear - year
' out: bMatched - is year
Sub Parse_GetYear
iSavedPtr = iBufPtr
Lex_GetDigit() ' 1000
If bMatched = "False" Then
Goto lGetYearExit
EndIf
iYear = cDigit
Lex_GetDigit() ' 100
If bMatched = "False" Then
iBufPtr = iSavedPtr
Goto lGetYearExit
EndIf
iYear = iYear * 10 + cDigit
Lex_GetDigit() ' 10
If bMatched = "False" Then
iBufPtr = iSavedPtr
Goto lGetYearExit
EndIf
iYear = iYear * 10 + cDigit
Lex_GetDigit() ' 1
If bMatched = "False" Then
iBufPtr = iSavedPtr
Goto lGetYearExit
EndIf
iYear = iYear * 10 + cDigit
lGetYearExit:
EndSub

' Parse | Get month
' in: sBuf - buffer
' in/out: iBufPtr - buffer pointer
' work: iSavedPtr - saved buffer pointer
' out: iMonth - month
' out: bMatched - is month
Sub Parse_GetMonth
Parse_Get2Digits()
If bMatched = "False" Then
Goto lGetMonthExit
EndIf
iMonth = iNum
lGetMonthExit:
EndSub

' Parse | Get day
' in: sBuf - buffer
' in/out: iBufPtr - buffer pointer
' work: iSavedPtr - saved buffer pointer
' out: iDay - day
' out: bMatched - is day
Sub Parse_GetDay
Parse_Get2Digits()
If bMatched = "False" Then
Goto lGetDayExit
EndIf
iDay = iNum
lGetDayExit:
EndSub

' Parse | Get time
' in: sBuf - buffer
' in/out: iBufPtr - buffer pointer
' work: iDatePtr - saved buffer pointer
' out: rDays - days from 00:00:00
' out: bMatced - is date
Sub Parse_GetTime
iTimePtr = iBufPtr
Parse_GetHour()
If bMatched = "False" Then
Goto lGetTimeExit
EndIf
Lex_GetColon()
If bMatched = "False" Then
iBufPtr = iTimePtr
Goto lGetTimeExit
EndIf
Parse_GetMinute()
If bMatched = "False" Then
iBufPtr = iTimePtr
Goto lGetTimeExit
EndIf
Lex_GetColon()
If bMatched = "False" Then
iBufPtr = iTimePtr
Goto lGetTimeExit
EndIf
Parse_GetSecond()
If bMatched = "False" Then
iBufPtr = iTimePtr
Goto lGetTimeExit
EndIf
rDays = (iHour + (iMinute + iSecond / 60) / 60) / 24
lGetTimeExit:
EndSub

' Parse | Get hour
' in: sBuf - buffer
' in/out: iBufPtr - buffer pointer
' work: iSavedPtr - saved buffer pointer
' out: iHour - hour
' out: bMatched - is hour
Sub Parse_GetHour
Parse_Get2Digits()
If bMatched = "False" Then
Goto lGetHourExit
EndIf
iHour = iNum
lGetHourExit:
EndSub

' Parse | Get minute
' in: sBuf - buffer
' in/out: iBufPtr - buffer pointer
' work: iSavedPtr - saved buffer pointer
' out: iMinute - minute
' out: bMatched - is minute
Sub Parse_GetMinute
Parse_Get2Digits()
If bMatched = "False" Then
Goto lGetMinuteExit
EndIf
iMinute = iNum
lGetMinuteExit:
EndSub

' Parse | Get second
' in: sBuf - buffer
' in/out: iBufPtr - buffer pointer
' work: iSavedPtr - saved buffer pointer
' out: iSecond - second
' out: bMatched - is socond
Sub Parse_GetSecond
Parse_Get2Digits()
If bMatched = "False" Then
Goto lGetSecondExit
EndIf
iSecond = iNum
lGetSecondExit:
EndSub