A simple PB music sampler.
Posted: Thu Jan 03, 2013 1:40 am
Here is the full code for the 'Eine Kleine PBmusik' (without Midi and the ugly macros).
For the PBPunch contest, the 33 MB music samples were replaced by Midi, but here PB behaves as a music sound stereo sampler without complaint.
This is tested on Win 32 and 64, but probably can run on all OS.
Here is the download link for the 16 MB zip that contains a folder with the samples:
http://www.2shared.com/file/j2rVTeXk/samples1.html
Put the unzipped samples folder on the same program's directory.
Happy sampling!
For the PBPunch contest, the 33 MB music samples were replaced by Midi, but here PB behaves as a music sound stereo sampler without complaint.
This is tested on Win 32 and 64, but probably can run on all OS.
Here is the download link for the 16 MB zip that contains a folder with the samples:
http://www.2shared.com/file/j2rVTeXk/samples1.html
Put the unzipped samples folder on the same program's directory.
Happy sampling!
Code: Select all
; Eine Kleine PBmusik - PB 5.0 and 5.10
; by einander
; download the sound samples from http://www.2shared.com/file/j2rVTeXk/samples1.html
; also from https://docs.google.com/file/d/0B8rygHyRpO3vVEtqcUs1eHBNdjQ/edit
;
; Seed 1 is based on a traditional cuban piano "Tumbao"
; Seed 2 works better with fast Tempos
; Seed 3 works better with slow Tempos
; Have fun!
EnableExplicit
If InitSound() = 0
MessageRequester("Error", "Sound system is not available", 0)
End
EndIf
;
Structure Th
Modulation.I
Root.I
Tpo.I
Vel.I
Img.I
Play.I
Col.I[6]
RGB.I[6]
EndStructure
;
Global _Transp,_CG ,_Thout,_Thread,_Chclick,_Mode1,_Mode2,_Quit
Global Dim _N.A(0),Dim _Soft.L(5),Dim _Hard.L(5), Dim _Fury.L(5)
Global _Mutex=CreateMutex()
Global _Th.Th,_XStp,_Ystp,_Len,_NewSeed
Define A,B,I,Ev,SpinTrans,Seed.S,Sound
;
Procedure SetPan(A,B,C,D,Sound)
If B=A:ProcedureReturn 0:EndIf
Protected E.D=(D-C)/(B-A)
ProcedureReturn C+E*(Sound-A)
EndProcedure
;
For Sound=9 To 96
LoadSound(Sound, "Samples1\Pn "+Str(Sound)+".wav"); piano Sound samples
SoundPan(Sound,SetPan(9,96,-100,100,Sound))
Next
LoadSound(8,"Samples1\WoodBlock-2.wav") ; click Sound sample
Dim TB.I(5) ; TrackBars
;
Macro ReSeed(Seed)
LockMutex(_Mutex)
_Len=Len(Seed)-1
Dim _N(_Len)
For I=0 To _Len
Ev=PeekA(@Seed+I)
If Ev=32 : _N(I)=0
Else : _N(I)=Ev-44
EndIf
Next
StopSound(-1)
UnlockMutex(_Mutex)
EndMacro
;
Macro Seed1
Seed="FYa M RY U^ Y T\ Y R[ K U [ ^ Uc ^ Ua K DW` K PW T\ W R[ W DPY I` PY U^ Y Y\ UY Y IU"
Seed+" OY[ R U IRY U[ IPY U OX H R T X R[ T X HT[` M^ T]a T MY\` HT RX[^ TY\ H M"
Seed+"QY[ T HTX\ MW] T HW MTY "
ReSeed(Seed)
EndMacro
;
Macro Seed2
Seed="BNZ^a Z^a B N U Z \ BZa U Z N U Za B U J^b Y > ^e Y > ^b J >^e Y > J^e b J"
Seed+"^ W KZ^ K ? W Zc Z^c ? W Z ? Zc ^ Z KW =IUZ^ UZ^ = U Z^ I^ = a ^ = Za ^ "
Seed+"IZ UU BNX^a B N U X^ UX^ B U X a B ^ X B GWZ_ WZ_ G GWZ_ a _ a GWZc a _ Z"
Seed+"^a FR ^ Z K DPW\_ K D 8 D W _ P\ SW \ DW IZ_ = W Z =_ IUZ_ UZ_ = IZ"
Seed+"a _ Z = "
ReSeed(Seed)
EndMacro
;
Macro Seed3
Seed="Kgjv R Wg e ^g K W c o l ^j ^bgj F R be Y R ^ JY^e R Y ^ V Y e Mg AW\ch "
Seed+"W COW^cj W DPW^cj `l W Wc P RW\`co Fn Wl Rj KW[^c W K W[^c W S GX]ad X G S "
Seed+"\_dht iu Gkw L S hkpt P X \f _h L X d p m _k _ck G S i Z S _ KZ_ S Z _ W Z f "
Seed+"h BX]di X DPX_dk X EQX_dk am X Xd Q SX]adp Gr m S_dp LX\ X L X^ad X L FW\^c "
Seed+"W F R [^co{ `lx Rjv "
ReSeed(Seed)
EndMacro
;
CopyMemory(?Rs,@_Soft(),24)
CopyMemory(?Rh,@_Hard(),24)
CopyMemory(?Rf,@_Fury(),24)
;
Procedure PlayNt(Nt.A,Chan=0,Vol=100,Z=-1)
If Nt > 7 And Nt<97
If _Chclick And Nt=8
PlaySound(Nt,0,60) ;click
Else
PlaySound(Nt)
If Z>-1
StartDrawing(CanvasOutput(_CG))
Box((Nt-8)*_Xstp,OutputHeight()-_Ystp-Z*_Ystp,_Xstp,_Xstp,_Th\RGB[Z])
StopDrawing()
EndIf
EndIf
EndIf
EndProcedure
;
Procedure Reset(Array A.L(1),Array Tb(1))
Protected A,I
With _Th
StopSound(-1)
For I=0 To 5
A=A(I):SetGadgetState(Tb(I),A)
If I:\Col[I]=A
Else :\Col[0]=200-A+100
EndIf
Next
If \Col[5]:\Col[5]=49-\Col[5]:EndIf
EndWith
EndProcedure
;
Procedure Trans(Nt,Tr) ;Transport nt to nt+tr preserving the octave
Protected Ov=Nt/12
ProcedureReturn(Nt+Tr)%12+Ov*12
EndProcedure
;
Procedure ThPlay(Void)
With _Th.Th
Protected Nt.A,Nt1, OldAp,OldAp1,Beat,I,Ov
Repeat
If \Modulation
\Root+(Random(4)+1)
\Root%12
EndIf
Beat=0
If TryLockMutex(_Mutex):SetGadgetAttribute(_CG,1,ImageID(\Img)):UnlockMutex(_Mutex):EndIf
For I=0 To _Len
Nt=_N(I)
If Nt
LockMutex(_Mutex)
If \Root:Nt=Trans(Nt,\Root):EndIf
If _Transp:Nt=Trans(Nt,_Transp):EndIf
Nt1=Nt
Nt+12*Random(2)
\Vel=60+Random(30)
If \Col[5]=0 Or Random(\Col[5])
If _Mode1 And Random(10)=0 ; Medium octaves
Playnt(Nt-12*(I%4),0,\Vel-10,5)
OldAp=Nt
ElseIf _Mode2 And Random(12)=0 ; High octaves
Playnt(Nt+24,0,\Vel-10,5)
OldAp=Nt
Else
Playnt(Nt,0,\Vel+10,0)
EndIf
If \Col[1]>36 And Nt1<\Col[1]
Playnt(Nt+12*Random(1),0,\Vel,1)
EndIf
If \Col[2]>36 And Nt1<\Col[2]
Playnt(Nt-12*Random(1),0,\Vel,2)
EndIf
If \Col[3]>35 And Nt1<\Col[3] And Nt>30
Playnt(Nt-12*Random(1),0,\Vel,3)
EndIf
If \Col[4]>35 And Nt1<\Col[4] And Nt<90
Playnt(Nt+12*Random(1),0,\Vel,4)
EndIf
Else ; apoggiatura
If Random(1) And Oldap=0
Playnt(Nt-1,0,\Vel-10,5)
Playnt(Nt+11,0,\Vel-10,5)
OldAp=Nt
Else
Playnt(Nt,0,\Vel+20,5)
OldAp1=Nt
EndIf
EndIf
UnlockMutex(_Mutex)
Else
LockMutex(_Mutex)
If _Chclick And Beat=0: Playnt(8,9,100):EndIf
UnlockMutex(_Mutex)
Beat+1
If OldAp
Delay(\Col[0]/2)
LockMutex(_Mutex)
Playnt(OldAp,0,\Vel+20,5)
Playnt(OldAp+12,0,\Vel+20,5)
OldAp=0
UnlockMutex(_Mutex)
Delay(\Col[0]/2)
ElseIf OldAp1
Delay(\Col[0]/2)
LockMutex(_Mutex)
Playnt(OldAp1-1,0,\Vel-10,5)
UnlockMutex(_Mutex)
Delay(\Col[0]/2)
LockMutex(_Mutex)
Playnt(OldAp1,0,\Vel+10,5)
OldAp1=0
UnlockMutex(_Mutex)
Else
If _NewSeed:_NewSeed=0:Break:EndIf
If _Thout:Break 2:EndIf
Delay(\Col[0])
If Beat%4=0
SetGadgetAttribute(_CG,1,ImageID(\Img))
EndIf
EndIf
EndIf
If Beat=8
StopSound(-1)
Beat=0
EndIf
Next
Until _Quit Or _Thout
EndWith
EndProcedure
;
Macro QuitThread()
_Thout=#True
If IsThread(_Thread)
PauseThread(_Thread)
WaitThread(_Thread,500)
KillThread(_Thread)
EndIf
StopSound(-1)
EndMacro
;
;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
ExamineDesktops()
Define DWi=DesktopWidth(0)
Define Title$="Eine Kleine PBmusik - Experiment in recombinatorial music"
OpenWindow(0, 100, 100,DWi/2,DesktopHeight(0)/2 ,Title$,$Cf0001)
Define Wi=WindowWidth(0),He=WindowHeight(0), Stp=DWi/18
SetWindowColor(0,$22)
With _Th
Define X=10,Y=10
Restore TBS
For I=0 To 5
Read A:Read B
Tb(I)=TrackBarGadget(#PB_Any,X+16,Y,22,He/2,A,B,#PB_TrackBar_Vertical)
X+Stp
Next
Reset(_Soft(),Tb())
Define A$,B$,Tg
X=10
A=Stp *0.8
For I=0 To 5
Read$ A$ : Read$ B$
If I<5 : Tg=TextGadget(#PB_Any,X,Y+He/1.85,A,16,A$,1)
Else : Tg=TextGadget(#PB_Any,X,Y+He/1.85,A/3,16,A$,1)
EndIf
X+Stp
SetGadgetColor(Tg,1,0)
\RGB[I]=Val("$"+B$)
SetGadgetColor(Tg,2,\RGB[I])
Next
X=GadgetX(Tb(5))+A
B=A*1.5
Define ChBMod =CheckBoxGadget(#PB_Any,X,10,B,18,"Modulation")
Define OpSoft=OptionGadget(#PB_Any,X, 32,B,18,"Soft")
Define OpHard=OptionGadget(#PB_Any,X, 54,B,18,"Hard")
Define OpFury=OptionGadget(#PB_Any,X, 76,B,18,"Furioso")
Define CHClick=CheckBoxGadget(#PB_Any,X,98,B,18," Click")
Define SPinTrans=SpinGadget(#PB_Any,X,120,30,18,0,11,#PB_Spin_Numeric)
Define Op0=OptionGadget(#PB_Any,X,142,60,18,"Seed 1")
Define Op1=OptionGadget(#PB_Any,X,164,60,18,"Seed 2")
Define Op2=OptionGadget(#PB_Any,X,186,60,18,"Seed 3")
Define CGFill=ContainerGadget(#PB_Any,GadgetX(Tg)+GadgetWidth(Tg),GadgetY(Tg),38,16)
SetGadgetColor(CGfill,#PB_Gadget_BackColor,#Red)
Define ChMode1=CheckBoxGadget(#PB_Any,0,2,12,12,"")
Define ChMode2=CheckBoxGadget(#PB_Any,20,2 ,12,12,"")
CloseGadgetList()
GadgetToolTip(ChMode1,"Medium octaves")
GadgetToolTip(ChMode2,"High octaves")
Define CHPlay=CheckBoxGadget(#PB_Any,X,240,B,20," Play")
GadgetToolTip(SpinTrans,"Transpose")
SetGadgetState(SpinTrans,0)
_CG=CanvasGadget(#PB_Any,10,He*0.66,Wi-20,He*0.32)
\Img=CreateImage(#PB_Any,Wi-20,He*0.32)
StartDrawing(ImageOutput(\Img))
Box(0,0,OutputWidth(),OutputHeight(),$22)
_XStp=OutputWidth()/90
_YStp=OutputHeight()/7
StopDrawing()
SetGadgetAttribute(_CG,1,ImageID(\Img))
Select Random(2)
Case 0:Seed1 :SetGadgetState(Op0,1)
Case 1:Seed2 :SetGadgetState(Op1,1)
Case 2:Seed3 :SetGadgetState(Op2,1)
EndSelect
Repeat
Ev=WaitWindowEvent()
;If GetAsyncKeyState_(27)&$8000 : _Quit=#True : EndIf ; only for OS = windows
If Ev=#PB_Event_Gadget
Select EventGadget()
Case ChPlay:\Play=GetGadgetState(ChPlay)
If \Play
If IsThread(_Thread)=0
_Thout=0
_Thread=CreateThread(@ThPlay(),Ev):EndIf
Else
QuitThread()
SetGadgetAttribute(_CG,1,ImageID(\Img))
EndIf
Case ChbMod :\Modulation=GetGadgetState(ChbMod)
If \Modulation:\Root+7:EndIf
Case Opsoft: Reset(_Soft(),Tb())
Case OpHard: Reset(_Hard(),Tb())
Case OpFury: Reset(_Fury(),Tb())
Seed2 :SetGadgetState(Op1,1)
Case SpinTrans :_Transp=GetGadgetState(SpinTrans)
SetWindowTitle(0,Str(GetGadgetState(Tb(2)))+" "+Str(\Col[2]))
Case Tb(0):\Col[0] =200-GetGadgetState(Tb(0))+100
Case Tb(1):\Col[1] =GetGadgetState(Tb(1))
Case Tb(2):\Col[2] =GetGadgetState(Tb(2))
Case Tb(3):\Col[3] =GetGadgetState(Tb(3))
Case Tb(4):\Col[4] =GetGadgetState(Tb(4))
Case Tb(5):\Col[5] =GetGadgetState(Tb(5))
If \Col[5]:\Col[5]=49-\Col[5]:EndIf
Case Op0:Seed1:_NewSeed=#True
Case Op1:Seed2:_NewSeed=#True
Case Op2:Seed3:_NewSeed=#True
Case Chclick:_Chclick=GetGadgetState(Chclick)
Case ChMode1:_Mode1=GetGadgetState(ChMode1)
Case ChMode2:_Mode2=GetGadgetState(ChMode2)
EndSelect
EndIf
Until _Quit Or EV=#PB_Event_CloseWindow
_Quit=#True
EndWith
QuitThread()
End
;
DataSection
Tbs:
Data.I 0,200,36,67,36,68,35,68,35,68,0,48
Tx:
Data.S "Tempo","ffffff","High","ffff","Low","ff00","Bass","336688"
Data.S "Treble","ff00ff","Fill","ff"
RS:Data.L 80,0,35,35,35,0 ; soft
RH:Data.L 100,67,36,68,40,22 ; hard
RF:Data.L 140,67,50,68,40,40 ; furioso
EndDataSection
