PureBasic

Forums PureBasic - Français
https://www.purebasic.fr/french/

Décodeur de fichiers Midi

https://www.purebasic.fr/french/viewtopic.php?t=1627

Page 1 sur 1

Décodeur de fichiers Midi

Publié : mer. 13/oct./2004 11:46
par ZapMan
MonPiano va enregistrer ses partitions en Midi. Comme il semble que personne ne se soit encore amuser à décoder ce format, ben voilà :

Code : Tout sélectionner

; MIDI File decoder by Zapman

Declare.s ReadStringl(Length.l)
Declare ReadVLD ()
Declare ReadMidiFile()

Dim MidiInstrument$ (127)
Restore SMI
For ct = 0 To 127
  Read MidiInstrument$(ct)
Next

ReadMidiFile()
;
Procedure ReadMidiFile()
  MidiFileName$= OpenFileRequester("", ".MID", ".MID", 0) 
  If ReadFile(0, MidiFileName$)
    ChkName$ = ReadStringl(4)
    ChkLength = (ReadByte()*256*256*256)+(ReadByte()*256*256)+(ReadByte()*256)+ReadByte()
    If ChkName$<>"MThd" Or ChkLength <> 6
      MessageRequester("Error","Unknown format !! : "+ChkName$+" / "+Str(ChkLength),0)
      ProcedureReturn(0)
    EndIf
    mloc = Loc()
    MFormatType = ReadByte()*256+ReadByte()
    Debug "FormatType = "+Str(MFormatType )
    NbOfMTrk = ReadByte()*256+ReadByte()
    Debug "Number of tracks = "+Str(NbOfMTrk)
    DeltaTimeIncrement = ReadByte()*256+ReadByte()
    Debug "DeltaTimeIncrement  = "+Str(DeltaTimeIncrement)
    FileSeek(mloc+ChkLength)
    While NbOfMTrk
      ChkName$ = ReadStringl(4)
      If ChkName$=""
        MessageRequester("Error","Abnormal EndOfFile encountered.",0)
        ProcedureReturn(0)
      EndIf
      ChkLength = (ReadByte()*256*256*256)+(ReadByte()*256*256)+(ReadByte()*256)+ReadByte()
      NbOfMTrk - 1
      If ChkName$<>"MTrk"
        Debug "Unknown Track Type: "+ChkName$
        FileSeek(Loc()+ChkLength)
      Else
        ContRead = 1
        While ContRead
        Delta_time = ReadVLD ()
        MEvent = ReadByte() : If MEvent<0 : MEvent+256 : EndIf
        If MEvent = $F0 Or MEvent = $F7 ; SYSEX Event
          Debug "SYSEX Event"
          LEvent = ReadVLD ()
          FileSeek(Loc()+LEvent)
        ElseIf MEvent = $FF ; Meta Event
          TEvent = ReadByte()
          ;Debug "Meta Event type : "+Str(TEvent)
          RS = 1
          Select TEvent
            Case 0
              MetaEvent$ = "Sequence Number"
              RS = 0
              SeqNumberYesNo = ReadByte()
              If SeqNumberYesNo
                MIDICue = ReadByte()*256 + ReadByte()
                MetaEvent$+" - MidiCue: "+Str(MIDICue)
              EndIf
            Case 1
              MetaEvent$ = "Text"
            Case 2
              MetaEvent$ = "Copyright"
            Case 3
              MetaEvent$ = "Sequence/Track Name"
            Case 4
              MetaEvent$ = "Instrument Name"
            Case 5
              MetaEvent$ = "Lyric"
            Case 6
              MetaEvent$ = "Marker"
            Case 7
              MetaEvent$ = "Cue Point"
            Case 8
              MetaEvent$ = "Program Name"
            Case 9
              MetaEvent$ = "Device Name"
            Case $20
              MetaEvent$ = "MIDI Channel Prefix"
            Case $2F
              MetaEvent$ = "End of Track"
              RS = 0
              ReadByte()
              ContRead = 0
            Case $51
              MetaEvent$ = "Set Tempo, in microseconds per MIDI quarter-note"
              RS = 0
              ReadByte()
              MTempo = ReadByte()*256*256 + ReadByte()*256 + ReadByte()
              MetaEvent$ + ": "+Str(MTempo)
            Case $54
              MetaEvent$ = "SMPTE Offset"
              RS = 0
              ReadByte()
              SecOffset = ReadByte()*3600+ReadByte()*60+ReadByte()
              FrameOffset = ReadByte()*100 + ReadByte()
              MetaEvent$+": "+Str(SecOffset)+" sec. and "+Str(FrameOffset)+" 1/100 of frame"
            Case $58
              MetaEvent$ = "Time Signature"
              RS = 0
              ReadByte()
              Numerator = ReadByte()
              Denominator = ReadByte()
              NbOfMidiClockPerMetronomeClick = ReadByte()
              Notated32ndPerQuarterNote = ReadByte()
              
            Case $59
              MetaEvent$ = "Key Signature"
              RS = 0
              ReadByte()
              sf = ReadByte()
              MajorMinor = ReadByte()
            Case $7F
              MetaEvent$ = "Sequencer-Specific Meta-Event"
            Default
              MetaEvent$ = "Unknown Meta-Event ("+Hex(TEvent)+")"
          EndSelect
          If RS
            LEvent = ReadVLD ()
            Debug MetaEvent$+": "+ReadStringl(LEvent )
          Else
            Debug MetaEvent$
          EndIf
        Else
          ; MIDI Event
          
          TEvent = MEvent
          If TEvent<$80 ; This is not an Event. Keep the old Status
            FileSeek(Loc()-1)
            TEvent = mTEvent
          Else
            mTEvent = TEvent
          EndIf
          ;Debug "Midi Event type : "+Hex(TEvent)
          If TEvent >=$80 And TEvent <=$8F
            MNote = ReadByte() : If MNote <0 : MNote + 256 : EndIf
            MVelocity = ReadByte() : If MVelocity <0 : MVelocity + 256 : EndIf
            MidiEvent$ = "Note Off, channel "+Str(TEvent&$F)+" - Note : "+Str(MNote)+" - Velocity : "+Str(MVelocity)
          ElseIf TEvent >=$90 And TEvent <=$9F
            MNote = ReadByte() : If MNote <0 : MNote + 256 : EndIf
            MVelocity = ReadByte() : If MVelocity <0 : MVelocity + 256 : EndIf
            MidiEvent$ ="Note On, channel "+Str(TEvent&$F)+" - Note : "+Str(MNote)+" - Velocity : "+Str(MVelocity)
          ElseIf TEvent >=$A0 And TEvent <=$AF
            MNote = ReadByte() : If MNote <0 : MNote + 256 : EndIf
            MPressure = ReadByte() : If MPressure <0 : MPressure + 256 : EndIf
            MidiEvent$ ="After touch, channel "+Str(TEvent&$F)+" - Note : "+Str(MNote)+" - Pressure : "+Str(MPressure)
          ElseIf TEvent >=$B0 And TEvent <=$BF
            MControlerNumber = ReadByte()
            MValue = ReadByte() : If Mvalue<0 : MValue + 256 : EndIf
            Select MControlerNumber
              Case 0
                ControlerEvent$ = "Bank Select - Coarse: "+Str(MValue)
              Case 32
                ControlerEvent$ = "Bank Select - Fine: "+Str(MValue)
              Case 1
                ControlerEvent$ = "MOD Wheel - Coarse: "+Str(MValue)
              Case 33
                ControlerEvent$ = "MOD Wheel - Fine: "+Str(MValue)
              Case 2
                ControlerEvent$ = "Breath Control - Coarse: "+Str(MValue)
              Case 34
                ControlerEvent$ = "Breath Control - Fine: "+Str(MValue)
              Case 4
                ControlerEvent$ = "Foot Pedal - Coarse: "+Str(MValue)
              Case 36
                ControlerEvent$ = "Foot Pedal - Fine: "+Str(MValue)
              Case 5
                ControlerEvent$ = "Portamento Time - Coarse: "+Str(MValue)
              Case 37
                ControlerEvent$ = "Portamento Time - Fine: "+Str(MValue)
              Case 6
                ControlerEvent$ = "Data Slider - Coarse: "+Str(MValue)
              Case 38
                ControlerEvent$ = "Data Slider - Fine: "+Str(MValue)
              Case 7
                ControlerEvent$ = "Volume - Coarse: "+Str(MValue)
              Case 39
                ControlerEvent$ = "Volume - Fine: "+Str(MValue)
              Case 8
                ControlerEvent$ = "Balance - Coarse: "+Str(MValue)
              Case 40
                ControlerEvent$ = "Balance - Fine: "+Str(MValue)
              Case 10
                ControlerEvent$ = "Pan - Coarse: "+Str(MValue)
              Case 42
                ControlerEvent$ = "Pan - Fine: "+Str(MValue)
              Case 11
                ControlerEvent$ = "Expression - Coarse: "+Str(MValue)
              Case 43
                ControlerEvent$ = "Expression - Fine: "+Str(MValue)
              Case 12
                ControlerEvent$ = "Effect 1 - Coarse: "+Str(MValue)
              Case 44
                ControlerEvent$ = "Effect 1 - Fine: "+Str(MValue)
              Case 13
                ControlerEvent$ = "Effect 2 - Coarse: "+Str(MValue)
              Case 45
                ControlerEvent$ = "Effect 2 - Fine: "+Str(MValue)
              Case 16
                ControlerEvent$ = "General Purpose 1: "+Str(MValue)
              Case 17
                ControlerEvent$ = "General Purpose 2: "+Str(MValue)
              Case 18
                ControlerEvent$ = "General Purpose 3: "+Str(MValue)
              Case 19
                ControlerEvent$ = "General Purpose 4: "+Str(MValue)
              Case 64
                ControlerEvent$ = "Hold Pedal: "
                If MValue >0 And MValue<64
                  ControlerEvent$+"On"
                Else
                  ControlerEvent$+"Off"
                EndIf
              Case 65
                ControlerEvent$ = "Portamento: "
                If MValue >0 And MValue<64
                  ControlerEvent$+"On"
                Else
                  ControlerEvent$+"Off"
                EndIf
              Case 66
                ControlerEvent$ = "Sustenuto: "
                If MValue >0 And MValue<64
                  ControlerEvent$+"On"
                Else
                  ControlerEvent$+"Off"
                EndIf
              Case 67
                ControlerEvent$ = "Soft Pedal: "
                If MValue >0 And MValue<64
                  ControlerEvent$+"On"
                Else
                  ControlerEvent$+"Off"
                EndIf
              Case 68
                ControlerEvent$ = "Legato Pedal: "
                If MValue >0 And MValue<64
                  ControlerEvent$+"On"
                Else
                  ControlerEvent$+"Off"
                EndIf
              Case 69
                ControlerEvent$ = "Hold 2 Pedal: "
                If MValue >0 And MValue<64
                  ControlerEvent$+"On"
                Else
                  ControlerEvent$+"Off"
                EndIf
              Case 70
                ControlerEvent$ = "Sound Variation: "+Str(MValue)
              Case 71
                ControlerEvent$ = "Sound Timbre: "+Str(MValue)
              Case 72
                ControlerEvent$ = "Release Time: "+Str(MValue)
              Case 73
                ControlerEvent$ = "Attack Time: "+Str(MValue)
              Case 74
                ControlerEvent$ = "Sound Brightness: "+Str(MValue)
              Case 75
                ControlerEvent$ = "Sound Control 1: "+Str(MValue)
              Case 76
                ControlerEvent$ = "Sound Control 2: "+Str(MValue)
              Case 77
                ControlerEvent$ = "Sound Control 3: "+Str(MValue)
              Case 78
                ControlerEvent$ = "Sound Control 4: "+Str(MValue)
              Case 79
                ControlerEvent$ = "Sound Control 5: "+Str(MValue)
              Case 80
                ControlerEvent$ = "General Purpose Button1: "
                If MValue >0 And MValue<64
                  ControlerEvent$+"On"
                Else
                  ControlerEvent$+"Off"
                EndIf
              Case 81
                ControlerEvent$ = "General Purpose Button2: "
                If MValue >0 And MValue<64
                  ControlerEvent$+"On"
                Else
                  ControlerEvent$+"Off"
                EndIf
              Case 82
                ControlerEvent$ = "General Purpose Button3: "
                If MValue >0 And MValue<64
                  ControlerEvent$+"On"
                Else
                  ControlerEvent$+"Off"
                EndIf
              Case 83
                ControlerEvent$ = "General Purpose Button4: "
                If MValue >0 And MValue<64
                  ControlerEvent$+"On"
                Else
                  ControlerEvent$+"Off"
                EndIf
              Case 91
                ControlerEvent$ = "Effects Level: "+Str(MValue)
              Case 92
                ControlerEvent$ = "Tremolo Level: "+Str(MValue)
              Case 93
                ControlerEvent$ = "Chorus Level: "+Str(MValue)
              Case 94
                ControlerEvent$ = "Celeste Level: "+Str(MValue)
              Case 95
                ControlerEvent$ = "Phaser Level: "+Str(MValue)
              Case 96
                ControlerEvent$ = "Data Button Increment"
              Case 97
                ControlerEvent$ = "Data Button Decrement"
              Case 99
                ControlerEvent$ = "Non-Registered Parameter Number - Coarse: "+Str(MValue)
              Case 98
                ControlerEvent$ = "Non-Registered Parameter Number - Fine: "+Str(MValue)
              Case 101
                ControlerEvent$ = "Registered Parameter Number - Coarse: "+Str(MValue)
              Case 100
                ControlerEvent$ = "Registered Parameter Number - Fine: "+Str(MValue)
              Case 120
                ControlerEvent$ = "All Sound Off"
              Case 121
                ControlerEvent$ = "All Controllers Off"
              Case 122
                ControlerEvent$ = "Local Keyboard: "
                If MValue >0 And MValue<64
                  ControlerEvent$+"On"
                Else
                  ControlerEvent$+"Off"
                EndIf
              Case 123
                ControlerEvent$ = "All Notes Off"
              Case 124
                ControlerEvent$ = "Omni Off"
              Case 125
                ControlerEvent$ = "Omni On"
              Case 126
                ControlerEvent$ = "Monophonic Mode"+Str(MValue)
              Case 127
                ControlerEvent$ = "Polyphonic Mode"+Str(MValue)
              Default 
                ControlerEvent$ = "Unknown Controler Number: "+Str(MControlerNumber)+" - Value = "+Str(MValue)
            EndSelect
            MidiEvent$ ="Controller, channel "+Str(TEvent&$F)+" - "+ControlerEvent$
                
          ElseIf TEvent >=$C0 And TEvent <=$CF
            MProgramNumber = ReadByte() : If MProgramNumber <0 : MProgramNumber + 256 : EndIf
            MidiEvent$ ="Program Change, channel "+Str(TEvent&$F)+" - ProgramNumber : "+Str(MProgramNumber)+" : "+MidiInstrument$(MProgramNumber)
          ElseIf TEvent >=$D0 And TEvent <=$DF
            MPressure = ReadByte() : If MPressure <0 : MPressure + 256 : EndIf
            MidiEvent$ ="ChannelPressure, channel "+Str(TEvent&$F)+" - Pressure : "+Str(MPressure)
          ElseIf TEvent >=$E0 And TEvent <=$EF
            MPitch = ReadByte() : If MPitch<0 : MPitch+256 : EndIf
            MPitch<<7
            MPitch = ReadByte() + MPitch - $2000
            MidiEvent$ ="PitchWheel, channel "+Str(TEvent&$F)+" - Pitch : "+Str(MPitch)
          ElseIf TEvent =$F1
            MTimeCode = ReadByte()
            MidiEvent$ ="MTC : "+Str(MTimeCode)
          ElseIf TEvent =$F2
            MBeat = ReadByte() : If MBeat <0 : MBeat +256 : EndIf
            MBeat <<7
            MBeat = ReadByte() + MBeat
            MidiEvent$ ="Midi Beat : "+Str(MBeat)
          ElseIf TEvent =$F3
            MNumber = ReadByte()
            MidiEvent$ ="SongSelect : "+Str(MNumber)
          ElseIf TEvent =$F6
            MidiEvent$ ="TuneRequest"
          ElseIf TEvent =$F8
            MidiEvent$ ="MidiClock"
          ElseIf TEvent =$F9
            MidiEvent$ ="MidiTick"
          ElseIf TEvent =$FA
            MidiEvent$ ="MidiStart"
          ElseIf TEvent =$FC
            MidiEvent$ ="MidiStop"
          ElseIf TEvent =$FB
            MidiEvent$ ="MidiCOntinue"
          ElseIf TEvent =$FE
            MidiEvent$ ="ActivSens"
          ElseIf TEvent =$FF
            MidiEvent$ ="Reset"
          Else
            MidiEvent$ ="Unknown Event: "+Hex(TEvent)
            ReadVLD ()
          EndIf
          Debug Str(Delta_time)+": "+MidiEvent$
        EndIf
        Wend
      EndIf
    Wend
      
    CloseFile(0)
  EndIf
EndProcedure
;
Procedure.s ReadStringl(Length.l)
; by Zapman
; (Read string Length from file)
; Lit "Length" caractères dans le fichier actuellement ouvert et retourne le résultat
; sous forme d'une chaine de caractere

; Read "Length" caracteres from the open file and return the result
; as a string.
  compt.l=0
  s$=""
  While compt<Length
    b=ReadByte()
    s$=s$+Chr(b)
    compt + 1
  Wend
  ProcedureReturn s$
EndProcedure
;
Procedure VLDToNum (v) ; Variable lenght Datas decoder
  v&$7F7F7F7F
  rv = 0
  ct = 0
  While v
    l1 = v&$FF
    ct2 = ct : While ct2 : l1*$80 : ct2 - 1 : Wend
    rv + l1
    v /256
    ct + 1
  Wend
  ProcedureReturn rv
EndProcedure
;
Procedure ReadVLD ()
  v = 0
  Repeat
    d.b = ReadByte()
    v = v*256+d
  Until d&$80 = 0
  ProcedureReturn VLDToNum (v)
EndProcedure
;
;
; ******************* BONUS *******************
; 
; If you want to create your own MIDI Files
; you will need that :
;
;
Procedure NumToVLD (v) ; Variable lenght Datas encoder
  ct = 0
  rv = 0
  While v
    l1 = v&$7F
    v = (v - l1)/$80
    If ct > 0
      l1+ $80
    EndIf
    ct2 = ct : While ct2 : l1*256 : ct2 - 1 : Wend
    rv + l1
    ct + 1
  Wend
  ProcedureReturn rv
EndProcedure
;
Procedure WriteVLD (v)
  vo = NumToVLD (v)
  ct = 3
  While PeekB(@vo+ct)=0 : ct - 1 : Wend
  While ct>=0
    v = PeekB(@vo+ct) : If v<0 : v + 256 : EndIf
    WriteByte(v)
    ct - 1
  Wend
EndProcedure 


;

DataSection
SMI:
  Data.s "Ac Gd Piano"
  Data.s "Bght Ac Piano"
  Data$ "El Gd Piano"
  Data$ "Honky-tonk Piano"
  Data$ "Electric Piano 1"
  Data$ "Electric Piano 2"
  Data$ "Harpsichord"
  Data$ "Clavi"
  Data$ "Celesta"
  Data$ "Glockenspiel"
  Data$ "Music Box"
  Data$ "Vibraphone"
  Data$ "Marimba"
  Data$ "Xylophone"
  Data$ "Tubular Bells"
  Data$ "Dulcimer" 
  Data$ "Drawbar Organ" 
  Data$ "Percussive Organ" 
  Data$ "Rock Organ" 
  Data$ "Church Organ" 
  Data$ "Reed Organ" 
  Data$ "Accordion" 
  Data$ "Harmonica" 
  Data$ "Tango Accordion" 
  Data$ "Ac Guitar (nylon)" 
  Data$ "Ac Guitar (steel)" 
  Data$ "El Guitar (jazz)" 
  Data$ "El Guitar (clean)" 
  Data$ "El Guitar (muted)" 
  Data$ "Overdrive Guitar" 
  Data$ "Distortion Guitar" 
  Data$ "Guitar harmonic" 
  Data$ "Ac Bass" 
  Data$ "El Bass (finger)" 
  Data$ "El Bass (pick)" 
  Data$ "Fretless Bass" 
  Data$ "Slap Bass 1" 
  Data$ "Slap Bass 2" 
  Data$ "Synth Bass 1" 
  Data$ "Synth Bass 2" 
  Data$ "Violin" 
  Data$ "Viola" 
  Data$ "Cello" 
  Data$ "Contrabasse" 
  Data$ "Tremolo Strings" 
  Data$ "Pizzicato Strings" 
  Data$ "Orchestral Harp" 
  Data$ "Timpani" 
  Data$ "String Ensemble 1" 
  Data$ "String Ensemble 2" 
  Data$ "SynthStrings 1" 
  Data$ "SynthStrings 2" 
  Data$ "Choir Aahs" 
  Data$ "Voice Oohs" 
  Data$ "Synth Voice" 
  Data$ "Orchestra Hit" 
  Data$ "Trumpet" 
  Data$ "Trombone" 
  Data$ "Tuba" 
  Data$ "Muted Trumpet" 
  Data$ "French Horn" 
  Data$ "Brass Section"
  Data$ "SynthBrass 1" 
  Data$ "SynthBrass 2" 
  Data$ "Soprano Sax" 
  Data$ "Alto Sax" 
  Data$ "Tenor Sax" 
  Data$ "Baritone Sax" 
  Data$ "Oboe" 
  Data$ "English Horn" 
  Data$ "Bassoon" 
  Data$ "Clarinet" 
  Data$ "Piccolo" 
  Data$ "Flute" 
  Data$ "Recorder" 
  Data$ "Pan Flute"
  Data$ "Blown Bottle" 
  Data$ "Shakuhachi" 
  Data$ "Whistle" 
  Data$ "Ocarina" 
  Data$ "Lead 1 (square)" 
  Data$ "Lead 2 (sawtooth)" 
  Data$ "Lead 3 (calliope)" 
  Data$ "Lead 4 (chiff)" 
  Data$ "Lead 5" 
  Data$ "Lead 6 (voice)" 
  Data$ "Lead 7 (fifths)" 
  Data$ "Lead 8 (bass + lead)" 
  Data$ "Pad 1 (new age)"
  Data$ "Pad 2 (warm)" 
  Data$ "Pad 3 (polysynth)" 
  Data$ "Pad 4 (choir)" 
  Data$ "Pad 5 (bowed" 
  Data$ "Pad 6 (metallic)" 
  Data$ "Pad 7 (halo)" 
  Data$ "Pad 8 (sweep)" 
  Data$ "FX 1 (rain)" 
  Data$ "FX 2 (soundtrack)" 
  Data$ "FX 3 (crystal)" 
  Data$ "FX 4 (atmosphere)" 
  Data$ "FX 5 (brightness)" 
  Data$ "FX 6 (goblins)" 
  Data$ "FX 7 (echoe)" 
  Data$ "FX 8 (sci-fi)" 
  Data$ "Sitar" 
  Data$ "Banjo" 
  Data$ "Shamisen" 
  Data$ "Koto" 
  Data$ "Kalimba" 
  Data$ "Bag pipe" 
  Data$ "Fiddle" 
  Data$ "Shanai" 
  Data$ "Tinkle Bell" 
  Data$ "Agogo" 
  Data$ "Steel Drums" 
  Data$ "Woodblock" 
  Data$ "Taiko Drum" 
  Data$ "Melodic Tom" 
  Data$ "Synth Drum" 
  Data$ "Reverse Cymba"
  Data$ "Guitar Fret Noise" 
  Data$ "Breath Noise" 
  Data$ "Seashore"
  Data$ "Bird Tweet" 
  Data$ "Telephone Ring" 
  Data$ "Helicopter"
  Data$ "Applause"
  Data$ "Gunshot"
EndDataSection

Publié : mer. 13/oct./2004 20:20
par comtois
quel bosseur aussi celui là :)

Publié : dim. 17/oct./2004 12:25
par ZapMan
Le code ci-dessus vient d'être corrigé (le 17/10/2004).

Publié : mar. 31/mai/2005 17:47
par Navedac
Quand je viendrai à Nouméa ... faudra qu'on se voit !

Bon Code

Navedac

Publié : mar. 31/mai/2005 22:10
par ZapMan
You're welcome

Publié : lun. 21/août/2006 11:14
par Dr. Dri
J'ai voulu passer le code en V4 mais comme je comprenais rien j'ai regardé les specs du format midi sur wotsit et j'ai commencé à faire un décodeur dans le m^me esprit.

C'est encore un embryon mais il tourne déjà pas trop mal ^^. Le code affiche l'entête, les notes "On/Off" et les changements de Tempo. Pour le tempo, comme jme doute que ca n'inspire personne (moi y compris) le "Delta-Time Increment per MIDI Quarter Note" je me suis permis de le convertir en BPM (Beats Per Minute).

Code : Tout sélectionner

;> ---------------- <
;- MIDI : Constants
;> ---------------- <

#MIDI_Chunk_Header = 'dhTM' ;"MThd"
#MIDI_Chunk_Track  = 'krTM' ;"MTrk"

Enumeration ;MIDI track types
  #MIDI_Track_Single
  #MIDI_Track_Synchronous
  #MIDI_Track_Asynchronous
EndEnumeration

#MIDI_VLV_Max   = $0FFFFFFF
#MIDI_VLV_Error = $FFFFFFFF

;> ----------------- <
;- MIDI : Structures
;> ----------------- <

Structure MIDICHUNK
  dwType.l
  dwSize.l ;remaining size
EndStructure

Structure MIDIHEADER
  wTrack.w ;track type
  wCount.w ;number of tracks
  wDelta.w ;delta time
EndStructure

;> ---------------------------- <
;- MIDI : Variable-Length Value
;> ---------------------------- <

Procedure.l NumToVLV(Num.l)
  Protected VLV.l, i.l
  Protected *VLV.Bytes
  
  If Num & ~#MIDI_VLV_Max
    
    VLV = #MIDI_VLV_Error
    
  Else
    *VLV = @VLV
    
    *VLV\b[0] = (Num >>  0) & $7F
    *VLV\b[1] = (Num >>  7) & $7F
    *VLV\b[2] = (Num >> 14) & $7F
    *VLV\b[3] = (Num >> 21) & $7F
    
    i = 3
    
    While i > 0 And Not *VLV\b[i]
      i - 1
    Wend
    
    While i > 0
      *VLV\b[i] | $80
      i - 1
    Wend
  EndIf
  
  ProcedureReturn VLV
EndProcedure

Procedure.l VLVToNum(VLV.l)
  Protected Num.l, i.l
  Protected *VLV.Bytes
  
  *VLV = @VLV
  
  Num | (*VLV\b[0] & $7F) <<  0
  Num | (*VLV\b[1] & $7F) <<  7
  Num | (*VLV\b[2] & $7F) << 14
  Num | (*VLV\b[3] & $7F) << 21
  
  If VLV <> NumToVLV(Num)
    Num = #MIDI_VLV_Error
  EndIf
  
  ProcedureReturn Num
EndProcedure

Procedure.l WriteVLV(File.l, Num.l)
  Protected Write.l, VLV.l, i.l
  Protected *VLV.Bytes
  
  VLV = NumToVLV(Num)
  
  If IsFile(File) And VLV <> #MIDI_VLV_Error
    *VLV = @VLV
    
    i = 3
    
    While Not *VLV\b[i]
      i - 1
    Wend
    
    While i >= 0
      Write + WriteByte(File, *VLV\b[i])
      i - 1
    Wend
  EndIf
  
  ProcedureReturn Write
EndProcedure

Procedure.l ReadVLV(File.l)
  Protected VLV.l, Len.l
  
  If IsFile(File)
    Repeat
      VLV = (VLV << 8) | (ReadByte(File) & $FF)
      Len + 1
    Until Not VLV & $80
    
    If Len > 4
      VLV = #MIDI_VLV_Error
    EndIf
  Else
    VLV = #MIDI_VLV_Error
  EndIf
  
  ProcedureReturn VLVToNum(VLV)
EndProcedure

;> ----------- <
;- MIDI : File
;> ----------- <

CompilerIf #PB_Compiler_Unicode
  #PB_String = #PB_UTF8
CompilerElse
  #PB_String = #PB_Ascii
CompilerEndIf

Procedure.w ReadBigEndianW(File)
  ReadWord(File)
  !BSWAP eax
  !SHR   eax, 16
  ProcedureReturn
EndProcedure

Procedure.l ReadBigEndianL(File)
  ReadLong(File)
  !BSWAP eax
  ProcedureReturn
EndProcedure

Procedure.s ReadStringN(File.l, Length.l = #PB_Default, Flags.l = #PB_String)
  Protected String.s
  
  If Length <= 0
    String = ReadString(File, Flags)
  Else
    String = Space(Length)
    Length = ReadData(File, @String, Length)
    String = Mid(String, 1, Length)
  EndIf
  
  ProcedureReturn String
EndProcedure

Macro ReadString(File, Length = #PB_Default, Flags = #PB_String)
  ReadStringN(File, Length, Flags)
EndMacro

;> ------------------- <
;- MIDI : Parsing test
;> ------------------- <

MidiFileName$= OpenFileRequester("Open midi file", "", "Midi|*.mid;*.midi", 0)
If ReadFile(0, MidiFileName$)
  
  Chunk.MIDICHUNK
  Header.MIDIHEADER
  
  Chunk\dwType = ReadLong(0)
  Chunk\dwSize = ReadBigEndianL(0)
  
  If Chunk\dwType = #MIDI_Chunk_Header And Chunk\dwSize = SizeOf(MIDIHEADER)
    
    Header\wTrack = ReadBigEndianW(0)
    Header\wCount = ReadBigEndianW(0)
    Header\wDelta = ReadBigEndianW(0)
    
    Debug "FormatType : " + Str(Header\wTrack)
    Debug "NumberOfTracks : " + Str(Header\wCount)
    Debug "DeltaTimeIncrement (BPM ?) : " + StrD(60 * 1000 / Header\wDelta)
    Debug "---"
    
    While Not (Error Or Eof(0))
      
      If Not Error And Lof(0) - Loc(0) < SizeOf(MIDICHUNK)
        Error = #True
      EndIf
      
      If Not Error
        Chunk\dwType = ReadLong(0)
        Chunk\dwSize = ReadBigEndianL(0)
        
        If Chunk\dwType <> #MIDI_Chunk_Track
          Debug "UnknownChunk : " + PeekS(Chunk, 4), 1
          FileSeek(0, Loc(0) + Chunk\dwSize)
        EndIf
      EndIf
      
      If Not Error And Chunk\dwType = #MIDI_Chunk_Track
        Debug "TrackChunk"
        nTracks + 1
        
        Time = 0
        MetaEvent = 0
        
        While Not (Event = $FF And MetaEvent = $2F) ;While Not EndOfTrack
          
          DeltaTime = ReadVLV(0)
          Time + DeltaTime
          
          If DeltaTime = #MIDI_VLV_Error
            Error = #True
            Break
          EndIf
          
          Old   = Event
          Event = ReadByte(0) & $FF
          
          If Event < $80
            FileSeek(0, Loc(0)-1)
            Event = Old
          EndIf
          
          Select Event
            Case $80 To $8F
              Channel  = Event & $F
              Note     = ReadByte(0) & $7F
              Velocity = ReadByte(0) & $7F
              s$ = Str(Time) + " -> Channel : " + Str(Channel)
              s$ + " Note Off : " + Str(Note) + " Velocity : " + Str(Velocity)
              Debug s$
              
            Case $90 To $9F
              Channel  = Event & $F
              Note     = ReadByte(0) & $7F
              Velocity = ReadByte(0) & $7F
              s$ = Str(Time) + " -> Channel : " + Str(Channel)
              s$ + " Note On : " + Str(Note) + " Velocity : " + Str(Velocity)
              Debug s$
              
            Case $A0 To $BF, $E0 To $EF, $F2
              ReadWord(0)
              
            Case $C0 To $DF, $F1, $F3
              ReadByte(0)
              
            Case $FF
              MetaEvent = ReadByte(0) & $FF
              Size = ReadVLV(0)
              
              If Size = #MIDI_VLV_Error
                Error = #True
                Break
              EndIf
              
              If MetaEvent = $51 ;Set tempo
                
                If Size <> 3
                  Error = #True
                  Break
                EndIf
                
                Tempo = 0
                
                While Size
                  Tempo << 8
                  Tempo | (ReadByte(0) & $FF)
                  Size - 1
                Wend
                
                Debug Str(Time) + " -> Set Tempo (BPM) : " + StrD(60 * 1000 * 1000 / Tempo)
              Else
                
                FileSeek(0, Loc(0) + Size)
                
              EndIf
              
          EndSelect
          
        Wend ;While Not EndOfTrack
        
      EndIf
      
    Wend ;While Not (Error Or Eof(0))
  EndIf
  
  If Error
    Debug "An error has occured"
  Else
    Debug "Finished (" + Str(nTracks) + " tracks found)"
  EndIf
  
  CloseFile(0)
EndIf
Pour le moment je me contente de zapper (nan pas de jeu de mot avec Zapman =) les évenements (et méta évennements) qui ne sont pas affichés mais tel que c'est programmé (légerrement inspiré du code de Zapman :lol:) c'est facile à modifier pour ajouter ce qui manque.

Dri

Publié : lun. 21/août/2006 13:15
par KarLKoX
C'est toujours un plaisir de lire tes codes : structuré, claire et rapide :)

Publié : mer. 30/août/2006 20:17
par Dr. Dri
Si tu aimes le structuré jettes un coup d'oeil à ce code ^^
C'est un décodeur de fichier midi beaucoup plus completdans le sens où il décode tout le fichier mais qu'il ne décode rien...

En fait il se contente d'extraire les infos du fichier et de les transmettre à l'utilisateur qui peut choisir de les traiter... J'ai ajouté un code qui affiche les même informations que le code précédent, en se servant du décodeur...

Je voulais en faire un lib mais les fonctions BigEndian ne sont pas toutes correctement gérées par tailbite (bug signalé =)

La lib

Code : Tout sélectionner

EnableExplicit

;> ---------------------- <
;- MidiParser : Constants
;> ---------------------- <

#MIDI_Chunk_Header = 'dhTM' ;"MThd"
#MIDI_Chunk_Track  = 'krTM' ;"MTrk"

Enumeration ;MIDI track types
  #MIDI_Track_Single
  #MIDI_Track_Synchronous
  #MIDI_Track_Asynchronous
EndEnumeration

;> ----------------------- <
;- MidiParser : Structures
;> ----------------------- <

Structure MIDICHUNK
  dwType.l
  dwSize.l ;remaining size
EndStructure

Structure MIDIHEADER
  wTrack.w ;track type
  wCount.w ;number of tracks
  wDelta.w ;delta time
EndStructure

;> ---------------------------------- <
;- MidiParser : Variable-Length Value
;> ---------------------------------- <

#MIDI_VarLen_Max   = $0FFFFFFF ;4 reserved Bytes
#MIDI_VarLen_Error = $FFFFFFFF ;impossible VarLen or Num value

Procedure.l NumToVarLen(Num.l)
  Protected VarLen.l, i.l
  Protected *VarLen.Bytes
  
  If Num & ~#MIDI_VarLen_Max
    
    VarLen = #MIDI_VarLen_Error
    
  Else
    *VarLen = @VarLen
    
    *VarLen\b[0] = (Num >>  0) & $7F
    *VarLen\b[1] = (Num >>  7) & $7F
    *VarLen\b[2] = (Num >> 14) & $7F
    *VarLen\b[3] = (Num >> 21) & $7F
    
    i = 3
    
    While i > 0 And Not *VarLen\b[i]
      i - 1
    Wend
    
    While i > 0
      *VarLen\b[i] | $80
      i - 1
    Wend
  EndIf
  
  ProcedureReturn VarLen
EndProcedure

Procedure.l VarLenToNum(VarLen.l)
  Protected Num.l, i.l
  Protected *VarLen.Bytes
  
  *VarLen = @VarLen
  
  Num | (*VarLen\b[0] & $7F) <<  0
  Num | (*VarLen\b[1] & $7F) <<  7
  Num | (*VarLen\b[2] & $7F) << 14
  Num | (*VarLen\b[3] & $7F) << 21
  
  If VarLen <> NumToVarLen(Num)
    Num = #MIDI_VarLen_Error
  EndIf
  
  ProcedureReturn Num
EndProcedure

Procedure.l WriteVarLen(File.l, Num.l)
  Protected Write.l, VarLen.l, i.l
  Protected *VarLen.Bytes
  
  VarLen = NumToVarLen(Num)
  
  If IsFile(File) And VarLen <> #MIDI_VarLen_Error
    *VarLen = @VarLen
    
    i = 3
    
    While Not *VarLen\b[i]
      i - 1
    Wend
    
    While i >= 0
      Write + WriteByte(File, *VarLen\b[i])
      i - 1
    Wend
  EndIf
  
  ProcedureReturn Write
EndProcedure

Procedure.l ReadVarLen(File.l)
  Protected VarLen.l, Len.l
  
  If IsFile(File)
    Repeat
      VarLen = (VarLen << 8) | (ReadByte(File) & $FF)
      Len + 1
    Until Not VarLen & $80
    
    If Len > 4
      VarLen = #MIDI_VarLen_Error
    EndIf
  Else
    VarLen = #MIDI_VarLen_Error
  EndIf
  
  ProcedureReturn VarLenToNum(VarLen)
EndProcedure

Procedure.l VarLenSize(Value.l, IsVarLen.l = #False)
  Protected Size.l
  
  If IsVarLen
    Value = VarLenToNum(Value)
  EndIf
  
  If Value < 0
    Size = #MIDI_VarLen_Error
  ElseIf Value < (1 <<  7)
    Size = 1
  ElseIf Value < (1 << 14)
    Size = 2
  ElseIf Value < (1 << 21)
    Size = 3
  ElseIf Value < (1 << 28)
    Size = 4
  Else
    Size = #MIDI_VarLen_Error
  EndIf
  
  ProcedureReturn Size
EndProcedure

;> ---------------------- <
;- MidiParser : BigEndian
;> ---------------------- <

ProcedureDLL.w PeekBigEndianW(*MemoryBuffer)
  !MOV   eax, dword [p.p_MemoryBuffer]
  !MOV    ax,  word [eax]
  !BSWAP eax
  !SHR   eax, 16
  ProcedureReturn
EndProcedure

ProcedureDLL.l PeekBigEndianL(*MemoryBuffer)
  !MOV   eax, dword [p.p_MemoryBuffer]
  !MOV   eax, dword [eax]
  !BSWAP eax
  ProcedureReturn
EndProcedure

ProcedureDLL.q PeekBigEndianQ(*MemoryBuffer)
  !MOV   eax, dword [p.p_MemoryBuffer]
  !MOV   edx, dword [eax+0]
  !MOV   eax, dword [eax+4]
  !BSWAP eax
  !BSWAP edx
  ProcedureReturn
EndProcedure

ProcedureDLL.q PeekBigEndianN(*MemoryBuffer.Bytes, Size.l)
  Protected Result.q, i.l
  
  While i < Size
    Result << 8
    Result | (*MemoryBuffer\b[i] & $FF)
    i + 1
  Wend
  
  ProcedureReturn Result
EndProcedure

ProcedureDLL.w ReadBigEndianW(File)
  ReadWord(File)
  !BSWAP eax
  !SHR   eax, 16
  ProcedureReturn
EndProcedure

ProcedureDLL.l ReadBigEndianL(File)
  ReadLong(File)
  !BSWAP eax
  ProcedureReturn
EndProcedure

ProcedureDLL.q ReadBigEndianQ(File)
  ReadQuad(File)
  !XOR   eax, edx
  !XOR   edx, eax
  !XOR   eax, edx
  !BSWAP eax
  !BSWAP edx
  ProcedureReturn
EndProcedure

;> --------------------------- <
;- MidiParser : Event handlers
;> --------------------------- <

Enumeration ;Event types
  #MidiParser_Event_Header  ;header chunk handler
  #MidiParser_Event_Track   ;track chunk handler
  #MidiParser_Event_Command ;channel event handler
  #MidiParser_Event_SysEx   ;system exclusive handler
  #MidiParser_Event_System  ;system event handler
  #MidiParser_Event_Meta    ;meta event handler
  #MidiParser_Event_Chunk   ;non track chunks handler
  #MidiParser_Event_Error   ;error handler
EndEnumeration

Enumeration ;Error codes
  #MidiParser_Error_File
  #MidiParser_Error_Header
  #MidiParser_Error_EOF
  #MidiParser_Error_Time
  #MidiParser_Error_Command
  #MidiParser_Error_SysEx
  #MidiParser_Error_System
  #MidiParser_Error_Meta
  #MidiParser_Error_Track
EndEnumeration

Enumeration ;Event handlers return value
  #MidiParser_Stop
  #MidiParser_Continue
EndEnumeration

Prototype.l HeaderHandler(Track.w, Count.w, Delta.w)
Prototype.l TrackHandler()
Prototype.l CommandHandler(Time.l, Event.l, Channel.l, Param1.l, Param2.l)
Prototype.l SysExHandler(Time.l, Event.l, Size.l, *Buffer)
Prototype.l SystemHandler(Time.l, Event.l, Param.l)
Prototype.l MetaHandler(Time.l, Event.l, Size.l, *Buffer)
Prototype.l ChunkHandler(Type.l, Size.l, *Buffer)

Global Dim EventHandlers.l(#MidiParser_Event_Error)

;> -------------------- <
;- MidiParser : Private
;> -------------------- <

Procedure.l RaiseMidiError(ErrorCode.l)
  ;if the user wants to catch it
  If EventHandlers(#MidiParser_Event_Error)
    ;then lets give him
    CallFunctionFast(EventHandlers(#MidiParser_Event_Error), ErrorCode)
  EndIf
  
  ProcedureReturn #MidiParser_Stop
EndProcedure

Procedure.l ParseMidiHeader(File.l, *Header.MIDIHEADER)
  Protected Result.l
  Protected Handler.HeaderHandler
  Protected Chunk.MIDICHUNK
  
  Chunk\dwType = ReadLong(File)
  Chunk\dwSize = ReadBigEndianL(File)
  
  If Chunk\dwType = #MIDI_Chunk_Header And Chunk\dwSize = SizeOf(MIDIHEADER)
    *Header\wTrack = ReadBigEndianW(File)
    *Header\wCount = ReadBigEndianW(File)
    *Header\wDelta = ReadBigEndianW(File)
    
    If *Header\wTrack >= #MIDI_Track_Single And *Header\wTrack <= #MIDI_Track_Asynchronous
      
      ;the header is valid so parsing continues
      Result  = #MidiParser_Continue
      Handler = EventHandlers(#MidiParser_Event_Header)
      
      ;except if the user doesn't agree
      If Handler
        Result = Handler(*Header\wTrack, *Header\wCount, *Header\wDelta)
      EndIf
      
    Else
      ;this is not a valid midi header
      Result = RaiseMidiError(#MidiParser_Error_Header)
    EndIf
    
  Else
    ;this is not a midi header
    Result = RaiseMidiError(#MidiParser_Error_Header)
  EndIf
  
  ProcedureReturn Result
EndProcedure

Procedure.l ParseMidiTrack()
  Protected Result.l
  Protected Handler.TrackHandler
  
  Result  = #MidiParser_Continue
  Handler = EventHandlers(#MidiParser_Event_Track)
  
  If Handler
    Result = Handler()
  EndIf
  
  ProcedureReturn Result
EndProcedure

Procedure.l ParseMidiCommand(File.l, Time.l, Event.l)
  Protected Result.l, Channel.l
  Protected Param1.l, Param2.l
  Protected Handler.CommandHandler
  
  Channel = LoNibble(Event)
  Event   = HiNibble(Event)
  
  Param1 = ReadByte(File) & $FF
  
  ;Program and After-touch messages
  ;only have a single param
  If Event <> $C And Event <> $D
    Param2 = ReadByte(File) & $FF
  EndIf
  
  If Param1 & $80 Or Param2 & $80
    ;the MSB is set to 1 for events
    RaiseMidiError(#MidiParser_Error_Command)
  Else
    ;the command is valid so parsing continues
    Result  = #MidiParser_Continue
    Handler = EventHandlers(#MidiParser_Event_Command)
    
    If Handler
      Result = Handler(Time, Event, Channel, Param1, Param2)
    EndIf
  EndIf
  
  ProcedureReturn Result
EndProcedure

Procedure.l ParseMidiSysEx(File.l, Time.l, Event.l)
  Protected Result.l, Size.l, *Buffer
  Protected Handler.SysExHandler
  
  Size = ReadVarLen(File)
  
  If Size = #MIDI_VarLen_Error
    RaiseMidiError(#MidiParser_Error_SysEx)
  Else
    *Buffer = AllocateMemory(Size)
  EndIf
  
  If *Buffer
    ReadData(File, *Buffer, Size)
    Result  = #MidiParser_Continue
    Handler = EventHandlers(#MidiParser_Event_SysEx)
    
    If Handler
      Result = Handler(Time, Event, Size, *Buffer)
    EndIf
    
    FreeMemory(*Buffer)
  Else
    FileSeek(File, Loc(File) + Size)
    Result = #MidiParser_Continue
  EndIf
  
  ProcedureReturn Result
EndProcedure

Procedure.l ParseMidiSystem(File.l, Time.l, Event.l)
  Protected Result.l, Param.l
  Protected Handler.SystemHandler
  
  Select Event
    Case $F1, $F3
      Param = ReadByte(File) & $FF
      
      If Param & $80
        ;the MSB is set to 1 for events
        RaiseMidiError(#MidiParser_Error_System)
        Param = $FFFFFFFF
      EndIf
      
    Case $F2
      Param = ReadVarLen(File)
      
      If VarLenSize(Param) <> 2
        ;this event param takes two bytes
        RaiseMidiError(#MidiParser_Error_System)
        Param = $FFFFFFFF
      EndIf
      
    Case $F4
      ;???
    Case $F5
      ;???
      
  EndSelect
  
  Handler = EventHandlers(#MidiParser_Event_System)
  
  If Param >= 0 And Handler
    Result = Handler(Time, Event, Param)
  EndIf
  
  ProcedureReturn Result
EndProcedure

Procedure.l ParseMidiMeta(File.l, Time.l, MetaEvent.l)
  Protected Result.l, Size.l, *Buffer
  Protected Handler.MetaHandler
  
  Size = ReadVarLen(File)
  
  If Size = #MIDI_VarLen_Error
    RaiseMidiError(#MidiParser_Error_Meta)
  Else
    ;if size = 0, force memory allocation
    *Buffer = AllocateMemory(Size + 1)
  EndIf
  
  If *Buffer
    ReadData(File, *Buffer, Size)
    Result  = #MidiParser_Continue
    Handler = EventHandlers(#MidiParser_Event_Meta)
    
    If Handler
      Result = Handler(Time, MetaEvent, Size, *Buffer)
    EndIf
    
    FreeMemory(*Buffer)
  Else
    FileSeek(File, Loc(File) + Size)
    Result = #MidiParser_Continue
  EndIf
  
  ProcedureReturn Result
EndProcedure

Procedure.l ParseMidiChunk(File.l, *Chunk.MIDICHUNK)
  Protected Result.l, *Buffer
  Protected Handler.ChunkHandler
  
  If *Chunk\dwSize
    *Buffer = AllocateMemory(*Chunk\dwSize)
  EndIf
  
  If *Buffer
    ReadData(File, *Buffer, *Chunk\dwSize)
    Result  = #MidiParser_Continue
    Handler = EventHandlers(#MidiParser_Event_Chunk)
    
    If Handler
      Result = Handler(*Chunk\dwType, *Chunk\dwSize, *Buffer)
    EndIf
    
    FreeMemory(*Buffer)
  Else
    FileSeek(File, Loc(File) + *Chunk\dwSize)
    Result = #MidiParser_Continue
  EndIf
  
  ProcedureReturn Result
EndProcedure

;> ------------------- <
;- MidiParser : Public
;> ------------------- <

ProcedureDLL.l SetMidiEventHandler(EventType.l, Callback.l)
  Protected Set.l
  
  ;If Callback is Null then the EventType is not catched (default behavior)
  
  If EventType >= #MidiParser_Event_Header And EventType <= #MidiParser_Event_Error
    EventHandlers(EventType) = Callback
    Set = #True
  EndIf
  
  ProcedureReturn Set
EndProcedure

ProcedureDLL.l ParseMidiFile(Filename.s)
  Protected Parsed.l, File.l, KeepParsing.l
  Protected nTracks.l, Event.l, MetaEvent.l
  Protected DeltaTime.l, Time.l, Old.l, Loc.l
  Protected Chunk.MIDICHUNK
  Protected Header.MIDIHEADER
  
  File = ReadFile(#PB_Any, Filename)
  
  If File
    KeepParsing = ParseMidiHeader(File, Header)
    
    ;
    ; Chunk loop (catch all chunks till the end of file)
    ;
    While KeepParsing And Not Eof(File)
      
      ;if not EOF then there must be another chunk
      If Lof(File) - Loc(File) < SizeOf(MIDICHUNK)
        KeepParsing = RaiseMidiError(#MidiParser_Error_EOF)
      Else
        Chunk\dwType = ReadLong(File)
        Chunk\dwSize = ReadBigEndianL(File)
      EndIf
      
      ;if remaining size is enough, identify the chunk
      If KeepParsing And Lof(File) - Loc(File) < Chunk\dwSize
        
        KeepParsing = RaiseMidiError(#MidiParser_Error_EOF)
        
      ElseIf KeepParsing
        
        Select Chunk\dwType
          Case #MIDI_Chunk_Track
            ;inform the user that a new track is about to be parsed
            KeepParsing = ParseMidiTrack()
            nTracks + 1 ;internal track counter
          Case #MIDI_Chunk_Header
            ;this chunk only append at the begining of the file
            KeepParsing = RaiseMidiError(#MidiParser_Error_Header)
          Default
            ;we don't know this chunk...
            KeepParsing = ParseMidiChunk(File, Chunk)
        EndSelect
        
      EndIf
      
      ;
      ; Track parser (catch all events till the end of the track)
      ;
      If KeepParsing And Chunk\dwType = #MIDI_Chunk_Track
        
        ;exprected file location at the end of the track
        Loc = Loc(File) + Chunk\dwSize
        
        ;reset values
        Time = 0
        MetaEvent = 0
        
        While Not (Event = $FF And MetaEvent = $2F) ;While Not EndOfTrack
          
          DeltaTime = ReadVarLen(File)
          Time + DeltaTime
         
          If DeltaTime = #MIDI_VarLen_Error
            RaiseMidiError(#MidiParser_Error_Time)
            Break
          EndIf
          
          Old   = Event
          Event = ReadByte(File) & $FF
          
          ;Events have MSB set to 1 (ie >= $80)
          ;If not, it's a param for the next event
          ;the next event is the same as the previous
          If Event < $80
            FileSeek(File, Loc(File)-1)
            Event = Old
          EndIf
          
          Select Event
            Case $80 To $EF
              KeepParsing = ParseMidiCommand(File, Time, Event)
              
            Case $F0, $F7
              KeepParsing = ParseMidiSysEx(File, Time, Event)
              
            Case $FF
              MetaEvent = ReadByte(File) & $FF
              
              If MetaEvent & $80
                ;the MSB is set to 1 for events
                KeepParsing = RaiseMidiError(#MidiParser_Error_Meta)
              Else
                KeepParsing = ParseMidiMeta(File, Time, MetaEvent)
              EndIf
              
            Default
              KeepParsing = ParseMidiSystem(File, Time, Event)
              
          EndSelect
          
          ;the user doesn't want to continue ?
          ;an error has occured ?
          If Not KeepParsing
            ;whatever... just stop parsing
            Break
          EndIf
          
        Wend ;While Not EndOfTrack
        
        ;the chunk size is not the specified size
        If Loc <> Loc(File)
          KeepParsing = RaiseMidiError(#MidiParser_Error_Track)
        EndIf
        
      EndIf ;Track parser
      
    Wend ;Chunk loop
    
    ;the number of tracks is not valid
    If nTracks <> Header\wCount
      KeepParsing = RaiseMidiError(#MidiParser_Error_Track)
    EndIf
    
    ;it's finally over ^_^
    If KeepParsing
      Parsed = #True
    EndIf
    
    CloseFile(File)
  Else
    RaiseMidiError(#MidiParser_Error_File)
  EndIf
  
  ProcedureReturn Parsed
EndProcedure

;> ---------------- <
;- MidiParser : EOF
;> ---------------- <
et le fichier d'exemple (qui pour le moment ne fonctionnera qu'avec includefile...)

Code : Tout sélectionner

IncludeFile "MidiParser.pbi"
DisableExplicit

Procedure ShowMidiError(Code)
  Select Code
    Case #MidiParser_Error_File
      Debug "Error : Cannot open the file"
    Case #MidiParser_Error_Header
      Debug "Error : Header Error"
    Case #MidiParser_Error_EOF
      Debug "Error : Unexpected EOF"
    Case #MidiParser_Error_Time
      Debug "Error : Invalid Delta-Time"
    Case #MidiParser_Error_Command
      Debug "Error : Command param"
    Case #MidiParser_Error_SysEx
      Debug "Error : System Exclusive Event"
    Case #MidiParser_Error_System
      Debug "Error : System Event param"
    Case #MidiParser_Error_Meta
      Debug "Error : Meta-event error"
  EndSelect
EndProcedure

Procedure ShowMidiHeader(type, count, delta)
  Debug "FormatType : " + Str(type)
  Debug "NumberOfTracks : " + Str(count)
  Debug "DeltaTimeIncrement (BPM ?) : " + StrD(6E4 / delta)
  Debug "---"
  
  ProcedureReturn #MidiParser_Continue
EndProcedure

Procedure ShowMidiTrack()
  Debug "TrackChunk"
  
  ProcedureReturn #MidiParser_Continue
EndProcedure

Procedure ShowMidiChunk(type, size, *buffer)
  Debug "Unknown chunk : " + PeekS(@type, 4)
  
  ProcedureReturn #MidiParser_Continue
EndProcedure

Procedure ShowMidiCommand(time, event, channel, param1, param2)
  
  Select event
    Case $8
      Debug Str(Time) + " -> Channel : " + Str(channel) + " Note Off : " + Str(param1) + " Velocity : " + Str(param2)
    Case $9
      Debug Str(Time) + " -> Channel : " + Str(channel) + " Note On : " + Str(param1) + " Velocity : " + Str(param2)
  EndSelect
  
  ProcedureReturn #MidiParser_Continue
EndProcedure

Procedure ShowMidiMeta(time, meta, size, *buffer)
  
  Select meta
    Case $51
      tempo = PeekBigEndianN(*buffer, size)
      Debug Str(time) + " -> Set Tempo (BPM) : " + StrD(6E7 / tempo)
      
    Case $2F
      Debug "EndOfTrack"
      Debug "---"
      
  EndSelect
  
  ProcedureReturn #MidiParser_Continue
EndProcedure

SetMidiEventHandler(#MidiParser_Event_Error,   @ShowMidiError()  )
SetMidiEventHandler(#MidiParser_Event_Header,  @ShowMidiHeader() )
SetMidiEventHandler(#MidiParser_Event_Track,   @ShowMidiTrack()  )
SetMidiEventHandler(#MidiParser_Event_Command, @ShowMidiCommand())
SetMidiEventHandler(#MidiParser_Event_Meta,    @ShowMidiMeta()   )

MidiFileName$ = OpenFileRequester("Open midi file", "", "Midi|*.mid;*.midi", 0)

If ParseMidiFile(MidiFileName$)
  Debug GetFilePart(MidiFileName$) + " parsing is over"
Else
  Debug "An error as occured while parsing " + GetFilePart(MidiFileName$)
EndIf
Dri :D

Publié : jeu. 19/oct./2006 6:41
par Dr. Dri
Grande niouze :D
J'ai réussi à programmer un lecteur de fichier midi ^^
La musique est fidèlement restituée mais sur certains midis j'ai des petits soucis de tempo (y doit y avoir un truc que je ne connaisn pas qui peut aussi changer le tempo)

La "lib" MidiParser a complètement changé ou presque ^^
Maintenant j'ai plusieurs lib à part

BigEndian et VarLen
(pour manipuler ces types d'entiers)

MidiParser MidiPlayer et MidiWriter
(our lire, jouer et écrire des fichiers midis)

MidiParser est quasi finie, y reste juste ce probleme de tempo
MidiPlayer contient le minimum vital
MidiWriter n'a pas été commencé

Une démo à télécharger bientôt :D

Dri

Publié : jeu. 19/oct./2006 7:52
par lionel_om
c cool tout ça...
Comme ça on pourra inclure ça dans nos futur RPG ou jeux oldschool !!!

Publié : jeu. 19/oct./2006 18:51
par Dr. Dri
Allez première démo (pas de code pour le moment =)
Je vous demande juste de la tester avec deux ou trois midi parce que j'ai un probleme de tempo sur un de mes fichiers midi (take_me_out dans le zip)

si je pouvais en avoir d'autres pour chercher les points communs et corriger mon parser ce serait cool ^^

sinon pour la démo c'est un lecteur de fichier midi qui force les instruments à être du piano (sauf la batterie qui est l'instrument à part)

MIDI.rar
Image

Dri :D

Publié : ven. 20/oct./2006 10:09
par lionel_om
Sympatoche tout ca !
C'est vrai que le sample "take me out" on a du mal à le reconnaitre au début et que le rythme ets beaucoup plus lent que que WMP9 par exemple.

Mais sinon c'est #yes super !!

Publié : ven. 20/oct./2006 16:02
par Dr. Dri
je me suis trouvé un 2e fichier midi qui tourne au ralenti ^^
j'ai donc un point de départ intéressant pour voir comment régler ce petit problème

Sinon pour la prochaine démo je ferais un petit player simple avec des boutons et une barre de progression

Dri :D

Publié : sam. 19/mai/2007 18:25
par bombseb
bonjour, et désolé de remonter un vieux topic...

est-ce que vous pourriez m'expliquer comment je pourrais calculer la position dans le temps à partir du début du morceau (en secondes ou millisecondes par exemple) de chaque note jouée dans un midi svp ?

j'ai écumé les tutoriaux mais je ne comprends pas du tout surtout la notion de delta time increment...

apparement avant chaque évennement midi il y a une valeur qui est le temps à attendre avant de traiter l'evenement mais je ne sais pas en quelle unité c'est exprimé...

et puis tout les tutoriaux sont en anglais alors ca ne m'aide pas trop
:x

Publié : sam. 19/mai/2007 23:19
par Dr. Dri
en fait c'est compté en nombres de noires, si tu as des rudiments de solfège tu sauras qu'une noire dure un temps, une blanche deux temps etc.

ce nombre de noires dépend du nombre de beats par minute qui peut varier au cours du morceau avec les évennements set_tempo qui peuvent intervenir sur n'importe quelle piste mais qui influent tout le morceau (pour les fichiers synchrones en tout cas)

perso j'ai trouvé ça très compliqué et tu dois pouvoir trouver ça en téléchargement (lib + sources) si tu cherches sur le forum mais j'ai pas touché à mon parser depuis un bout de temps déjà.

Dri
Fuseau horaire sur UTC+01:00
Page 1 sur 1

Développé par phpBB® Forum Software © phpBB Limited

Traduction française officielle © Qiaeru