PureMetronome Ligth

Programmation d'applications complexes
Dr. Dri
Messages : 2527
Inscription : ven. 23/janv./2004 18:10

PureMetronome Ligth

Message par Dr. Dri »

Un petit métronome en PB ^^

Code : Tout sélectionner

;-bpm.pb
#BPM_Nb  =   7
#BPM_Max = 208

Structure Tempo
  bpm .l[#BPM_Nb]
  name.s[#BPM_Nb]
EndStructure

Global Tempos.Tempo

Procedure.f MsToBeat(bpm.l, ms.l)
  ProcedureReturn (ms / 1000.0) * (bpm / 60.0)
EndProcedure

Procedure.f BeatToMs(bpm.l, beat.l)
  ProcedureReturn (beat * 1000.0) / (bpm / 60.0)
EndProcedure

Procedure InitTempos()
  Protected i.l, *ptr.Long, length.l
  *ptr = ?Tempos
  While i < #BPM_Nb
    Tempos\bpm [i] = *ptr\l
    *ptr + SizeOf(Long)
    length = *ptr\l
    Tempos\name[i] = Space(length)
    *ptr + SizeOf(Long)
    CopyMemory(*ptr, @Tempos\name[i], length)
    *ptr + length
    i + 1
  Wend
EndProcedure

Procedure.s TempoName(bpm.l)
  Protected name.s, i.l
  If bpm >= 40 And bpm <= #BPM_Max
    i = #BPM_Nb
    Repeat
      i - 1
    Until bpm >= Tempos\bpm[i]
    name = Tempos\name[i]
  EndIf
  ProcedureReturn name
EndProcedure

DataSection
  Tempos:
  Data.l 40, 5
  Data.b 'L', 'a', 'r', 'g', 'o'
  Data.l 60, 9
  Data.b 'L', 'a', 'r', 'g', 'h', 'e', 't', 't', 'o'
  Data.l 66, 6
  Data.b 'A', 'd', 'a', 'g', 'i', 'o'
  Data.l 76, 7
  Data.b 'A', 'n', 'd', 'a', 'n', 't', 'e'
  Data.l 108, 8
  Data.b 'M', 'o', 'd', 'e', 'r', 'a', 't', 'o'
  Data.l 120, 7
  Data.b 'A', 'l', 'l', 'e', 'g', 'r', 'o'
  Data.l 168, 11
  Data.b 'P', 'r', 'e', 's', 't', 'i', 's', 's', 'i', 'm', 'o'
EndDataSection

;-midi.pb
Enumeration
  #MIDI_Channel_01
  #MIDI_Channel_02
  #MIDI_Channel_03
  #MIDI_Channel_04
  #MIDI_Channel_05
  #MIDI_Channel_06
  #MIDI_Channel_07
  #MIDI_Channel_08
  #MIDI_Channel_09
  #MIDI_Channel_10
  #MIDI_Channel_Drums = #MIDI_Channel_10
  #MIDI_Channel_11
  #MIDI_Channel_12
  #MIDI_Channel_13
  #MIDI_Channel_14
  #MIDI_Channel_15
  #MIDI_Channel_16
EndEnumeration

Enumeration
  ;listes des instruments
EndEnumeration

Enumeration 35
  #Acoustic_Bass_Drum
  #Bass_Drum_1
  #Side_Stick
  #Acoustic_Snare
  #Hand_Clap
  #Electric_Snare
  #Low_Floor_Tom
  #Closed_Hi_Hat
  #High_Floor_Tom
  #Pedal_Hi_Hat
  #Low_Tom
  #Open_Hi_Hat
  #Low_Mid_Tom
  #High_Mid_Tom
  #Crash_Cymbal_1
  #High_Tom
  #Ride_Cymbal_1
  #Chinese_Cymbal
  #Ride_Bell
  #Tambourine
  #Splash_Cymbal
  #Cowbell
  #Crash_Cymbal_2
  #Vibraslap
  #Ride_Cymbal_2
  #High_Bongo
  #Low_Bongo
  #Mute_High_Conga
  #Open_High_Conga
  #Low_Conga
  #High_Timbale
  #Low_Timbale
  #High_Agogo
  #Low_Agogo
  #Cabasa
  #Maracas
  #Short_Whistle
  #Long_Whistle
  #Short_Guiro
  #Long_Guiro
  #Claves
  #High_Wood_Block
  #Low_Wood_Block
  #Mute_Cuica
  #Open_Cuica
  #Mute_Triangle
  #Open_Triangle
EndEnumeration

Procedure midiOutOpenDevice()
  Protected hMidiOut.l, midi.MidiOutCaps, nDevices.l, port.l
 
  nDevices = midiOutGetNumDevs_()
 
  port = -1
  While port < nDevices And midi\wVoices <= 0
    midiOutGetDevCaps_( port, midi, SizeOf(MidiOutCaps) )
    port + 1
  Wend
 
  If port < nDevices
    midiOutOpen_(@hMidiOut, port, #Null, #Null, #Null)
  EndIf
 
  ProcedureReturn hMidiOut
EndProcedure

Procedure midiOutCloseDevice(hMidiOut.l)
  midiOutClose_(hMidiOut)
EndProcedure

Procedure midiOutNoteOn(hMidiOut.l, Channel.l, Note.l, Velocity.l)
  Protected Message.l
  Message = $90 | Channel | (Note << 8 ) | (Velocity << 16)
  midiOutShortMsg_(hMidiOut, Message)
EndProcedure

Procedure midiOutNoteOff(hMidiOut.l, Channel.l, Note.l, Velocity.l)
  Protected Message.l
  Message = $80 | Channel | (Note << 8 )
  midiOutShortMsg_(hMidiOut, Message)
EndProcedure

Procedure midiOutNoteOnOff(hMidiOut.l, Channel.l, Note.l, VelocityUp.l, VelocityDown)
  midiOutNoteOn (hMidiOut, Channel, Note, VelocityUp)
  midiOutNoteOff(hMidiOut, Channel, Note, VelocityDown)
EndProcedure

;-metro.pb
;IncludeFile "bpm.pb"
;IncludeFile "midi.pb"

Enumeration
  ;fenetres
  #WindowMetro
  ;gadgets
  #TextBPM
  #SpinBPM
  #TextTempo
  #ComboSignature
  #ButtonOnOff
EndEnumeration

Procedure Metronome(hMidiOut.l)
  Protected bpm.l, signature.l, ms.l, tick.l, note.l, start.l
  
  start = ElapsedMilliseconds()
  
  Repeat
    
    bpm = GetGadgetState(#SpinBPM)
    signature = GetGadgetState(#ComboSignature) + 2
    ms = BeatToMs(bpm, 1)
    
    If ElapsedMilliseconds() - start >= ms
      
      If tick % signature
        note = #Maracas
      Else
        note = #Side_Stick
      EndIf
      midiOutNoteOnOff(hMidiOut, #MIDI_Channel_Drums, note, 100, 100)
      
      tick  + 1
      start + ms
    EndIf
    
    Delay(1)
  ForEver
EndProcedure

OpenWindow(#WindowMetro, 0, 0, 200, 100,#PB_Window_MinimizeGadget|#PB_Window_ScreenCentered, "PureMetronome light")
  CreateGadgetList( WindowID() )
    TextGadget(#TextBPM, 10, 14, 40, 18, "BPM :")
    SpinGadget(#SpinBPM, 60, 10, 40, 22, 40, 208)
      SetGadgetState(#SpinBPM, 120)
      SetGadgetText(#SpinBPM, "120")
    TextGadget(#TextTempo, 10, 44, 100, 18, "Tempo : Allegro")
    ComboBoxGadget(#ComboSignature, 10, 70, 90, 80)
      For i = 2 To 8
        AddGadgetItem(#ComboSignature, #PB_Default, Str(i)+" / 4")
      Next i
      SetGadgetState(#ComboSignature, 0)
    ButtonGadget(#ButtonOnOff, 110, 10, 80, 80, "on", #PB_Button_Toggle)
  ExtractIconEx_("sndrec32.exe", 0, #Null, @IconID.l, 1)
  SendMessage_(WindowID(), #WM_SETICON, #False, IconID)

InitTempos()

hMidiOut = midiOutOpenDevice()
If hMidiOut = 0
  MessageRequester("Erreur", "Impossible d'ouvrir un port midi", #MB_ICONERROR)
  End
EndIf

Repeat
  Event = WaitWindowEvent()
 
  If Event = #PB_Event_Gadget
   
    Gadget = EventGadgetID()
   
    If Gadget = #SpinBPM
     
      bpm = GetGadgetState(#SpinBPM)
      SetGadgetText( #SpinBPM, Str( bpm ) )
      SetGadgetText( #TextTempo, "Tempo : " + TempoName(bpm) )
     
    ElseIf Gadget = #ButtonOnOff
     
      If tID
        KillThread(tID)
        SetGadgetText(#ButtonOnOff, "On")
        tID = 0
      Else
        tID = CreateThread(@Metronome(), hMidiOut)
        SetGadgetText(#ButtonOnOff, "Off")
      EndIf
     
    EndIf
   
  EndIf
Until Event = #PB_Event_CloseWindow

If tID
  KillThread(tID)
EndIf

midiOutCloseDevice(hMidiOut)

CloseWindow(#WindowMetro)
Dri ;)
Dernière modification par Dr. Dri le mer. 21/sept./2005 21:16, modifié 1 fois.
lionel_om
Messages : 1500
Inscription : jeu. 25/mars/2004 11:23
Localisation : Sophia Antipolis (Nice)
Contact :

Message par lionel_om »

Lol c'est simpa.
C'était ça ta One Night Prog ? :P
Webmestre de Basic-univers
Participez à son extension: ajouter vos programmes et partagez vos codes !
Dr. Dri
Messages : 2527
Inscription : ven. 23/janv./2004 18:10

Message par Dr. Dri »

oué, c'est devenu un one afternoon prog avec les plantages répétés de l'ide lol (j'ai réinstallé la 3.93)

Dri
Répondre