PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

Wie bekommt man das (am besten) asynchron hin?

https://www.purebasic.fr/german/viewtopic.php?t=32214

Seite 1 von 1

Wie bekommt man das (am besten) asynchron hin?

Verfasst: 28.12.2020 15:51
von ccode_new
Hallo Leute,
hier war das Thema Midi gerade so präsent, daher hier einmal eine allgemeine Thread/Async-Frage (mit Bezug auf Musik).

Wie könnte man so etwas (am besten) asynchron hinbekommen.
(Also ohne das Delay)

Code: Alles auswählen

;Einrücken: Strg + I
;Nur ein kleiner Testcode

EnableExplicit

CompilerIf #PB_Compiler_OS = #PB_OS_Windows
  
  Global.i hMidiOut
  
  Procedure MidiOutMessage(hMidi,iStatus,iChannel,iData1,iData2)
    Protected.i dwMessage
    dwMessage = iStatus | iChannel | (iData1 << 8 ) | (iData2 << 16)
    ProcedureReturn midiOutShortMsg_(hMidi, dwMessage)
  EndProcedure
  
  Procedure SetInstrumentPerChannel(channel, instrument)
    MidiOutMessage(hMidiOut, $C0,  channel, instrument, 0)
  EndProcedure
  
  Procedure StopNote(channel, note)
    MidiOutMessage(hMidiOut, $90, channel, Note, 0)
  EndProcedure
  
  Procedure PlayNote(channel, note, volume)
    MidiOutMessage(hMidiOut, $90, channel, note , volume)
  EndProcedure
  
  Define midi.MIDIOUTCAPS, devices, devnum, midiport
  devices = midiOutGetNumDevs_()
  
  For devnum = - 1 To devices - 1
    If midiOutGetDevCaps_(devnum,@midi,SizeOf(MIDIOUTCAPS))=0
      If midi\wVoices > 0
        midiport=devnum
      EndIf
    EndIf
  Next
  
  Define *hMidiOut
  If midiOutOpen_(@hMidiOut,midiport,0,0,0) <> #MMSYSERR_NOERROR
    MessageRequester("Fehler", "Keine Midi-Ausgabe möglich.", #PB_MessageRequester_Error)
    End
  EndIf
  
  Procedure Decode_MidiString(channel.i, MidiStr.s, bpm.i = 120, volume.i = 50) 
    Protected.i index = 1
    Protected.s nstr, ns, ds, ts
    Protected.i note, octave, dots, i
    Protected.f duration, bps, beat, mbeats
    
    If channel = 0
      ProcedureReturn -1
      Debug "Kanal muss größer 0 sein."
    EndIf
    
    bps.f = bpm / 60
    beat.f = (1 / bps) * 1000
    
    Repeat
      nstr = StringField(MidiStr, index, "/")
      
      If nstr <> #Null$
        ns = StringField(nstr, 1, ":")
        octave = Val(StringField(nstr, 2, ":"))
        ds = StringField(nstr, 3, ":")
        ts = Right(nstr, 1) ;Um den Takt zu ermitteln.
        
        Select UCase(ns)
          Case "C"
            note = 0
          Case "#C", "bD"
            note = 1
          Case "D"
            note = 2
          Case "#D", "bE"
            note = 3
          Case "E"
            note = 4
          Case "F"
            note = 5
          Case "#F", "bG"
            note = 6
          Case "G"
            note = 7
          Case "#G", "bA"
            note = 8
          Case "A"
            note = 9
          Case "#A", "bB", "bH"
            note = 10
          Case "B", "H"
            note = 11
          Case "R" ;Pause
            note = 255
          Default
            MessageRequester("Fehler", ~"Eine ungültige Note eingegeben.\nDie Eingabe: \""+ns+~"\" ist ungültig.", #PB_MessageRequester_Error)
            ProcedureReturn -1
        EndSelect
        
        note = (octave * 12) + note
        
        Select UCase(Left(ds, 1))
          Case "Q"
            duration = 1 ;Viertel-Note
          Case "H"
            duration = 2 ;Halbe-Note
          Case "W"
            duration = 4 ;Ganze-Note
          Case "E"
            duration = 0.5 ;Achtel-Note
          Case "S"
            duration = 0.25 ;Sechzehntel-Note
          Case "T"
            duration = 0.125 ;Zweiunddreißigstel-Note
          Case "F"
            duration = 0.0625 ;Vierundsechzigstel-Note
          Default
            MessageRequester("Fehler", ~"Eine ungültige Notenlänge angegeben.\nDie Eingabe: \""+ds+~"\" ist ungültig.", #PB_MessageRequester_Error)
            ProcedureReturn -1
        EndSelect
        
        dots = CountString(UCase(ds), "D")
        If duration > 0 And Len(ds) > 1 And dots > 0 And (dots = Len(ds)-1)
          For i=1 To dots
            duration * 1.5
          Next
        ElseIf duration > 0 And Len(ds) > 1 And (dots <> Len(ds)-1)
          MessageRequester("Fehler", ~"Eine ungültige Punktierung angegeben.\nDie Eingabe: \""+UCase(ds)+~"\" ist ungültig.", #PB_MessageRequester_Error)
          ProcedureReturn -1  
        EndIf
        
        mbeats = mbeats + duration
        
        If note < 255
          PlayNote(channel, note, volume)
          Delay(beat * duration)
          StopNote(channel, note)
        EndIf
        
        If ts = "|"
          Debug "Count: " + StrF(mbeats)
          mbeats = 0
        EndIf
      EndIf
      
      index + 1
      
    Until nstr = ""
    
  EndProcedure
  
  ;-GUI
  
  Global evt
  
  If OpenWindow(0, 0, 0, 100, 100, "Midi-Test", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
    
    StartDrawing(WindowOutput(0))
    DrawText(10, 10, "Bitte warten!")
    StopDrawing()
    
    ;...
    SetInstrumentPerChannel(1, 10)
    ;SetInstrumentPerChannel(2, 1)
    
    Decode_MidiString(1, "g:6:q/a:6:q/b:6:q/c:7:q/d:7:q/e:7:q/#f:7:q:|/g:7:q", 120, 100)
    
    ;...
    
    Repeat
      evt = WaitWindowEvent()
      ;....
    Until evt = #PB_Event_CloseWindow
  EndIf
  
  midiOutClose_(@hMidiOut)
  
CompilerElse
  MessageRequester("Fehler", ~"Dieser Code läuft nur unter Windows.\nDanke für Ihr Verständnis.", #PB_MessageRequester_Error)
CompilerEndIf

Re: Wie bekommt man das (am besten) asynchron hin?

Verfasst: 28.12.2020 23:12
von ccode_new
Mit einzelnen Threads geht das ja ganz gut, aber wie kann man das Ganze am besten mit mehrerer Threads (und "Taktgesteuert") machen?

Code: Alles auswählen

EnableExplicit

CompilerIf #PB_Compiler_OS = #PB_OS_Windows And #PB_Compiler_Thread = 1
  
  Global.i hMidiOut
  
  Global evt, MThread
  
  Procedure MidiOutMessage(hMidi, iStatus, iChannel, iData1, iData2)
    Protected.i dwMessage
    dwMessage = iStatus | iChannel | (iData1 << 8) | (iData2 << 16)
    ProcedureReturn midiOutShortMsg_(hMidi, dwMessage)
  EndProcedure
  
  Procedure SetInstrumentPerChannel(channel, instrument)
    MidiOutMessage(hMidiOut, $C0, channel, instrument, 0)
  EndProcedure
  
  Procedure StopNote(channel, note)
    MidiOutMessage(hMidiOut, $90, channel, Note, 0)
  EndProcedure
  
  Procedure PlayNote(channel, note, volume)
    MidiOutMessage(hMidiOut, $90, channel, note, volume)
  EndProcedure
  
  Define midi.MIDIOUTCAPS, devices, devnum, midiport
  devices = midiOutGetNumDevs_()
  
  For devnum = - 1 To devices - 1
    If midiOutGetDevCaps_(devnum, @midi, SizeOf(MIDIOUTCAPS)) = 0
      If midi\wVoices > 0
        midiport = devnum
      EndIf
    EndIf
  Next
  
  Define *hMidiOut
  If midiOutOpen_(@hMidiOut, midiport, 0, 0, 0) <> #MMSYSERR_NOERROR
    MessageRequester("Fehler", "Keine Midi-Ausgabe möglich.", #PB_MessageRequester_Error)
    End
  EndIf
  
  Structure TMidiInfo
    channel.i
    *mstr
    bpm.i
    volume.i
  EndStructure
  
  Global.TMidiInfo MidiInfo
  
  Procedure Decode_MidiString(channel.i, MidiStr.s, bpm.i = 120, volume.i = 50)
    Protected.i index = 1
    Protected.s nstr, ns, ds, ts
    Protected.i note, octave, dots, i
    Protected.f duration, bps, beat, mbeats
    
    If channel = 0
      ProcedureReturn -1
      Debug "Kanal muss größer 0 sein."
    EndIf
    
    bps.f = bpm / 60
    beat.f = (1 / bps) * 1000
    
    Repeat
      nstr = StringField(MidiStr, index, "/")
      
      If nstr <> #Null$
        ns = StringField(nstr, 1, ":")
        octave = Val(StringField(nstr, 2, ":"))
        ds = StringField(nstr, 3, ":")
        ts = Right(nstr, 1) ;Um den Takt zu ermitteln.
        
        Select UCase(ns)
          Case "C"
            note = 0
          Case "#C", "bD"
            note = 1
          Case "D"
            note = 2
          Case "#D", "bE"
            note = 3
          Case "E"
            note = 4
          Case "F"
            note = 5
          Case "#F", "bG"
            note = 6
          Case "G"
            note = 7
          Case "#G", "bA"
            note = 8
          Case "A"
            note = 9
          Case "#A", "bB", "bH"
            note = 10
          Case "B", "H"
            note = 11
          Case "R" ;Pause
            note = 255
          Default
            MessageRequester("Fehler", ~"Eine ungültige Note eingegeben.\nDie Eingabe: \"" + ns + ~"\" ist ungültig.", #PB_MessageRequester_Error)
            ProcedureReturn -1
        EndSelect
        
        note = (octave * 12) + note
        
        Select UCase(Left(ds, 1))
          Case "Q"
            duration = 1 ;Viertel-Note
          Case "H"
            duration = 2 ;Halbe-Note
          Case "W"
            duration = 4 ;Ganze-Note
          Case "E"
            duration = 0.5 ;Achtel-Note
          Case "S"
            duration = 0.25 ;Sechzehntel-Note
          Case "T"
            duration = 0.125 ;Zweiunddreißigstel-Note
          Case "F"
            duration = 0.0625 ;Vierundsechzigstel-Note
          Default
            MessageRequester("Fehler", ~"Eine ungültige Notenlänge angegeben.\nDie Eingabe: \"" + ds + ~"\" ist ungültig.", #PB_MessageRequester_Error)
            ProcedureReturn -1
        EndSelect
        
        dots = CountString(UCase(ds), "D")
        If duration > 0 And Len(ds) > 1 And dots > 0 And (dots = Len(ds)-1)
          For i = 1 To dots
            duration * 1.5
          Next
        ElseIf duration > 0 And Len(ds) > 1 And (dots <> Len(ds)-1)
          MessageRequester("Fehler", ~"Eine ungültige Punktierung angegeben.\nDie Eingabe: \"" + UCase(ds) + ~"\" ist ungültig.", #PB_MessageRequester_Error)
          ProcedureReturn -1
        EndIf
        
        mbeats = mbeats + duration
        
        If note < 255
          PlayNote(channel, note, volume)
          Delay(beat * duration)
          StopNote(channel, note)
        EndIf
        
        If ts = "|"
          Debug "Count: " + StrF(mbeats)
          mbeats = 0
        EndIf
      EndIf
      
      index + 1
      
    Until nstr = ""
    
  EndProcedure
  
  Procedure MidiThread(*minfo.TMidiInfo)
    Decode_MidiString(*minfo\channel, PeekS(*minfo\mstr), *minfo\bpm, *minfo\volume)
    Delay(0)
  EndProcedure
  
  ;-GUI
  
  If OpenWindow(0, 0, 0, 100, 100, "Midi-Test", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
    
    StartDrawing(WindowOutput(0))
    DrawText(10, 10, "Bitte warten!")
    StopDrawing()
    
    SetInstrumentPerChannel(1, 1)
    ;SetInstrumentPerChannel(2, 10)
    
    MidiInfo\channel = 1
    MidiInfo\mstr = ?song
    MidiInfo\bpm = 120
    MidiInfo\volume = 100
    
    MThread = CreateThread(@MidiThread(), @MidiInfo)
    
    Repeat
      evt = WaitWindowEvent()
      
      ;....
    Until evt = #PB_Event_CloseWindow
  EndIf
  
  midiOutClose_(@hMidiOut)
  
CompilerElse
  MessageRequester("Fehler", ~"Dieser Code läuft nur unter Windows und verwendet Threads.\nBitte den entsprechenden Compiler-Schalter aktivieren.\nDanke für Ihr Verständnis.", #PB_MessageRequester_Error)
CompilerEndIf

DataSection
  song:
  Data.s "e:6:q/e:6:q/f:6:q/g:6:q:|/g:6:q/f:6:q/e:6:q/d:6:q:|/c:6:q/c:6:q/d:6:q/e:6:q:|/e:6:qd/d:6:e/d:6:h:|/e:6:q/e:6:q/f:6:q/g:6:q:|/g:6:q/f:6:q/e:6:q/d:6:q:|/c:6:q/c:6:q/d:6:q/e:6:q:|/d:6:qd/c:6:e/c:6:h:|/d:6:q/d:6:q/e:6:q/c:6:q:|/d:6:q/e:6:e/f:6:e/e:6:q/c:6:q:|/d:6:q/e:6:e/f:6:e/e:6:q/d:6:q:|/c:6:q/d:6:q/r:6:q/e:6:q:|/e:6:q/e:6:q/f:6:q/g:6:q:|/g:6:q/f:6:q/e:6:q/d:6:q:|/c:6:q/c:6:q/d:6:q/e:6:q:|/d:6:qd/c:6:e/c:6:h:|"
EndDataSection

Re: Wie bekommt man das (am besten) asynchron hin?

Verfasst: 29.12.2020 20:11
von Mijikai
Würde mich auch interessieren.

Evtl. könnte midiOutLongMsg_() helfen??
Sieht so aus als ob man damit einen Buffer abspielen könnte.

Noch einen Link den ich gefunden habe - Playing MIDI Files in Windows:
https://blog.fourthwoods.com/2011/12/31 ... ws-part-4/
Alle Zeiten sind UTC+02:00
Seite 1 von 1

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de