Sampling sound frequencies to semitones.

Share your advanced PureBasic knowledge/code with the community.
User avatar
einander
Enthusiast
Enthusiast
Posts: 744
Joined: Thu Jun 26, 2003 2:09 am
Location: Spain (Galicia)

Sampling sound frequencies to semitones.

Post by einander »

Small demo to convert sound frequencies to musical notes based on a unique sound file.
Different notes are played on a 3 octaves range.
Needs a Sound File (396 KB) From "http://www.2shared.com/audio/QDLpe4Oa/Pn_48.HTML"
The Sound File is a single piano Note C48.

Code: Select all

; PB 5.10
; by einander
; Load one Note Sound File (396 KB) From "http://www.2shared.com/audio/QDLpe4Oa/Pn_48.HTML"
; and save it as 'Pn 48.wav' on the program directory.
; Press escape to quit.
EnableExplicit
Define Note, StartNote=24,Range=36 
Define LastNote=StartNote+Range , Base=?BaseSound
#Semitone=1.059463094359  ;=Pow(2,1/12)
Dim Chord(4)
InitSound()
;
Procedure TransposeSound(Sound,Transpose,Freq=44100) ; transpose can be negative
  SetSoundFrequency(Sound,Freq * Pow(#Semitone,Transpose)/12)
EndProcedure 
;
Macro PlaySnd(Sound,Transpose=0,Volume=100,Freq=44100)
  TransposeSound(Sound,Transpose,Freq)
  PlaySound(Sound,0,Volume)
EndMacro
;
For Note=0 To 4 ;  Sounds to conform a 5 Note Chord
  CatchSound(Note,Base)
  Chord(Note)=7*Note+StartNote 
Next
Repeat
  If GetAsyncKeyState_(27)&$8000 :  End : EndIf
  For Note=0 To 4
    PlaySnd(Note,Chord(Note))
    Chord(Note)+5   
    If Chord(Note)>=LastNote:Chord(Note)-Range:EndIf
    If Note>1 And Random(3)   :PlaySnd(Note-2,Chord(Note-2)):EndIf
    If Note>2 And Random(2)=0 :PlaySnd(Note-3,Chord(Note-3)):EndIf
    Delay(400)  
  Next
  Delay(1200)  
  StopSound(-1)  
ForEver
;
DataSection 
  BaseSound: IncludeBinary "Pn 48.wav"
EndDataSection 
Last edited by einander on Tue Feb 26, 2013 12:11 pm, edited 1 time in total.
kvitaliy
Enthusiast
Enthusiast
Posts: 162
Joined: Mon May 10, 2010 4:02 pm

Re: Sampling sound frequencies to semitones.

Post by kvitaliy »

Excellent Job einander!
Joris
Addict
Addict
Posts: 890
Joined: Fri Oct 16, 2009 10:12 am
Location: BE

Re: Sampling sound frequencies to semitones.

Post by Joris »

Thanks, Einander.

What exactly does that $8000 behind the escape key in GetAsyncKeyState_(27) ?
Yeah I know, but keep in mind ... Leonardo da Vinci was also an autodidact.
User avatar
einander
Enthusiast
Enthusiast
Posts: 744
Joined: Thu Jun 26, 2003 2:09 am
Location: Spain (Galicia)

Re: Sampling sound frequencies to semitones.

Post by einander »

@Joris:
the $8000 is not mandatory here, but see this Rashad's code:
http://www.purebasic.fr/english/viewtop ... cKeyState_
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5494
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: Sampling sound frequencies to semitones.

Post by Kwai chang caine »

Impressive :shock:
Again a new magical turn :wink:

Thanks 8)
ImageThe happiness is a road...
Not a destination
Post Reply