code partially stolen from i don't remember.
Again, sorry for the swedish in code.
Code: Select all
; German forum: http://www.purebasic.fr/german/viewtopic.php?t=426&highlight=
; Author: zapman (updated for PB 4.00 by Andre)
; Date: 13. October 2004
; OS: Windows
; Demo: Yes
;; MIDI File decoder by Zapman
;Disable debugger
Global.u Dim volym(16,255),ddd , Dim instrument(16) , instrument,channel_v
Global.q Dim ton(83000)
Global.l Dim colorcodes(16), DeltaTimeIncrement ,filepos
Global.w fileend,txt,lyr,tit,tit2
Global.s Dim text(1000), Dim lyric(1), Dim title(5), Dim title2(5),MidiFileName$
For a=1 To 16
g:
aa+1
r.l=255&(aa*40)
g.l=255&(aa*70)
b.l=255&(aa*100)
If r<100 Or r<100 Or r<200 : Goto g: EndIf
colorcodes(a)=RGB(r,g,b)
Next a
;colorcodes(0)=0
Declare AlertThread1(Parameter)
Declare OpenWindow_3D(c.i)
Declare Play()
Declare.s ReadStringl(Length.l)
Declare ReadVLD ()
Declare ReadMidiFile()
#SaveFile = 0
Global.s Dim MidiInstrument$ (255)
Global.i sss
Restore SMI
For ct = 0 To 255
If ct<128: Read.s MidiInstrument$(ct) :Else :MidiInstrument$(ct)="mute":EndIf
Next
Global.l hMidiOut
Procedure MidiOutMessage(hMidi, iStatus,iChannel,iData1,iData2)
dwMessage = iStatus | iChannel | (iData1 << 8 ) | (iData2 << 16)
ProcedureReturn midiOutShortMsg_(hMidi, dwMessage) ;
EndProcedure
Procedure SetInstrument(channel,instrument)
MidiOutMessage(hMidiOut, $C0, channel, instrument, 0)
EndProcedure
midi.MIDIOUTCAPS
devices = midiOutGetNumDevs_()
For devnum=-1 To devices-1
If midiOutGetDevCaps_(devnum,@midi,SizeOf(MIDIOUTCAPS))=0
If midi\wVoices >0
midiport=devnum
EndIf
EndIf
Next
;*hMidiOut.l
If midiOutOpen_(@hMidiOut,midiport,0,0,0):End:EndIf; = #MMSYSERR_NOERROR
#oktav=12*1
Procedure mute()
Protected.u channel,MNote
; StartDrawing(WindowOutput(1))
;Box(0,0,#screenX, #screeny,#Black)
For channel =0 To 15
For MNote=0 To 127
;MoveEntity(MNote,(MNote-64)*1.1,0,0,#PB_Absolute)
midiOutShortMsg_(hMidiOut, $90 | channel | (mNote << 8 ) )
; Circle(MNote * 6,channel * 40 + 150 ,3,colorcodes(0))
Next mnote
Next channel
WorldGravity(1)
Delay(100)
WorldGravity(0.1)
;For a=9+#oktav To 96+#oktav:ApplyEntityImpulse(a, 0,0.1,0):Next a
;For a=1 To 50:RenderWorld():Next a
; StopDrawing()
EndProcedure
Global.l nr
;{
;-init3d
Define.f x
#CameraSpeed = 0.2
#deg45=0.707106781
If InitEngine3D() =0 : End: EndIf
If InitSprite() =0 : End: EndIf
If InitKeyboard() =0 : End: EndIf
If InitMouse() =0 : End: EndIf
If InitSound() =0 : End: EndIf
IncludeFile #PB_Compiler_Home + "examples/3d/Screen3DRequester.pb"
#screenX=1024
#screeny=768
;If Screen3DRequester() =0 : End: EndIf
OpenWindow (1, 0, 0, #screenX , #screenY , "",1 )
OpenWindowedScreen ( WindowID (1) , 0, 0, #screenX , #screenY , 0, 0, 0 ,1)
;OpenWindow(1, 0, 0, #screenX, #screeny, "", #PB_Window_ScreenCentered | #PB_Window_MinimizeGadget)
Add3DArchive(#PB_Compiler_Home + "examples/3d/Data", #PB_3DArchive_FileSystem)
Add3DArchive(#PB_Compiler_Home + "examples/3d/Data/GUI", #PB_3DArchive_FileSystem)
Add3DArchive(#PB_Compiler_Home + "examples/3d/Data/Scripts", #PB_3DArchive_FileSystem)
Add3DArchive(#PB_Compiler_Home + "examples/3d/Data/Packs/desert.zip", #PB_3DArchive_Zip)
Parse3DScripts()
;- Material
GetScriptMaterial(0, "Color/Green")
GetScriptMaterial(1, "Color/Blue")
GetScriptMaterial(2, "Color/Yellow")
;- Mesh
CreateCube(0, 1)
CreateSphere(1, 6)
;- Entity
#Restitution=-0.0
#friktion=0.0
#visu=1
; ;down stop
; CreateEntity(128 ,MeshID(0), MaterialID(2),-12.7,-0.6,0,0,#visu)
; ;uper stop vita
; CreateEntity(129 ,MeshID(0), MaterialID(0),-12.7,1,2,0,#visu)
; ;uper stop svarta
; CreateEntity(130 ,MeshID(0), MaterialID(0),-12.7,1.4,0,0,#visu)
;
; For a=128 To 130
; ScaleEntity(a,96.5,0.2,1)
; EntityPhysicBody(a,#PB_Entity_StaticBody ,1,1,0 )
; SetEntityCollisionFilter(a,2,1)
; Next a
b=8
For a=9+#oktav To 96+#oktav
;If a>8 And a<97
If b=12 :b=1:Else:b+1:EndIf
If b=5 Or b=12 :x+1:Else :x+0.5:EndIf
;Debug b
If b=1 Or b=3 Or b=6 Or b=8 Or b=10;svarta
z=0
CreateEntity(a, MeshID(0), MaterialID(z+1),(x-40)*1.04,0,-0.7)
EntityPhysicBody(a,#PB_Entity_None )
ScaleEntity(a,0.36,1.6,3)
; SetEntityCollisionFilter(a,1,2)
Else ;vita
z=-1
CreateEntity(a, MeshID(0), MaterialID(z+1),(x-40)*1.04,0,0.7)
EntityPhysicBody(a,#PB_Entity_None )
ScaleEntity(a,1,0.7,5.8)
; SetEntityCollisionFilter(a,1,2)
EndIf
Next a
#sc=0.1
For b=0 To 2
For a=0 To 15
CreateEntity(b*16+a+200, MeshID(0), MaterialID(1),-20+a/2,2+b/2,-2)
ScaleEntity(b*16+a+200,#sc,#sc,#sc)
Next a
Next b
;mute()
;- Camera
CreateCamera(0, 0, 0, 100, 100)
MoveCamera(0,-30,20,35)
CameraLookAt(0,-15,0,0)
;CameraFOV(0, 12)
CreateLight(0, RGB(255, 255, 255))
CreateLight(1, RGB(255, 255, 255))
MoveLight(0, 0,1,60)
MoveLight(1, 0,60,60)
; DisableLightShadows(0, 1)
; DisableLightShadows(1, 1)
RenderWorld()
FlipBuffers()
Delay(1000)
;}
EnableExplicit
;{
;------------------------------------main
OpenWindow_3D(9)
CreateThread(@AlertThread1(), 0)
Repeat
nr=0
fileend=0:txt=0:lyr=0:tit=0:tit2=0
MidiFileName$=OpenFileRequester("", ".MID", ".MID", 0)
;MidiFileName$ = "F:\Musik+Musik+Musik+ Musik+Musik\Midi-Karaoke\classic\bethoven\mond_3.mid"
;MidiFileName$ = "F:\Musik+Musik+Musik+ Musik+Musik\Midi-Karaoke\APACHE.MID"
ReadMidiFile()
SortArray(ton(),#PB_Sort_Ascending,0,nr)
;debug nr
mute()
Play()
Delay(2000)
ForEver
;}
Procedure Play()
Protected.f tempo2,tempo3
Protected.s deb,tile,text
Protected.l delay,tempo_int,counter,counter2,pos1,pos2,time,nr2,tempo
Protected.w event,channel,MNote,MVelocity,startp , g
; Static.a MNote_min=127,MNote_max
If tit
tit-1
For nr2=0 To tit
tile + title(nr2)
If nr2<tit : tile + " - ":EndIf
Next nr2
ElseIf tit2
tit2-1
For nr2=0 To tit2
tile + title2(nr2)
If nr2<tit2 : tile + " - ":EndIf
Next nr2
EndIf
If Trim(tile)="" : tile=MidiFileName$: EndIf
SetWindowTitle(1, tile)
;SetWindowTitle(1, tile)
;debug ""
;debug "---text---"
nr2=0
;-lyrics
; Repeat
; startp=1
; If Left(text(nr2), 1)="/":;debug text:text="":startp=2:EndIf
; If Left(text(nr2), 1)="\":;debug text:;debug"":text="":startp=2:EndIf
; text+ Mid(text(nr2),startp)
; nr2+1
; Until nr2>txt
;MNote_min=127
tempo2=1
DeltaTimeIncrement/10
time=ElapsedMilliseconds()
;-play loop
;{
For nr2=0 To nr
pos1 = ton(nr2) >>24 ;& $FFFFFF000000 / $1000000
pos2 = ton(nr2+1) >>24 ;& $FFFFFF000000 / $1000000
delay= pos2 - pos1
If Delay<0: Delay=5:EndIf
If ton(nr2) & $100000 : tempo=ton(nr2)&$FFFF:counter+1:Goto g:EndIf
If ton(nr2) & $200000 : SetInstrument((ton(nr2) & $FF00)/$100,ton(nr2) & $FF):Goto g:EndIf
channel=(ton(nr2) >>16) & $FF
;If channel <>0:End:EndIf
MNote= (ton(nr2) >>8) & $FF
; $100
MVelocity=ton(nr2) & $FF
midiOutShortMsg_(hMidiOut, $90 | channel | (mNote << 8 ) | (mvelocity << 16))
g:
ExamineKeyboard()
If KeyboardReleased(#PB_Key_P) :g!1:EndIf
If WindowEvent() = #PB_Event_CloseWindow:mute():End:EndIf
If KeyboardPushed(#PB_Key_Add):tempo2 * 0.99 :EndIf
If KeyboardPushed(#PB_Key_Subtract):tempo2 * 1.01:EndIf
If KeyboardPushed(#PB_Key_Return):tempo2=1:EndIf
If KeyboardPushed(#PB_Key_Escape):mute():End:EndIf
If KeyboardReleased(#PB_Key_R):mute():Delay(500):nr2=0:time=ElapsedMilliseconds():EndIf
If KeyboardReleased(#PB_Key_L):mute():ProcedureReturn:EndIf
If g :Delay(20):time+20:Goto g:EndIf
If KeyboardReleased(#PB_Key_Pad7):channel_v+1:channel_v & 15:EndIf
If KeyboardReleased(#PB_Key_M):instrument(channel_v) ! 128
SetInstrument(channel_v,instrument(channel_v))
EndIf
If KeyboardReleased(#PB_Key_Pad8):instrument(channel_v) +1:instrument(channel_v) & 127:
SetInstrument(channel_v,instrument(channel_v))
;instrument(channel_v)=instrument
EndIf
;StartDrawing(WindowOutput(1))
;DrawText(50,15, StrF((ElapsedMilliseconds()-time)/1000,3) + " "+StrF(tempo2,2))
;If tempo3>0.1:DrawText(50,30, StrF(pos1/1000,3) + " " +Str(nr2) +" " +Str(nr ) + " " +StrF(122 / tempo3,1)):EndIf
;Circle(MNote * 6,channel * 40 + 150 ,3,colorcodes((channel+1)*Int(Sign(MVelocity))))
If MNote >8; And channel_v= channel
If MVelocity
; ApplyEntityImpulse(MNote, 0,-0.8,0)
; ApplyEntityForce(MNote,0,0.8,0)
MoveEntity(mnote,EntityX(mnote),-0.4,EntityZ(mnote),#PB_Absolute)
;EntityVelocity(MNote, 0,-200,0)
EndIf
If MVelocity=0
; ApplyEntityImpulse(MNote, 0, 0.8,0)
; ApplyEntityForce(MNote,0,0.8,0)
;EntityVelocity(MNote, 0,200,0)
MoveEntity(mnote,EntityX(mnote),0,EntityZ(mnote),#PB_Absolute)
EndIf
EndIf
;StopDrawing()
tempo3 = tempo / DeltaTimeIncrement * tempo2
Delay(delay * tempo3)
;SetGadgetText3D(2,"channel ");+Str(channel))
; RenderWorld()
;
; FlipBuffers()
Next nr2
; If ExamineKeyboard()
;
; If KeyboardPushed(#PB_Key_D): :CallDebugger:EndIf
; If KeyboardReleased(#PB_Key_F2) And nr2>50:mute():Delay(200) :nr2-50:EndIf
; If KeyboardPushed(#PB_Key_Left): KeyX = -#CameraSpeed
; ElseIf KeyboardPushed(#PB_Key_Right): KeyX = #CameraSpeed
; Else: KeyX = 0
; EndIf
;
; If KeyboardPushed(#PB_Key_Up): Keyz = -#CameraSpeed
; ElseIf KeyboardPushed(#PB_Key_Down): Keyz = #CameraSpeed
; Else: Keyz = 0
; EndIf
;
; If KeyboardPushed(#PB_Key_PageDown): Keyy = -#CameraSpeed
; ElseIf KeyboardPushed(#PB_Key_PageUp): Keyy = #CameraSpeed
; Else: Keyy = 0
; EndIf
;
; EndIf
;
; ;RotateCamera(0, MouseY, MouseX, 0, #PB_Relative)
; ;CameraFollow(0, EntityID(#ball), 1,400,100, 0,0); [, Mode])
; ;MoveLight(0, CameraX(0), CameraY(0), CameraZ(0),#PB_Absolute)
; If ElapsedMilliseconds()&63
; MoveCamera (0, KeyX, KeyY, KeyZ)
; RenderWorld()
; FlipBuffers()
; EndIf
;}
;debug "ending"
;SetClipboardText(deb)
;mute()
Delay(1000)
EndProcedure
Procedure ReadAsciiCh()
Protected.a asc
asc=ReadAsciiCharacter(0)
filepos=Loc(0)
fileend+Eof(0)
;;debug Hex(filepos) + #TAB$ + Hex(asc)+ #TAB$ + Str(asc)
;If fileend::;debug "end : "+fileend:EndIf
ProcedureReturn asc
EndProcedure
Procedure ReadMidiFile()
Protected.a MEvent,TEvent,mTEvent,SeqNumberYesNo
Protected.s ChkName$ , MetaEvent$ , MidiEvent$ , ControlerEvent$,rs_test
Protected.l ChkLength , mloc , MFormatType , NbOfMTrk , ContRead , Delta_time , time_pos
Protected.l LEvent , RS , MIDICue
Protected.l MTempo , SecOffset , FrameOffset
Protected.a Numerator , Denominator , NbOfMidiClockPerMetronomeClick , Notated32ndPerQuarterNote
Protected.l sf , MajorMinor
Protected.l MNote , MVelocity , MPressure , MControlerNumber , MValue , instrument , MPitch , MTimeCode , MBeat , MNumber
Protected.l channel,track
;MidiFileName$= "APACHE.MID";
;SetCurrentDirectory("F:\Musik+Musik+Musik+ Musik+Musik\Midi-Karaoke\midi")
If ReadFile(0, MidiFileName$)
ChkName$ = ReadStringl(4)
ChkLength = (ReadAsciiCh()*256*256*256)+(ReadAsciiCh()*256*256)+(ReadAsciiCh()*256)+ReadAsciiCh()
If ChkName$<>"MThd" Or ChkLength <> 6
MessageRequester("Error","Unknown format !! : "+ChkName$+" / "+Str(ChkLength),0)
ProcedureReturn(0)
EndIf
mloc = Loc(0)
MFormatType = ReadAsciiCh()*256+ReadAsciiCh()
;debug "FormatType = "+Str(MFormatType )
NbOfMTrk = ReadAsciiCh()*256+ReadAsciiCh()
;debug "Number of tracks = "+Str(NbOfMTrk)
DeltaTimeIncrement = ReadAsciiCh()*256+ReadAsciiCh()
;debug "DeltaTimeIncrement = "+Str(DeltaTimeIncrement)
FileSeek(0, mloc+ChkLength)
;-loop
While NbOfMTrk
;debug "track: "+Str(track)
ChkName$ = ReadStringl(4)
If ChkName$=""
MessageRequester("Error","Abnormal EndOfFile encountered.",0)
ProcedureReturn(0)
EndIf
ChkLength = (ReadAsciiCh()*256*256*256)+(ReadAsciiCh()*256*256)+(ReadAsciiCh()*256)+ReadAsciiCh()
NbOfMTrk - 1
If ChkName$<>"MTrk"
;debug "Unknown Track Type: "+ChkName$
FileSeek(0, Loc(0)+ChkLength)
Else
ContRead = 1
While ContRead
If fileend: ProcedureReturn nr:EndIf
Delta_time = ReadVLD ()
;-------------time
If Delta_time> 2435:ddd+1 :EndIf
;Delay(Delta_time/2)
time_pos+Delta_time
;-------------
;ExamineKeyboard():If KeyboardPushed(#PB_Key_Escape):End:EndIf
; If Delta_time> 10000: Call;debugger:EndIf
MEvent = ReadAsciiCh() ;: If MEvent<0 : MEvent+256 : EndIf
If MEvent = $F0 Or MEvent = $F7 ; SYSEX Event
;debug Str(time_pos)+#TAB$+"SYSEX Event"
LEvent = ReadVLD()
FileSeek(0, Loc(0)+LEvent)
ElseIf MEvent = $FF ; Meta Event
TEvent = ReadAsciiCh()
;;debug "Meta Event type : "+Str(TEvent)
RS = 1
Select TEvent
Case 0
MetaEvent$ = "Sequence Number: "
RS = 0
SeqNumberYesNo = ReadAsciiCh()
If SeqNumberYesNo
MIDICue = ReadAsciiCh()*256 + ReadAsciiCh()
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"
;--------- End of Track
time_pos=0
RS = 0
ReadAsciiCh()
ContRead = 0
Case $51
MetaEvent$ = "Set Tempo, in microseconds per MIDI quarter-note"
RS = 0
ReadAsciiCh()
MTempo = ReadAsciiCh()*256*256 + ReadAsciiCh()*256 + ReadAsciiCh()
MetaEvent$ + ": "+Str(MTempo)
;-------------------------------Set Tempo
;If MTempo<0:Call;debugger:EndIf
ton(nr)=time_pos *$1000000 + $100000 + MTempo/10000
;$100000
nr+1
Case $54
MetaEvent$ = "SMPTE Offset"
RS = 0
ReadAsciiCh()
SecOffset = ReadAsciiCh()*3600+ReadAsciiCh()*60+ReadAsciiCh()
FrameOffset = ReadAsciiCh()*100 + ReadAsciiCh()
MetaEvent$+": "+Str(SecOffset)+" sec. and "+Str(FrameOffset)+" 1/100 of frame"
Case $58
MetaEvent$ = "Time Signature: "
RS = 0
ReadAsciiCh()
Numerator = ReadAsciiCh()
Denominator = ReadAsciiCh()
NbOfMidiClockPerMetronomeClick = ReadAsciiCh()
Notated32ndPerQuarterNote = ReadAsciiCh()
MetaEvent$+Str(Numerator)+#TAB$+Str(Denominator)+#TAB$+Str(NbOfMidiClockPerMetronomeClick)+#TAB$+Str(Notated32ndPerQuarterNote)
Case $59
MetaEvent$ = "Key Signature"
RS = 0
ReadAsciiCh()
sf = ReadAsciiCh()
MajorMinor = ReadAsciiCh()
Case $7F
MetaEvent$ = "Sequencer-Specific Meta-Event"
Default
MetaEvent$ = "Unknown Meta-Event ("+Hex(TEvent)+")"
EndSelect
If RS
LEvent = ReadVLD ()
RS_test=ReadStringl(LEvent)
;If TEvent=1 :text(txt)=MetaEvent$+RS_test:txt+1:EndIf
;--- text
If Left(RS_test, 2)="@T" :title(tit)=Mid(RS_test,3):tit+1:EndIf
If track=0 And tit2<4 And (TEvent=3 Or TEvent=1) :title2(tit2)=RS_test:tit2+1:EndIf
If TEvent=1 :text(txt)=RS_test:txt+1:EndIf
;debug Str(time_pos)+#TAB$+MetaEvent$+RS_test
Else
;debug Str(time_pos)+#TAB$+MetaEvent$
EndIf
Else
; MIDI Event
TEvent = MEvent
;If nr=10000:Call;debugger:EndIf
If TEvent<$80 ; This is not an Event. Keep the old Status
;;debug "not an Event"
FileSeek(0, Loc(0)-1)
TEvent = mTEvent
Else
mTEvent = TEvent
EndIf
;;debug "Midi Event type : "+Hex(TEvent)
channel=TEvent&$F
If TEvent >=$80 And TEvent <=$8F
MNote = ReadAsciiCh()
MVelocity = ReadAsciiCh()
MidiEvent$ = "Note Off, channel "+Str(channel)+" - Note : "+Str(MNote)+" - Velocity : "+Str(MVelocity)
;-------------off
;stopnote(channel,MNote)
;volym(channel,MNote)=0
ton(nr)=time_pos *$1000000 + channel*$10000 + MNote*$100
nr+1
ElseIf TEvent >=$90 And TEvent <=$9F
MNote = ReadAsciiCh()
MVelocity = ReadAsciiCh()
MidiEvent$ ="Note On, channel "+Str(channel)+" - Note : "+Str(MNote)+" - Velocity : "+Str(MVelocity)
;--------------on
;PlayNote(channel,MNote,MVelocity)
;channel=channel
; time delay channel note vol
;ton(nr)=time_pos * 1<<32 + channel*1<<17 + MNote*1<<9 + MVelocity
ton(nr)=time_pos *$1000000 + channel*$10000 + MNote*$100 + MVelocity
If nr=83000:ProcedureReturn nr:EndIf
nr+1
;Delay(200)
ElseIf TEvent >=$A0 And TEvent <=$AF
MNote = ReadAsciiCh()
MPressure = ReadAsciiCh()
MidiEvent$ ="After touch, channel "+Str(channel)+" - Note : "+Str(MNote)+" - Pressure : "+Str(MPressure)
ElseIf TEvent >=$B0 And TEvent <=$BF
MControlerNumber = ReadAsciiCh()
MValue = ReadAsciiCh()
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(channel)+" - "+ControlerEvent$
ElseIf TEvent >=$C0 And TEvent <=$CF
instrument = ReadAsciiCh()
MidiEvent$ ="Program Change, channel "+Str(channel)+" - ProgramNumber : "+Str(instrument)+" : "+MidiInstrument$(instrument)
ton(nr)=time_pos *$1000000 + $200000 +channel*$100+ instrument
instrument(channel)=instrument
nr+1
ElseIf TEvent >=$D0 And TEvent <=$DF
MPressure = ReadAsciiCh()
MidiEvent$ ="ChannelPressure, channel "+Str(channel)+" - Pressure : "+Str(MPressure)
ElseIf TEvent >=$E0 And TEvent <=$EF
;-------------PitchWheel
MPitch = ReadAsciiCh() : If MPitch<0 : MPitch+256 : EndIf
MPitch<<7
MPitch = ReadAsciiCh() + MPitch - $2000
MidiEvent$ ="PitchWheel, channel "+Str(channel)+" - Pitch : "+Str(MPitch)
ElseIf TEvent =$F1
MTimeCode = ReadAsciiCh()
MidiEvent$ ="MTC : "+Str(MTimeCode)
ElseIf TEvent =$F2
MBeat = ReadAsciiCh() : If MBeat <0 : MBeat +256 : EndIf
MBeat <<7
MBeat = ReadAsciiCh() + MBeat
MidiEvent$ ="Midi Beat : "+Str(MBeat)
ElseIf TEvent =$F3
MNumber = ReadAsciiCh()
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
WindowEvent()
;Debug Str(track)+#TAB$+Str(channel)+#TAB$+Str(filepos)+#TAB$+Str(time_pos)+#TAB$+Str(Delta_time)+#TAB$+MidiEvent$
; If Delta_time> 10000:sss+1:EndIf
EndIf
Wend
EndIf
:track+1
Wend
;----------------------------------------------------------
; ;debug Str(time_pos)+#TAB$+"hhh"
; ;debug Str(time_pos)+#TAB$+sss
CloseFile(0)
EndIf
ProcedureReturn nr
EndProcedure
;
Procedure.s ReadStringl(Length.l)
Protected b.a
Protected compt.l
Protected s.s
; 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=0
s=""
While compt<Length
b=ReadAsciiCh()
s=s+Chr(b)
compt + 1
Wend
ProcedureReturn s
EndProcedure
;
Procedure VLDToNum (v) ; Variable lenght Datas decoder
Protected.l rv , ct , l1 , ct2
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
; If rv> 10000: Call;debugger:EndIf
ProcedureReturn rv
EndProcedure
;
Procedure ReadVLD ()
Protected.a d
Protected.l v
;sss+1:If sss=5598: Call;debugger:EndIf
v = 0
Repeat
d = ReadAsciiCh()
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.l) ; Variable lenght Datas encoder
Protected.l rv , ct , l1 , ct2
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)
Protected.l vo,ct
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(#SaveFile, v)
ct - 1
Wend
EndProcedure
;
DataSection
SMI:
Data$ "Ac Gd Piano"
Data$ "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
Procedure OpenWindow_3D(c)
Protected.i a , b , sc_h
sc_h=ScreenHeight()*0.12*0.7
OpenWindow3D(1, 4, 3, ScreenWidth()-8, sc_h, "",#PB_Window3D_Borderless)
ShowGUI(200, 0);,#Camera2,0)
b=ScreenWidth()/((c+1)*1.03)
For a=0 To c
TextGadget3D(a, 10+a * b, 0, 152, sc_h, "")
Next a
EndProcedure
Procedure AlertThread1(Parameter)
Protected.w a
Protected.f MouseX,Mousey,KeyX,KeyY,KeyZ
Repeat
If ExamineMouse()
MouseX = -MouseDeltaX()/10
MouseY = -MouseDeltaY()/10
EndIf
RotateCamera(0, MouseY, MouseX, 0, #PB_Relative)
If ExamineKeyboard()
If KeyboardPushed(#PB_Key_D): :CallDebugger:EndIf
; If KeyboardReleased(#PB_Key_F2) And nr2>50:mute():Delay(200) :nr2-50:EndIf
If KeyboardPushed(#PB_Key_Left): KeyX = -#CameraSpeed
ElseIf KeyboardPushed(#PB_Key_Right): KeyX = #CameraSpeed
Else: KeyX = 0
EndIf
If KeyboardPushed(#PB_Key_Up): Keyz = -#CameraSpeed
ElseIf KeyboardPushed(#PB_Key_Down): Keyz = #CameraSpeed
Else: Keyz = 0
EndIf
If KeyboardPushed(#PB_Key_PageDown): Keyy = -#CameraSpeed
ElseIf KeyboardPushed(#PB_Key_PageUp): Keyy = #CameraSpeed
Else: Keyy = 0
EndIf
EndIf
;RotateCamera(0, MouseY, MouseX, 0, #PB_Relative)
;CameraFollow(0, EntityID(#ball), 1,400,100, 0,0); [, Mode])
;MoveLight(0, CameraX(0), CameraY(0), CameraZ(0),#PB_Absolute)
MoveCamera (0, KeyX, KeyY, KeyZ)
; SetGadgetText3D(1,"Channel"+ #LF$ + Str(channel_v+1))
; SetGadgetText3D(3,"instrument "+ #LF$ + Str(instrument(channel_v)) + #LF$ + MidiInstrument$(instrument(channel_v)))
;
For a=1 To 1
RenderWorld(40)
Next a
FlipBuffers()
ForEver
EndProcedure