08-13-2024, 11:46 PM
Here is a talking and chiming clock I made. Dav posted the code for the chimes once.
Code: (Select All)
'Speaking and Chiming Analog Clock by SierraKen
'Updated on August 13, 2024.
'Thanks to Dav for the chiming frequencies.
_Title "(N)umerals With or Without, (1) Male Speak, (2) Female Speak, (Space Bar) Chimes"
Screen _NewImage(600, 600, 32)
rom = 1
Cls
tt = 23
d = 0
Do
_Limit 100
For t = 0 To 360 Step .5
x2 = (Sin(t) * 190) + 300
y2 = (Cos(t) * 190) + 300
For sz = .1 To 5 Step .1
Circle (x2, y2), sz, _RGB32(127, 255, 127)
Next sz
Next t
For t = 1 To 359
For tt = t - 2 To t + 2 Step .5
x2 = Int((Sin(tt) * 170) + 300)
y2 = Int((Cos(tt) * 170) + 300)
For sz = .1 To 5 Step .1
Circle (x2, y2), sz, _RGB32(255, 255, 255)
Next sz
Next tt
Next t
If rom = 0 Then GoTo skip:
For sc = 1 To 60
ss = (60 - sc) * 6 + 180
x4 = Int(Sin(ss / 180 * 3.141592) * 150) + 300
y4 = Int(Cos(ss / 180 * 3.141592) * 150) + 300
Circle (x4, y4), 3, _RGB32(230, 230, 230)
n2 = (60 - sc) * 6 + 180
x3 = Int(Sin(n2 / 180 * 3.141592) * 140) + 290
y3 = Int(Cos(n2 / 180 * 3.141592) * 140) + 295
Color _RGB32(255, 255, 255), _RGB32(0, 0, 0)
If sc = 5 Then _PrintString (x3, y3), "I"
If sc = 10 Then _PrintString (x3, y3), "II"
If sc = 15 Then _PrintString (x3, y3), "III"
If sc = 20 Then _PrintString (x3, y3), "IV"
If sc = 25 Then _PrintString (x3, y3), "V"
If sc = 30 Then _PrintString (x3, y3), "VI"
If sc = 35 Then _PrintString (x3, y3), "VII"
If sc = 40 Then _PrintString (x3, y3), "VIII"
If sc = 45 Then _PrintString (x3, y3), "IX"
If sc = 50 Then _PrintString (x3, y3), "X"
If sc = 55 Then _PrintString (x3, y3), "XI"
If sc = 60 Then _PrintString (x3, y3), "XII"
Next sc
skip:
hours = Timer \ 3600
minutes = Timer \ 60 - hours * 60
seconds = (Timer - hours * 3600 - minutes * 60)
ho$ = Left$(Time$, 2): hou = Val(ho$)
min$ = Mid$(Time$, 4, 2): minu = Val(min$)
seco$ = Right$(Time$, 2): secon = Val(seco$)
pendulum tt, d
'Minutes
m = 180 - minutes * 6
xx = Int(Sin(m / 180 * 3.141592) * 120) + 300
yy = Int(Cos(m / 180 * 3.141592) * 120) + 304
For b = -5 To 5 Step .1
Line (300 + b, 304)-(xx, yy), _RGB32(0, 255, 255)
Line (300, 304 + b)-(xx, yy), _RGB32(0, 255, 255)
Next b
'Hours
h = 360 - hours * 30 + 180
xxx = Int(Sin(h / 180 * 3.141592) * 75) + 300
yyy = Int(Cos(h / 180 * 3.141592) * 75) + 304
For b = -5 To 5 Step .1
Line (300 + b, 304)-(xxx, yyy), _RGB32(0, 255, 0)
Line (300, 304 + b)-(xxx, yyy), _RGB32(0, 255, 0)
Next b
'Seconds
s = (60 - seconds) * 6 + 180
xxxx = Int(Sin(s / 180 * 3.141592) * 125) + 300
yyyy = Int(Cos(s / 180 * 3.141592) * 125) + 304
For b = -5 To 5 Step .1
Line (300 + b, 304)-(xxxx, yyyy), _RGB32(255, 0, 0)
Line (300, 304 + b)-(xxxx, yyyy), _RGB32(255, 0, 0)
Next b
For sz = .1 To 10 Step .1
Circle (300, 300), sz, _RGB32(255, 255, 127)
Next sz
_Display
Line (0, 0)-(600, 600), _RGB32(0, 0, 0), BF
'Chimes
If (minu = 0 And secon = 0) Or song = 1 Then
'note frequencies
For notes = 1 To 20
If notes = 1 Then note = 311.13 'D#
If notes = 2 Then note = 246.94 'B
If notes = 3 Then note = 277.18 'C#
If notes = 4 Then note = 185.00 'F#
If notes = 5 Then note = 0
If notes = 6 Then note = 185.00 'F#
If notes = 7 Then note = 277.18 'C#
If notes = 8 Then note = 311.13 'D#
If notes = 9 Then note = 246.94 'B
If notes = 10 Then note = 0
If notes = 11 Then note = 311.13 'D#
If notes = 12 Then note = 277.18 'C3
If notes = 13 Then note = 246.94 'B
If notes = 14 Then note = 185.00 'F#
If notes = 15 Then note = 0
If notes = 16 Then note = 185.00 'F#
If notes = 17 Then note = 277.18 'C#
If notes = 18 Then note = 311.13 'D#
If notes = 19 Then note = 246.94 'B
If notes = 20 Then note = 0
Do
'queue some sound
Do While _SndRawLen < 0.5 'you may wish to adjust this
sample = Sin(ttt * note * Atn(1) * 8) '340Hz sine wave (ttt * 440 * 2p)
sample = sample * Exp(-ttt * 3) 'fade out eliminates clicks after sound
_SndRaw sample
ttt = ttt + 1 / _SndRate 'sound card sample frequency determines time
Loop
'do other stuff, but it may interrupt sound
Loop While ttt < 1 'play for 1 second
Do While _SndRawLen > 0 'Finish any left over queued sound!
Loop
ttt = 0
Next notes
hour2 = hou
If hour2 > 12 Then hour2 = hour2 - 12
If hour2 = 0 Then hour2 = 12
For chimes = 1 To hour2
Do
'queue some sound
Do While _SndRawLen < 0.1 'you may wish to adjust this
sample = Sin(ttt * 240 * Atn(1) * 8) '340Hz sine wave (ttt * 440 * 2p)
sample = sample * Exp(-ttt * 3) 'fade out eliminates clicks after sound
_SndRaw sample
ttt = ttt + 1 / _SndRate 'sound card sample frequency determines time
Loop
'do other stuff, but it may interrupt sound
Loop While ttt < 2 'play for 2 seconds
Do While _SndRawLen > 0 'Finish any left over queued sound!
Loop
ttt = 0
Next chimes
song = 0
End If
two:
a$ = InKey$
If a$ = Chr$(27) Then End
If a$ = " " Then song = 1
If a$ = "n" Or a$ = "N" Then
rom = rom + 1
If rom > 1 Then rom = 0
For sz = .1 To 180 Step .1
Circle (300, 300), sz, _RGB32(0, 0, 0)
Next sz
End If
If a$ = "1" Then speaker = 0
If a$ = "2" Then speaker = 1
If a$ = "1" Or a$ = "2" Then
hour2 = hou
If hour2 > 11 Then
ampm$ = "P M"
Else
ampm$ = "A M"
End If
If hour2 > 12 Then hour2 = hour2 - 12
hour3$ = Str$(hour2)
hour4 = Val(hour3$)
If hour4 = 0 Then hour4 = 12
hour5$ = Str$(hour4)
min2 = Val(min$)
min3$ = Str$(min2)
seco2 = Val(seco$)
seco3$ = Str$(seco2)
hour5$ = _Trim$(hour5$)
If hour5$ = "10" Then hour5$ = "ten"
If hour5$ = "11" Then hour5$ = "eleven"
If hour5$ = "12" Then hour5$ = "twelve"
If _Trim$(min3$) = "1" Then smin$ = "minute"
If _Trim$(min3$) <> "1" Then smin$ = "minutes"
If _Trim$(seco3$) = "1" Then ssec$ = "second"
If _Trim$(seco3$) <> "1" Then ssec$ = "seconds"
sentence$ = "Today's date is " + w$ + ", " + month$ + " " + dd$ + ", " + yy$ + ", and the time is " + hour5$ + ampm$ + ", " + min3$ + " " + smin$ + ", and " + seco3$ + " " + ssec$
speak sentence$, speaker, 0
End If
mm$ = Left$(Date$, 2)
dd$ = Mid$(Date$, 4, 2)
yy$ = Right$(Date$, 4)
mm = Val(mm$)
dd = Val(dd$)
yy = Val(yy$)
GetDay mm, dd, yy, weekday
If weekday = 1 Then w$ = "Sunday"
If weekday = 2 Then w$ = "Monday"
If weekday = 3 Then w$ = "Tuesday"
If weekday = 4 Then w$ = "Wednesday"
If weekday = 5 Then w$ = "Thursday"
If weekday = 6 Then w$ = "Friday"
If weekday = 7 Then w$ = "Saturday"
If mm = 1 Then month$ = "January"
If mm = 2 Then month$ = "February"
If mm = 3 Then month$ = "March"
If mm = 4 Then month$ = "April"
If mm = 5 Then month$ = "May"
If mm = 6 Then month$ = "June"
If mm = 7 Then month$ = "July"
If mm = 8 Then month$ = "August"
If mm = 9 Then month$ = "September"
If mm = 10 Then month$ = "October"
If mm = 11 Then month$ = "November"
If mm = 12 Then month$ = "December"
hour2 = hou
If hour2 > 12 Then hour2 = hour2 - 12
If hour2 = 0 Then hour2 = 12
hour2$ = Str$(hour2)
Locate 2, 34: Print hour2$ + ":" + min$ + ":" + seco$
Locate 4, 27: Print w$ + ", " + month$ + " " + dd$ + ", " + yy$
Loop
End
Sub pendulum (tt, d)
If d = 0 Then tt = tt + (.26 / 2)
If d = 1 Then tt = tt - (.26 / 2)
If tt < 24.25 Then d = 0
If tt > 26 Then d = 1
theta = .3 * Cos(Timer)
x5 = (Sin(theta) * 80) + 300
y5 = (Cos(theta) * 80) + 300
For sz = -3 To 4
Line (300 + sz, 300)-(x5, y5), _RGB32(255, 255, 127)
Line (300, 300 + sz)-(x5, y5), _RGB32(255, 255, 127)
Next sz
For sz = .1 To 15 Step .1
Circle (x5, y5), sz, _RGB32(255, 255, 127)
Next sz
_Delay .06
_Display
End Sub
Sub speak (text As String, Speaker As Integer, Speed)
Dim message As String, remove$, out$
Dim As Long i, j
message = text
'some symbols and such can't be used with Powershell like this, as they're command symbols
'we need to strip them out of our text. (Like apostrophes!)
remove$ = "'" + Chr$(34) 'add to remove$ here, if more symbols need to be removed as future testing showcases problems
For j = 1 To Len(remove$)
Do
i = InStr(message, Mid$(remove$, j, 1))
If i Then message = Left$(message, i - 1) + Mid$(message, i + 1)
Loop Until i = 0
Next
out$ = "Powershell -Command " + Chr$(34)
out$ = out$ + "Add-Type -AssemblyName System.Speech; "
out$ = out$ + "$Speech = New-Object System.Speech.Synthesis.SpeechSynthesizer; "
If Speaker = 0 Then out$ = out$ + "$Speech.SelectVoice('Microsoft David Desktop'); "
If Speaker = 1 Then out$ = out$ + "$Speech.SelectVoice('Microsoft Zira Desktop'); "
If Speed Then out$ = out$ + "$Speech.Rate =" + Str$(Speed) + "; "
out$ = out$ + "$Speech.Speak('" + message + "');" + Chr$(34)
Shell _Hide out$
End Sub
'This section gets the right weekday.
Sub GetDay (mm, dd, yy, weekday) 'use 4 digit year
'From Zeller's congruence: https://en.wikipedia.org/wiki/Zeller%27s_congruence
If mm < 3 Then yy = yy - 1
If mm < 3 Then mm = mm + 12
century = yy Mod 100
zerocentury = yy \ 100
weekday = (dd + Int(13 * (mm + 1) / 5) + century + Int(century / 4) + Int(zerocentury / 4) + 5 * zerocentury) Mod 7
End Sub