Code: Select all
;Music Scales Explorer
;by einander - PureBasic 4.60 Beta 3
EnableExplicit
Define I,Midi.MidioutCaps
Global _DraWing,_HMidiout,_Quit,_SpRoot
Global _MyFont12=FontID(LoadFont(#PB_Any,"Arial",12,#PB_Font_HighQuality))
#NoteOff = $80
#NoteOn = $90
#CtrlChg = $B0
#AllSoundOff = $7800
#WayLeft = 1
#WayRight = 2
#CHROMATIC$ = "C C#D EbE F F#G AbA BbB C " ;2 Chars per Note, mixed # b
#MSEC = 60000.0 ; milliseconds in 1 minute
Enumeration ; 6 CanvasButton States
#Normal=0
#Selected
#Pressed
#HoverSelected
#HoverUnSelected
#Disabled
EndEnumeration
;
Structure BtnColors
TextRGB.L
BackRGB1.L
BackRGB2.L
EndStructure
;
Structure CanvasButton
Indx.I
gNum.I
FontID.I
Selected.I
State.I
RGB.BtnColors[6] ; Colors :\L1=TextColor, \L2=BackColor
Text.S{2}
EndStructure
;
Structure MidiThread
Indx.I
Chan.A ; Midi Channel 0/15
Vel.A ; Midi velocity 0/127
InStrument.I
Ove.I ; Midi octave 0/10
Thread.I
BPM.F
BeatDuration.F
Denom.F
Loop.I
BtnPlay.I
EndStructure
;
Declare PlayThread(*Th1.MidiThread)
Global _Mutex=CreateMutex()
Global Dim _BoxNT.CanvasButton(12)
Global _Root,_Myfont10=FontID(LoadFont(#PB_Any,"arial",10))
Define BR.S="<br>"
Define T$="<html><Body>"
T$+ "<b>Octave</b> is the distance between frequencies with ratio 2:1"+BR
T$+"The twelve-tone equal temperament divides the octave into 12 equal steps."+BR+BR
T$+"<b>Note</b> is the sound of each division."+BR
T$+"If one note has a frequency of 400 Hz, the note one octave above it is at 800 Hz,"
T$+" and the note one octave below is at 200 Hz. Both notes have the same name but the sound is one octave apart."+BR+BR
T$+"<b>Scale</b> is any combinantion of notes, starting on any note and ending on the same note name one octave higher."+BR+BR
T$+"<b>Mode</b> is the order of the steps between the notes of the scale."+BR
T$+"The mode is changed rotating the steps without moving the first and last notes."+BR
T$+"________________________"+BR
T$+"Usage:"+BR+BR
T$+"First and last notes can't be unselected; any other note can be selected\unselected"+BR+BR
T$+"<b>Root</b> is the first note of the scale."+BR+BR
T$+"Button <b>Root</b> transpose all notes"+BR
T$+"Buttons ' < ' and ' > ' rotates all notes and steps."+BR
T$+"Button <b>C Major</b> reset all notes and selections to initial C Major Scale."+BR
T$+"Button <b>Mode</b> rotate selections (change scale mode)."+BR+BR
T$+"</body></html>"
;
Global _HelpWin=OpenWindow(#PB_Any,0,0,640,640,"PB Scale Explorer Help",#PB_Window_SystemMenu | 1|#PB_Window_Invisible)
Define WG=WebGadget(#PB_Any, 0, 0, WindowWidth(_HelpWin) - 10, WindowHeight(_HelpWin) - 10, "")
SetGadgetItemText(WG, #PB_Web_HtmlCode, T$)
Macro GadgetBottom(Gad) : GadgetY(Gad)+GadgetHeight(Gad) : EndMacro
Macro GadgetRight(Gad) : GadgetX(Gad)+GadgetWidth(Gad) : EndMacro
Macro GetBeatDuration(BPM,Denom) ; millisecs for 1 beat
#MSEC/(BPM*Denom)
EndMacro
;
Procedure InitMidiOut() ; open first MidiOutDevice found
Protected Ndev,Midi.Midioutcaps
For NDev=-1 To midiOutGetNumDevs_()-1
If midiOutGetDevCaps_(NDev,@Midi.MidiOUTCAPS,SizeOf(MidiOUTCAPS))=0
If Midi\WVoices>0
midiOutOpen_(@_HMidiout,NDev,0,0,0)
EndIf
EndIf
Next
EndProcedure
;
Procedure CenterTxt1(X,Y,Wi,He,Text.S)
Protected TextWidth=TextWidth(Text),TextHeight=TextHeight(Text)
Protected X1=X+Wi,Y1=Y+He
If TextWidth>Wi : DrawText(X,(Y+Y1)/2-TextHeight/2 , Text)
Else : DrawText((X+X1)/2-TextWidth/2, (Y1+Y)/2-TextHeight/2 , Text)
EndIf
EndProcedure
;
Procedure CBInvertImage(gNum,Wi,He)
Protected Imgid=GetGadgetAttribute(gNum,#PB_Canvas_Image )
Protected Img=CreateImage(#PB_Any,Wi,He)
If _DraWing: StopDrawing():EndIf
_DraWing=StartDrawing(ImageOutput(Img))
Box(0,0,Wi,He,#White)
Protected HTMP=CreateCompatibleDC_(_DraWing)
SelectObject_(HTMP,ImgID)
BitBlt_(_DraWing,0,0,Wi,He,HTMP,0,0,#SRCINVERT)
DeleteDC_(HTMP)
StopDrawing():_DraWing=0
SetGadgetAttribute(gNum,#Pb_Canvas_Image,ImageID(Img))
FreeImage(Img)
EndProcedure
;
Procedure CBDraw(Indx,State=-1,Invert=0) ;- Draw CBtn con Color segun \State
With _BoxNT(Indx)
Static OldgNum
Protected Wi=GadgetWidth(\gNum)
Protected He=GadgetHeight(\gNum)
If State=-1:State=\State:EndIf
If OldgNum
CbInvertImage(OldgNum,Wi,He)
OldgNum=0
EndIf
If Invert
CbInvertImage(\gNum,Wi,He)
OldgNum=\gNum
Else
Protected Img=CreateImage(#PB_Any,Wi,He)
If _DraWing:StopDrawing():EndIf
_DraWing=StartDrawing(ImageOutput(Img)) ;background Color
DrawingMode(#PB_2DDrawing_Gradient)
FrontColor(\RGB[State]\BackRGB1)
BackColor(\RGB[State]\BackRGB2)
LinearGradient(Wi/2,0, Wi/2,He) ; try (0,0,Wi,He) to diagonal Gradient
Box(0,0,Wi,He)
DrawingMode(#PB_2DDrawing_Transparent) ; Button Text
DrawingFont(\Fontid)
FrontColor(\RGB[State]\TextRGB)
CenterTxt1(0,0,Wi,He,\Text)
StopDrawing():_DraWing=0
SetGadgetAttribute(\gNum,#Pb_Canvas_Image,ImageID(Img))
FreeImage(Img)
EndIf
EndWith
EndProcedure
;
Procedure CanvasButton(CBNum,X,Y,Wi,He,Text.S,Fontid,Indx,*CB.CanvasButton,Flags=-1)
Protected I
With *CB
If Flags=-1:Flags=#Pb_Canvas_Keyboard
Else :Flags|#Pb_Canvas_Keyboard
EndIf
\Text=Text
\gNum =CanvasGadget(CBNum,X,Y,Wi,He,Flags)
If CBNum<>#PB_Any:\gNum=CBNum:EndIf
SetGadgetAttribute(\gNum,#Pb_Canvas_Cursor,#Pb_Cursor_Hand)
\Fontid=Fontid
\Indx=Indx
Restore BtnColors
For I=0 To 5
Read.I \RGB[I]\TextRGB
Read.I \RGB[I]\BackRGB1
Read.I \RGB[I]\BackRGB2
Next
CBDraw(Indx)
EndWith
EndProcedure
;
Procedure CanvasCtrl(Indx,EvTyp)
Define State
With _BoxNT(Indx)
Select EvTyp
Case #PB_EventType_LeftButtonDown
If Indx>0 And Indx<12
\Selected!1 :
\State=\Selected
CbDraw(Indx,-1)
EndIf
Case #Pb_EventType_MouseEnter,#Pb_EventType_LeftButtonup
If \Selected : CBDraw(Indx,#HoverSelected)
Else: : CBDraw(Indx,#HoverunSelected)
EndIf
Case #Pb_EventType_Mouseleave
If \Selected : CBDraw(Indx,#Selected)
Else : CBDraw(Indx,#Normal)
EndIf
EndSelect
EndWith
EndProcedure
;
Procedure PlayCtrl(*Th1.MidiThread)
With *Th1
midiOutShortMsg_(_HMidiout, #CtrlChg | \Chan | #AllSoundOff )
If GetGadgetState(\BtnPlay) : \Thread=CreateThread(@PlayThread(),*Th1)
Else : CbDraw(\Indx-1)
EndIf
\Indx=0
EndWith
EndProcedure
;
Procedure PlayThread(*Th1.MidiThread)
With *Th1
Static OldNt
Protected State,Ti
While GetGadgetState(\BtnPlay) And _Quit=0
If ElapsedMilliseconds()-Ti>=\BeatDuration
LockMutex(_Mutex)
If \Indx>12 And \Loop=0
SetGadgetState(\BtnPlay,0)
PlayCtrl(*Th1)
CbDraw(12)
UnlockMutex(_Mutex)
Break
EndIf
Ti=ElapsedMilliseconds()
Repeat ; get next Note to Play
If \Indx>12: \Indx=0: EndIf
State=_BoxNT(\Indx)\State
If State= #Selected Or State=#HoverSelected
Break
EndIf
\Indx+1
ForEver
midiOutShortMsg_(_HMidiout, #NoteOff | \Chan | OldNt << 8 | \Vel << 16) ;
OldNt=\Indx+\Ove*12+_Root
midiOutShortMsg_(_HMidiout, $C0 | \Chan | \InStrument<< 8 ) ; OJO Default=piano 0
midiOutShortMsg_(_HMidiout, #NoteOn | \Chan | OldNt << 8 | \Vel << 16) ;
CbDraw(\Indx,-1,1)
\Indx+1
UnlockMutex(_Mutex)
EndIf
Delay(1)
Wend
EndWith
EndProcedure
;
Procedure Mode(Way)
Protected I,J,K,Stp
Select Way
Case #Wayright
For J=1 To 12
If _BoxNT(J)\Selected
If Stp=0:Stp=J:EndIf
If Stp
_BoxNT(J-Stp)\Selected=1
_BoxNT(J-Stp)\State=1
If J<12
_BoxNT(J)\Selected=0
_BoxNT(J)\State=0
EndIf
EndIf
EndIf
Next
Case #Wayleft
For J=11 To 0 Step -1
If _BoxNT(J)\Selected
If Stp=0:Stp=12-J:EndIf
If Stp
_BoxNT(J+Stp)\Selected=1
_BoxNT(J+Stp)\State= 1
If J
_BoxNT(J)\Selected=0
_BoxNT(J)\State=0
EndIf
EndIf
EndIf
Next
EndSelect
_BoxNT(0)\Selected=1
_BoxNT(12)\Selected=1
_BoxNT(0)\State=1
_BoxNT(12)\State=1
For I=1 To 11 : CbDraw(I,-1) : Next
EndProcedure
;
Procedure Rotation(Way)
Protected Nt.S,I,Stp
Select Way
Case #Wayright
Repeat : Stp+1 : Until _BoxNT(Stp)\Selected
Case #Wayleft
Stp=12
Repeat : Stp-1 : Until _BoxNT(Stp)\Selected
EndSelect
_Root=(_Root+Stp)%12
Nt=Mid(#CHROMATIC$,(_Root % 12)*2+1,2)
SetGadgetState(_SpRoot,_Root)
SetGadgetText(_SpRoot,"Root: "+Nt)
Mode(Way)
For I= 0 To 12
Nt=Mid(#CHROMATIC$,(I+_Root) % 12*2+1,2)
_BoxNT(I)\Text=Nt
CbDraw(I)
Next
SetActiveGadget(_BoxNT(0)\gNum)
EndProcedure
;
;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
OpenWindow(0, 100, 100,650,200 ,"Music Scales Explorer", #PB_Window_SystemMenu|#PB_Window_Invisible | 1)
SetWindowColor(0,0)
Initmidiout()
Define Nt.S,I,Ev,EvGad,Flags,Way,Evtyp
Define *Sel.CanvasButton=0
Define Bwi=40,Bhe=30,X=Bwi,Y=Bhe
Define Th1.MidiThread
Define BtnMajor
Define BtnRotLeft=ButtonGadget(#PB_Any,X,Y,20,30,"<")
X+22
For I=0 To 12
Nt=Trim(Mid(#CHROMATIC$,(I % 12)*2+1,2))
CanvasButton(#PB_Any,X+I*Bwi,Y,Bwi-1,Bhe,Nt,_Myfont10,I,@_BoxNT(I))
Select I
Case 0,2,4,5,7,9,11,12
_BoxNT(I)\State=#Selected
_BoxNT(I)\Selected=1
CbDraw(I)
EndSelect
Next
With Th1.MidiThread
Define BtnRotRight=ButtonGadget(#PB_Any,X+I*Bwi,Y,20,30,">")
Define \BtnPlay=ButtonGadget(#PB_Any,Bwi,80,100,26,"Play",#PB_Button_Toggle)
Define TrackVel=TrackBarGadget(#PB_Any,Bwi,130,230,20,0,127) ; Midi velocity (loudness)
Define TrackBPM=TrackBarGadget(#PB_Any,Bwi,160,230,20,30,1200)
_SPRoot=SpinGadget(#PB_Any,160,80,110,26,-1,12)
Define BtnModeLeft=ButtonGadget(#PB_Any,290,GadgetY(\BtnPlay),30,26,"<")
Define BtnModeRight=ButtonGadget(#PB_Any,320,GadgetY(\BtnPlay),30,26,">")
Define ChBLoop=CheckBoxGadget(#PB_Any,370,80,80,26,"Loop")
Define BtnMajor=ButtonGadget(#PB_Any,520,80,80,26,"C Major")
Define BtnHelp=ButtonGadget(#PB_Any,WindowWidth(0)-100,WindowHeight(0)-40,60,20,"Help")
SetGadgetFont(\BtnPlay,_Myfont12)
SetGadgetFont(_SpRoot,_Myfont12)
SetGadgetFont(ChbLoop,_Myfont12)
SetGadgetFont(Btnmajor,_Myfont12)
SetGadgetText(_SpRoot,"Root: C")
GadgetToolTip(TrackVel,"Volume")
GadgetToolTip(TrackBPM,"Speed")
GadgetToolTip(BtnRotLeft,"Rotation")
GadgetToolTip(BtnRotRight,"Rotation")
Define TGMode=TextGadget(-1,GadgetX(btnmodeleft),gadgetbottom(btnmodeleft),60,16,"Mode",#PB_Text_Center)
SetGadgetColor(tgmode,#PB_Gadget_FrontColor,#White)
SetGadgetColor(tgmode,#PB_Gadget_BackColor,0)
\BPM=200
\Denom=1
\BeatDuration=300
\Ove=4
\Chan=0
\Vel=100
\Instrument=0 ; <<<<<<< general Midi inStrument - try 0 to 127
\Loop=1
SetGadgetState(TrackVel,\Vel)
SetGadgetState(TrackBPM,Th1\BPM)
SetGadgetState(ChbLoop,\Loop)
HideWindow(0,0)
Repeat
EV=WaitWindowEvent()
Select Ev
Case #PB_Event_Gadget
LockMutex(_Mutex)
EvGad=EventGadget()
Select EvGad
Case \BtnPlay:PlayCtrl(Th1)
Case _SpRoot
_Root=GetGadgetState(_SpRoot)
If _Root>11 :_Root=0: SetGadgetState(_SpRoot,0)
ElseIf _Root<0:_Root=11:SetGadgetState(_SpRoot,11)
EndIf
Nt=Mid(#CHROMATIC$,(_Root % 12)*2+1,2)
SetGadgetText(_SpRoot,"Root: "+Nt)
For I=0 To 12
Nt=Mid(#CHROMATIC$,(I+_Root) % 12*2+1,2)
_BoxNT(I)\Text=Nt
CbDraw(I)
Next
SetActiveGadget(_BoxNT(0)\gNum)
Case BtnRotLeft : Rotation(#WayLeft)
Case BtnRotRight : Rotation(#WayRight)
Case BtnModeLeft : Mode(#WayLeft)
Case BtnModeRight : Mode(#WayRight)
Case TrackVel : \Vel=GetGadgetState(TrackVel)
Case TrackBPM : \BPM=GetGadgetState(TrackBPM)
\BeatDuration=GetBeatDuration(\BPM,\Denom)
Case ChbLoop : \Loop=GetGadgetState(ChbLoop)
Case BtnHelp : HideWindow(_HelpWin,0)
Case BtnMajor
_Root=0 : SetGadgetState(_SpRoot,0)
SetGadgetText(_SpRoot,"Root: C")
For I=0 To 12
Nt=Mid(#CHROMATIC$,(I+_Root) % 12*2+1,2)
_BoxNT(I)\Text=Nt
Select I
Case 0,2,4,5,7,9,11,12
_BoxNT(I)\State=#Selected
Default
_BoxNT(I)\State=0
EndSelect
CbDraw(I)
Next
Default
For I=0 To 12
If EvGad= _BoxNT(I)\gNum
CanvasCtrl(I,EventType())
Break
EndIf
Next
EndSelect
UnlockMutex(_Mutex)
EndSelect
If Ev=#PB_Event_CloseWindow
If EventWindow()=_HelpWin:HideWindow(_HelpWin,1)
Else : Break
EndIf
EndIf
Until _Quit
Delay(Th1\BeatDuration)
midiOutShortMsg_(_HMidiout, #CtrlChg | \Chan | #AllSoundOff )
SetGadgetState(\BtnPlay,0)
EndWith
End
;
DataSection
BtnColors: ; Assign here Button Color combinations <<<<<<<<<<<<<
Data.I #Gray , #Gray ,#White ;Normal
Data.I 0 , #Red ,#Yellow ;Selected
Data.I 0 , #Blue ,#White ;Pressed
Data.I 0 , #Yellow ,#Red ;HoverSelected
Data.I #Gray , #White ,#Gray ;HoverUnSelected
Data.I $88888 , $8A8A8A ,#White ;Disabled
EndDataSection 
