A simple PB music sampler.

einander · Post by **einander** » 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!

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

RASHAD · Post by **RASHAD** » Thu Jan 03, 2013 5:39 am

When it comes to music no one can beat einander
(I mean in the forum of course)

BasicallyPure · Post by **BasicallyPure** » Thu Jan 03, 2013 6:04 am

Thanks for posting this.
It sounds really good.

I think I see something in the code that could be improved.
for 64 bit systems I think this will not work correctly when using integers (8 bytes).

Code: Select all

CopyMemory(?Rs,@_Soft(),24)
CopyMemory(?Rh,@_Hard(),24)
CopyMemory(?Rf,@_fury(),24)

a way to fix it would be to use long variable types instead of default integers.
Then it should be good for both 32 and 64 bit systems.

Code: Select all

Global Dim _N.A(0),Dim _Soft.L(5),Dim _Hard.L(5), Dim _fury.L(5)

then,

Code: Select all

Procedure Reset(Array A.L(1),Array Tb(1))

and,

Code: Select all

  RS:Data.L 80,0,35,35,35,0  ; soft
  RH:Data.L 100,67,36,68,40,38   ;hard
  RF:Data.L 140,67,50,68,40,46   ; furioso

When I use 'seed 2' and move 'Low' trackbar to maximum after a while I get an error.
" [ERROR] The specified #sound is not initalized ".

B.P.

einander · Post by **einander** » Thu Jan 03, 2013 6:50 pm

Thanks B.P.!
Code updated with your corrections.

Kurzer · Post by **Kurzer** » Thu Jan 03, 2013 9:31 pm

Thank you very much for sharing your code, einander!

Edit: Hmm, after a few seconds of playing I get a "Sound is not initialized"-error in Line 258.
This failure is reproduceable.

The failure does not occur in your code for the PurePunch Contest.

oryaaaaa · Post by **oryaaaaa** » Sat Jan 05, 2013 1:09 pm

einander wrote: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

This code need more fast, I say "Remove Mutex in thread".
[Main] Read only, Write Address
[Thread[] Write only, Read Address
then, you can creating faster code. I know to create fast sound engine.

infratec · Post by **infratec** » Sat Jan 05, 2013 1:49 pm

@kurzer

Have you enabled 'Thread save' in compiler options

Bernd

Kurzer · Post by **Kurzer** » Sat Jan 05, 2013 4:51 pm

@infratec: Good hint, but I tried now with active threadsafe compiler option.
The only change is, that the programm now crashes at line 89 at "Playsound (Nt)".

Code: Select all

Procedure PlayNt(Nt.A,Chan=0,Vol=100,Z=-1) 
  If Chan=9 And GetGadgetState(_Chclick): PlaySound(1,0,60) ;click
  Else  
    PlaySound(Nt) ; <-- here
    If Z>-1 
      StartDrawing(CanvasOutput(_CG))

infratec · Post by **infratec** » Sat Jan 05, 2013 5:24 pm

kurzer wrote:The only change is, that the programm now crashes at line 89 at "Playsound (Nt)".

Hm, that happens when I don't use 'Thread save'.
PB 5.00 Windows 32bit

Bernd

infratec · Post by **infratec** » Sat Jan 05, 2013 5:38 pm

kurzer is right.

after a long time of playing fine it happens.

Now I found a way to reproduce it quickly:
Pull all sliders up (minimum the first 3) than press 'play'.

Bernd

infratec · Post by **infratec** » Sat Jan 05, 2013 5:48 pm

As I understand the code,
sounds 1, 9 to 96 are available.
Sometimes I get Nt = 6 or 98 and the fault happens

But if I put enough debug outputs in the source
(in front of each PlayNt()) the fault disappears.

After

Code: Select all

Nt+12*Random(2)

I sometimes get 18 as Nt which results in a fault.
(18 - 12 = 6)

einander · Post by **einander** » Sat Jan 05, 2013 6:15 pm

Thanks for the feedback!
I've made a few corrections on the first post: changed the sound 1 (click) to 8, and put a condition on procedure PlayNt() to avoid illegal notes; also the timeout in WaitWindowEvent is removed.

Infratec is correct; only sounds 'click' (now 8 ) and 9 to 96 shoud play.

Kurzer · Post by **Kurzer** » Sat Jan 05, 2013 7:05 pm

Thank you, einander. Now it runs very smoothly.

Olby · Post by **Olby** » Mon Jan 14, 2013 9:37 pm

Can anyone re-upload the samples ? Cant download anything from the link provided. Thanks.

einander · Post by **einander** » Mon Jan 14, 2013 10:35 pm

Hi Olby:
The old link is working for me.
Here is another link with the zip:
https://docs.google.com/file/d/0B8rygHy ... BNdjQ/edit

PureBasic Forums - English

A simple PB music sampler.

A simple PB music sampler.

Re: A simple PB music sampler.

Re: A simple PB music sampler.

Re: A simple PB music sampler.

Re: A simple PB music sampler.

Re: A simple PB music sampler.

Re: A simple PB music sampler.

Re: A simple PB music sampler.

Re: A simple PB music sampler.

Re: A simple PB music sampler.

Re: A simple PB music sampler.

Re: A simple PB music sampler.

Re: A simple PB music sampler.

Re: A simple PB music sampler.

Re: A simple PB music sampler.