As also mentioned in code, you'll need the FMOD.DLL in it's StdCall-version from:
http://www.fmod.org/files/fmod_stdcall.zip
Have fun with it!:)
Code: Select all
; Realtime-Keyboard 0.1;
; This little program lets us play on a keyboard!
; The sound is generated in REALTIME by a callback-procedure using the _stdcall-version
; of FMOD.DLL, which you'll get here :
;
; [url]http://www.fmod.org/files/fmod_stdcall.zip[/url]
;
; Just copy the extracted FMOD.DLL into this program's directory
;
; (c) 2002, Sven Kurras, [url]http://www.schalldesign.com[/url]
Declare.l Buffercallback(hStream.l, BufferPointer.l, length.l, param.l)
Declare Info(a.s,b.s,c.l)
Declare _CreateGadgetlist(hWnd)
InitKeyboard()
#pi = 3.14159265
#FMOD_MONO = $20:#FMOD_STEREO = $40:#FMOD_16BIT = $10 ; From FMOD-API
DefType.f osz1, amp_max, osz1start
DefType.l samplerate, osz_num, bits, buffer_num, buffer_size, wavetype, channels, change, Resume, osz_diff
samplerate = 44100 : bits = 16 : channels = 2
buffer_num = 4 : buffer_size = 2048 ;increase _size to 2048 | 4096 etc. when sound output is not continuous
osz1start = 110 ;start-FQ and the basis of all following
osz1 = osz1start * Pow(Pow(2.0 , 1/12),3000); for details read further down in code
osz_num = 4 : osz_diff = 12 ;play with these parametes, especially with the _diff, to affect the sound!
amp_max = Int(Pow(2, bits) / osz_num / 2)-1 ;to prevent clipping - not the correct algor. yet
If OpenLibrary(1,"fmod.dll") = 0 : Info("","Couldn't load fmod.dll",0):End:EndIf
If CallFunction(1,"_FSOUND_Init@12",Samplerate,32,0) = 0 : Info("","Couldn't initialize FSOUND.",0):End:EndIf
If channels = 2
wavetype = #FMOD_STEREO | #FMOD_16BIT
Else
wavetype = #FMOD_MONO | #FMOD_16BIT
EndIf
;Create stream and set callback to @BufferCallback
hStream.l = CallFunction(1,"_FSOUND_Stream_Create@20", @BufferCallback(), buffer_num*buffer_size, wavetype, samplerate, 0)
If hStream = 0 : Info("","Cannot create stream.",0):End:EndIf
;Start playing
hChannel.l = CallFunction(1,"_FSOUND_Stream_Play@8", -1, hStream)
If hChannel = 0 : Info("","Cannot play stream.",0):End:EndIf
hWnd=OpenWindow(1,0,0,720,100,#PB_Window_SystemMenu|#PB_Window_ScreenCentered,"Realtime-Keyboard 0.1")
_CreateGadgetList(hWnd) ;'paints' the Keyboard
;Plays the beginning of 'the Entertainer'
;FQ *|/ (12th Square of 2) is +|- 1 Semitone, so FQ
;Semitone 0 is the a in the middle of the keyboard here
osz1 = osz1start * Pow(Pow(2.0 , 1/12),-7) : Delay(250)
osz1 = osz1start * Pow(Pow(2.0 , 1/12),-6) : Delay(250)
osz1 = osz1start * Pow(Pow(2.0 , 1/12),-5) : Delay(250)
osz1 = osz1start * Pow(Pow(2.0 , 1/12),3) : Delay(500)
osz1 = osz1start * Pow(Pow(2.0 , 1/12),-5) : Delay(250)
osz1 = osz1start * Pow(Pow(2.0 , 1/12),3) : Delay(500)
osz1 = osz1start * Pow(Pow(2.0 , 1/12),-5) : Delay(250)
osz1 = osz1start * Pow(Pow(2.0 , 1/12),3) : Delay(500)
osz1 = osz1start * Pow(Pow(2.0 , 1/12),3000) ;just an easy-made pause - can you hear it ? :wink:
Resume=1
While Resume
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
Resume=0
osz1 = osz1start * Pow(Pow(2.0 , 1/12),3000);stops sound
Case #PB_EventGadget
Select EventGadgetID()
Case 999
osz1 = osz1start * Pow(Pow(2.0 , 1/12),3000); the easy-pause, again
Case 998
osz_diff-1 : If osz_diff samplerate ;to prevent overflow
If time_run 0 ;to prevent clipping caused by time_run-reset
time_run=0
EndIf
EndIf
Next
For j=0 To channels-1 ;OK, not really stereo, just Dual-Mono :wink:
PokeW(*BufferPointer + sample_act+Int(bits/8)*j, signed_word)
Next
sample_act + bytes_per_sample
Wend
ProcedureReturn 1
EndProcedure
Procedure _CreateGadgetlist(hWnd)
Shared osz_diff
CreateGadgetList(hWnd)
For oktaven=1 To 4
For part2=5 To 7 Step 2
run=0
For part=1 To part2
i+1
k+12
run!1
FreeGadget(i)
ButtonGadget(i,k,10+20*run,12+13*run,40,"")
Next
k+12
Next
Next
run=1 : i+1 : k+12
FreeGadget(i)
ButtonGadget(i,k,10+20*run,12+13*run,40,"")
FreeGadget(999)
ButtonGadget(999,310,80,100,15,"stop sound")
FreeGadget(998)
ButtonGadget(998,550,80,150,15,"change sound - active : "+Str(osz_diff))
EndProcedure
Procedure Info(a.s , b.s, c.l) ;I'm lazy about typing MessageRequester <- was this grammatically ok ??
MessageRequester(a,b,c)
EndProcedure