Anonymous user
Metronome: Difference between revisions
→{{header|PureBasic}}: added missing feature to correct code
m (fixed typo) |
(→{{header|PureBasic}}: added missing feature to correct code) |
||
Line 553:
</ul>
[[file:MetronomeScreenShot.png|PureBasic output|thumb|200px]]
<lang PureBasic>Structure METRONOMEs
msPerBeat.i
BeatsPerMinute.i
BeatsPerCycle.i
volume.i
canvasGadget.i
h.i
originX.i
originY.i
radius.i
activityStatus.i
EndStructure
Enumeration ;gadgets
#TEXT_MSPB ;milliseconds per beat
#STRING_MSPB ;milliseconds per beat
#TEXT_BPM ;beats per minute
#STRING_BPM ;beats per minute
#TEXT_BPC ;beats per cycle
#STRING_BPC ;beats per cycle
#BUTTON_VOLM ;volume -
#BUTTON_VOLP ;volume +
#BUTTON_START ;start
#SPIN_BPM
#CANVAS_METRONOME
EndEnumeration
Enumeration ;sounds
#SOUND_LOW
#SOUND_HIGH
EndEnumeration
#WINDOW = 0 ;window
Procedure handleError(Value, text.s)
If Not Value: MessageRequester("Error", text): End: EndIf
EndProcedure
Procedure drawMetronome(*m.METRONOMEs, Angle.f, cycleCount = 0)
Protected CircleX, CircleY, circleColor
If StartDrawing(CanvasOutput(*m\canvasGadget))
Box(0, 0, *m\w, *m\h, RGB(0, 0, 0))
CircleX = Int(*m\radius * Cos(Radian(Angle)))
CircleY = Int(*m\radius * Sin(Radian(Angle)))
If Angle = 90
If cycleCount: circleColor = RGB(255, 0, 0): Else: circleColor = RGB(0, 255, 0): EndIf
LineXY(*m\originX, *m\originY, *m\originX, *m\originY - CircleY, RGB(255, 255, 0))
Circle(*m\originX + CircleX, *m\originY - CircleY - *m\radius * 0.15, 10, circleColor)
Else
LineXY(*m\originX, *m\originY - *m\radius * 1.02, *m\originX, *m\originY - *m\radius, RGB(255, 255, 0))
LineXY(*m\originX, *m\originY, *m\originX + CircleX, *m\originY - CircleY, RGB(255, 255, 0))
EndIf
StopDrawing()
ProcedureReturn 1
EndIf
EndProcedure
Procedure.i Metronome(*m.METRONOMEs)
Protected milliseconds = Int((60 * 1000) / *m\BeatsPerMinute)
Protected msPerFrame, framesPerBeat
Protected i, j, cycleCount, startTime, frameEndTime, delayTime, delayError, h.f
;calculate metronome angles for each frame of animation
If *m\BeatsPerMinute < 60
framesPerBeat = Round(milliseconds / 150, #PB_Round_Nearest)
Else
framesPerBeat = Round((*m\BeatsPerMinute - 420) / -60, #PB_Round_Nearest)
EndIf
If framesPerBeat < 1
framesPerBeat = 1
Dim metronomeFrameAngle.f(1, framesPerBeat)
metronomeFrameAngle(0, 1) = 90
metronomeFrameAngle(1, 1) = 90
Else
Dim metronomeFrameAngle.f(1, framesPerBeat * 2)
For j = 1 To framesPerBeat
h = 45 / framesPerBeat
metronomeFrameAngle(0, j) = 90 - h * (j - 1)
metronomeFrameAngle(0, framesPerBeat + j) = 45 + h * (j - 1)
metronomeFrameAngle(1, j) = 90 + h * (j - 1)
metronomeFrameAngle(1, framesPerBeat + j) = 135 - h * (j - 1)
Next
framesPerBeat * 2
EndIf
msPerFrame = milliseconds / framesPerBeat
PlaySound(#SOUND_HIGH)
startTime = ElapsedMilliseconds()
Repeat
For i = 0 To 1
frameEndTime = startTime + msPerFrame
For j = 1 To framesPerBeat
drawMetronome(*m, metronomeFrameAngle(i, j), cycleCount)
;check for thread exit
If *m\activityStatus < 0
*m\activityStatus = 0
ProcedureReturn
EndIf
delayTime = frameEndTime - ElapsedMilliseconds()
If (delayTime - delayError) >= 0
Delay(frameEndTime - ElapsedMilliseconds() - delayError) ;wait the remainder of frame
ElseIf delayTime < 0
delayError = - delayTime
EndIf
frameEndTime + msPerFrame
Next
;check for thread exit
If *m\activityStatus < 0
*m\activityStatus = 0
ProcedureReturn
EndIf
While (ElapsedMilliseconds() - startTime) < milliseconds: Wend
SetGadgetText(*m\msPerBeat, Str(ElapsedMilliseconds() - startTime))
cycleCount + 1: cycleCount % *m\BeatsPerCycle
If cycleCount = 0
PlaySound(#SOUND_HIGH)
Else
PlaySound(#SOUND_LOW)
EndIf
startTime + milliseconds
Next
ForEver
EndProcedure
Procedure startMetronome(*m.METRONOMEs, MetronomeThread) ;start up the thread with new values
*m\BeatsPerMinute = Val(GetGadgetText(#STRING_BPM))
*m\BeatsPerCycle = Val(GetGadgetText(#STRING_BPC))
*m\activityStatus = 1
If *m\BeatsPerMinute
MetronomeThread = CreateThread(@Metronome(), *m)
EndIf
ProcedureReturn MetronomeThread
EndProcedure
Procedure stopMetronome(*m.METRONOMEs, MetronomeThread) ;if the thread is running: stop it
If IsThread(MetronomeThread)
*m\activityStatus = -1 ;signal thread to stop
EndIf
drawMetronome(*m, 90)
EndProcedure
Define w = 360, h = 360, ourMetronome.METRONOMEs
;initialize the metronome
With ourMetronome
\canvasGadget = #CANVAS_METRONOME
\volume = 10
\w = w
\h = h
\originX = w / 2
\originY = h / 2
\radius = 100
EndWith
ourMetronome\canvasGadget = #CANVAS_METRONOME
;initialize sounds
handleError(InitSound(), "Sound system is Not available")
handleError(CatchSound(#SOUND_LOW, ?sClick, ?eClick - ?sClick), "Could Not CatchSound")
handleError(CatchSound(#SOUND_HIGH, ?sClick, ?eClick - ?sClick), "Could Not CatchSound")
SetSoundFrequency(#SOUND_HIGH, 50000)
SoundVolume(#SOUND_LOW, ourMetronome\volume)
SoundVolume(#SOUND_HIGH, ourMetronome\volume)
;setup window & GUI
Define Style, i, wp, gh
Style = #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_MinimizeGadget
handleError(OpenWindow(#WINDOW, 0, 0, w + 200 + 12, h + 4, "Metronome", Style), "Not OpenWindow")
SetWindowColor(#WINDOW, $505050)
If LoadFont(0, "tahoma", 9, #PB_Font_HighQuality | #PB_Font_Bold)
SetGadgetFont(#PB_Default, FontID(0))
EndIf
i = 3: wp = 10: gh = 22
TextGadget(#TEXT_MSPB, w + wp, gh * i, 100, gh, "MilliSecs/Beat ", #PB_Text_Center)
StringGadget(#STRING_MSPB, w + wp + 108, gh * i, 90, gh, "0", #PB_String_ReadOnly): i + 2
TextGadget(#TEXT_BPM, w + wp, gh * i, 100, gh,"Beats/Min ", #PB_Text_Center)
GadgetToolTip(#STRING_BPM, "Valid range is 20 -> 240")
TextGadget(#TEXT_BPC, w + wp, gh * i, 100, gh,"Beats/Cycle ", #PB_Text_Center)
StringGadget(#STRING_BPC, w + wp + 108, gh * i, 90, gh, "4", #PB_String_Numeric): i + 2
GadgetToolTip(#STRING_BPC, "Valid range is 1 -> BPM")
ButtonGadget(#BUTTON_VOLM, w + wp, gh * i, 100, gh, "-Volume")
CanvasGadget(ourMetronome\canvasGadget, 0, 0, ourMetronome\w, ourMetronome\h, #PB_Image_Border)
drawMetronome(ourMetronome, 90)
Define msg, GID, MetronomeThread, Value
Repeat ;the control loop for our application
msg = WaitWindowEvent(1)
GID = EventGadget()
etp = EventType()
If GetAsyncKeyState_(#VK_ESCAPE): End: EndIf ;remove when app is o.k.
Select msg
Case #PB_Event_CloseWindow
Case #PB_Event_Gadget
Case #STRING_BPM
If etp = #PB_EventType_LostFocus
Value = Val(GetGadgetText(#STRING_BPM))
If Value > 390
Value = 390
ElseIf Value < 20
Value = 20
EndIf
SetGadgetText(#STRING_BPM, Str(Value))
EndIf
Case #STRING_BPC
If etp = #PB_EventType_LostFocus
Value = Val(GetGadgetText(#STRING_BPC))
If Value > Val(GetGadgetText(#STRING_BPM))
Value = Val(GetGadgetText(#STRING_BPM))
ElseIf Value < 1
Value = 1
EndIf
SetGadgetText(#STRING_BPC, Str(Value))
EndIf
Case #BUTTON_VOLP, #BUTTON_VOLM ;change volume
If GID = #BUTTON_VOLP And ourMetronome\volume < 100
ourMetronome\volume + 10
ElseIf GID = #BUTTON_VOLM And ourMetronome\volume > 0
ourMetronome\volume - 10
EndIf
SoundVolume(#SOUND_LOW, ourMetronome\volume)
SoundVolume(#SOUND_HIGH, ourMetronome\volume)
Case #BUTTON_START ;the toggle button for start/stop
Select GetGadgetState(#BUTTON_START)
Case 1
stopMetronome(ourMetronome, MetronomeThread)
MetronomeThread = startMetronome(ourMetronome, MetronomeThread)
SetGadgetText(#BUTTON_START,"Stop")
Case 0
stopMetronome(ourMetronome, MetronomeThread)
EndSelect
EndSelect
EndSelect
ForEver
End
DataSection
;a small wav file saved as raw data
sClick:
Data.q $0000082E46464952,$20746D6645564157,$0001000100000010,$0000AC440000AC44
Data.q $6174616400080001,$8484848300000602,$8B8A898886868585,$C0B3A9A29C95918E
Data.q $31479BD3CED0CFCF,$3233323232323331,$BDAEC4C9A1423133,$D0CFCFD0CFD1CDD4
Data.q $323232333770A9CB,$2E34313332333232,$CFD0CFCACFCFAF53,$9783AAD3CED0CFD0
Data.q $3233313332448AA1,$4430333233323233,$CFD0CFAE7D7E9483,$B7B9C3B8BFD1CED0
Data.q $3233313037476898,$3E48493D32333233,$85959187775C4338,$898A8F8D807A7978
Data.q $737F898381888D8D,$3131435564717A77,$332F36413A343234,$827B7873695C4D37
Data.q $9C9B949191908F8A,$4D50515A67758694,$5451484341414245,$7B83868782756559
Data.q $565D5F616365676E,$7871675F57504B4E,$797C8083827E7C7B,$4D525E686C6D7176
Data.q $4D4B4B474343464A,$8B82796F655D5953,$7B7C83888B909392,$5153595E666F767B
Data.q $5A5A5B5B59575553,$696C6E6D67615E5B,$7879777573726F6B,$71727376797C7B79
Data.q $505352505159646C,$6B6153463C3B414A,$A09B908379706D6E,$6F767A7E858C949C
Data.q $4D4D4845484E5662,$80796F645B544E4C,$8487888885828283,$555A5D606369737D
Data.q $6A665F58524E4E51,$878E8F8B867D736D,$54606B72797F8081,$5852504F4E4E4C4D
Data.q $7E7B7A79756F675F,$6B6C6F757C7F8182,$6D6865676C6F6E6C,$6E6B6C7074777773
Data.q $615E5D60676F7372,$7069636061636463,$81817F7C7A797976,$65676B6E72797E80
Data.q $65625F5E5D5D5F62,$7D7C7B7875716E6A,$6F74777B7E7F7F7E,$454950565D63676A
Data.q $605A55504B464343,$9E9F9D978E817469,$6E7D8A93989A9B9C,$444546494C505861
Data.q $7B756F665C534C46,$7E82858788888580,$5C5D61666B70757A,$6A6B6B6B6965615E
Data.q $646B717676736F6B,$727272716D676261,$8285878885817A74,$5F5F636A72797D80
Data.q $645D58585A5E6060,$827D79777877746D,$7878797C80848685,$6A686664666B7075
Data.q $76726C666364686B,$807E7B7878787878,$656A6F74797B7D7F,$59585A5C5D5F6163
Data.q $84807C79746D665E,$777C81878B8C8B89,$555352555B636B72,$82776B625C595957
Data.q $989B9A979493918B,$656A6E7277818A92,$535457575656585E,$6E6E6F6D675E5753
Data.q $898C9398968D7F74,$69717E8C9697918B,$3B39414F5D656767,$695B56565A595145
Data.q $8986878A8F90897B,$7A7875757B848A8C,$747168605E636D76,$7B7365585257636F
Data.q $8C8981777272777C,$70757676767A8188,$6A6D6D68625F6269,$8687847D746C6868
Data.q $8485888A89868484,$585A616B747B8083,$5B555355595C5C5A,$8C898786847D7265
Data.q $888C9096999A9892,$6163666C72797F83,$5E554E4B4C52595E,$91887C7169676663
Data.q $8E8E8A88888C9193,$656666676A737E88,$655F585352555B62,$8B88837C756F6B69
Data.q $7E858B8E8E8B898B,$62676B6D6D6C6E74,$6C6C6B6A6764605F,$7C7978787775736F
Data.q $8E8C8C8C8D8D8982,$686D747C858C9091,$625C58585B5E6265,$908A837C75706C68
Data.q $848A8E9396989896,$545960676E757A7F,$65605E5D5B575352,$A19D9890877C746C
Data.q $8992979A9C9FA1A2,$525355575C64707E,$736D665D56514F50,$8D8D8B8986827E79
Data.q $7777797B7F84898C,$78746F6A6A6E7376,$7B79767372747879,$6C6B69686A6F757A
Data.q $7C78746F6D6C6C6D,$888B8C8B88858280,$6F75797B7D7F8184,$6F6D6B686565676A
Data.q $8785817D79747270,$868B8D8D8C8A8988,$6F73777A7C7D7F82,$6F6B68656465666A
Data.q $8A837D7976757472,$76787A7D82888C8D,$6562606064696F73,$8E8A847C756F6B68
Data.q $8D90939494929190,$606264686F788088,$73685D58585A5D5F,$9B96918C8987837D
Data.q $71767B838C959B9D,$5B5756585D63686D,$8C86817B756F6962,$888F939597979591
Data.q $5C606366696F7780,$7A756D6259535458,$9EA2A0988D837E7C,$79858D8F8F8E9097
Data.q $656B6E6D6865666E,$797A79746C656060,$7F7F7F7F7E7C7978,$8381828384848280
Data.q $7F82888E92918D88,$59606A757C7F7F7F,$655E5A5A59585656,$A59F97918A82796E
Data.q $7E848A939CA6ABAA,$48454548515E6B76,$8A7C6E6057514E4B,$A9ACABA8A4A09B94
Data.q $5A626A737F8C98A3,$60554D49484A4E54,$A9A19A928A81776B,$848C969FA7ADAFAD
Data.q $4B494C525C67717B,$8A7D7167605A544F,$A2A4A5A6A6A49F96,$626970777F89949C
Data.q $6B655E56504F545A,$A19F988F8379736E,$848C9296989A9C9F,$61626465676B717A
Data.q $807E79736D676261,$86898B8C8A888583,$797A7E8284848484,$77777A7C7E7E7C7A
Data.q $7979797B7D7E7C79,$7D7C7B7B7C7C7B7A,$7D7D7C7B7A7B7C7D,$797978777677797B
Data.q $787A7A7976757678,$415380817C777576,$2C31000002005255,$30202C36202C3020
eClick:
EndDataSection</lang>
=={{header|Pure Data}}==
|