Musik Erzeuger / MFSK Modulator

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Syr2
Beiträge: 26
Registriert: 11.03.2020 13:39

Musik Erzeuger / MFSK Modulator

Beitrag von Syr2 »

Für alle die mit Beep_() nicht so richtig glücklich sind, aber auch nicht auf FXMod oder so zurückgreifen wollen:

Entwicklung basierd auf:
http://www.purebasic.fr/english/viewtopic.php?t=7431 von Froggerprogger und blbltheworm
Beschreibung:
Der Code hier kann anhand einer Liste mit Tonhöhe (Frequenz) und Tondauer einen Sound im WAV-Format im Speicher zusammenbauen.
1. Besonderheit: Entgegen einem einfachen Beep_() können mehrere Töne simultan erzeugt werden.
2. Besonderheit: Abgesehen davon dass man damit Musik machen kann, kann man auch ein (M)FSK-Signal erzeugen. Das Signal muss nur noch auf die entsprechende Hochfrequenz moduliert werden und kann dann abgestrahlt werden.
3. Besonderheit: Das erzeugte Signal kann über Catchsound() direkt geladen werden oder durch wegspeichern als .wav auch exportiert werden. Macht die Sache handlicher. Bin mir aber nicht sicher ob es durchoptimiert ist.

Viel Spaaaß,


Code: Alles auswählen

InitSound()

Structure WAVEHeader
  MagicBytes.l
  Filesize.l
  Text.q
  ChuckSize.l
  Compression.w
  Channels.w
  samplerate.l
  avBytesPerSecons.l
  BlockAlign.w
  bitPerSample.w
  dataText.l
  avBytesTotal.l
EndStructure

Structure Note
  StartMs.i
  DurationMs.i
  Frequency.i
EndStructure

Procedure CreateMusic(List Note.Note(),channels=1,bitrate=16,samplerate=44100)
  
  ;{ #Pb_Any Catching
  If channels = #PB_Any : channels = 1: EndIf
  If bitrate = #PB_Any : bitrate = 16: EndIf
  ;}
  
  ;{ Missing input Catching
  If ListSize(Note()) <= 0 : MessageRequester("Error","no notes given") : EndIf
  ;}
  
  ;{ Calculate Duration
  TotalDuration = 0
  ForEach Note()
    current = Note()\StartMs + Note()\DurationMs
    If TotalDuration < current
      TotalDuration = current
    EndIf
  Next
  SecUpRounded = Round(TotalDuration/1000,#PB_Round_Up)
  ;}
  
  ;{ Create a WAVE Header
  avBytesPerSec.l = channels * bitrate / 8 * samplerate  ; calculate the average bytes per second  
  
  Waveheader.Waveheader
  Waveheader\MagicBytes = $46464952 ;Backwards, LittleEndian
  Waveheader\Filesize = 36 + avBytesPerSec * SecUpRounded
  Waveheader\Text = $20746d6645564157
  Waveheader\ChuckSize = 16
  Waveheader\Compression = 1
  Waveheader\Channels = channels
  Waveheader\samplerate = samplerate
  Waveheader\avBytesPerSecons = avBytesPerSec
  Waveheader\BlockAlign = bitrate / 8 * channels
  Waveheader\bitPerSample = bitrate
  Waveheader\dataText = $61746164 ;Backwards, LittleEndian
  Waveheader\avBytesTotal = avBytesPerSec*SecUpRounded
  
  WaveHeaderSize = SizeOf(Waveheader)
  ;}
  
  ;{ Allocate Memory for the whole song
  Memory = AllocateMemory(WaveHeaderSize + SecUpRounded * samplerate * (bitrate / 8))
  ; Copy the Wave-Header to the first 44 Bytes
  CopyMemory(Waveheader,Memory,WaveHeaderSize)
  ;}
  
  ;{ Start calculating the samples
 
  Protected sample.w  ;(signed RAW data)
   
  For acttime = 1 To samplerate * SecUpRounded
    ProgressMs.f = acttime / samplerate * 1000
    For actchannel = 1 To channels  
      Sum = 0 : TempSample.f = 0
      ForEach Note()
        If ProgressMs >= Note()\StartMs And ProgressMs <= Note()\StartMs + Note()\DurationMs
          Sum +1 ; Sum of Tones for later division (normalisation)
          TempSample + Sin(2 * #PI * Note()\Frequency * acttime / samplerate)
        EndIf
      Next
      If Not sum
        Continue
      EndIf
      Sample = 32767 * (TempSample / Sum)
      PokeW(Memory + WaveHeaderSize + acttime*2 ,sample)
    Next  
  Next  
  ;}
  
  ProcedureReturn Memory
EndProcedure



CompilerIf Not #PB_Compiler_IsIncludeFile
  
Macro AddTone(Time,Dur,Frq)
  AddElement(Notes()) : Notes()\StartMs =   Time : Notes()\Frequency = Frq : Notes()\DurationMs = Dur
EndMacro
NewList Notes.Note()
 
AddTone(0,500,240)
AddTone(500,500,440)
AddTone(500,1000,240)
AddTone(0,50,240)
AddTone(1500,1500,440)

 Mem = CreateMusic(Notes())
 
  Sound = CatchSound(#PB_Any,Mem)
  PlaySound(sound)
  Delay(3000)
 
  f = CreateFile(#PB_Any,"test.wav")
  If f
   WriteData(f,Mem,MemorySize(Mem))
   CloseFile(f)
   RunProgram("test.wav")
 EndIf
 
 FreeMemory(mem)
CompilerEndIf
Syr2
Beiträge: 26
Registriert: 11.03.2020 13:39

Re: Musik Erzeuger / MFSK Modulator

Beitrag von Syr2 »

Und für alle die Bock auf richtig coole Lieder haben, hier noch sieben Modi zum spielen.

Dieser Code erzeugt zwar nur Tonleitern, kann aber sehr gut als Grundlage genutzt werden um Modi-unabhängig Lieder zu schreiben.

Code: Alles auswählen

IncludeFile "MyWaveLib.pb"

Structure Ton
  Ton.s
  ms.f
EndStructure

Macro AddTone(Time,Dur,Frq)
  AddElement(Notes()) : Notes()\StartMs =   Time : Notes()\Frequency = Frq : Notes()\DurationMs = Dur
EndMacro

Global NewMap Hz.l() ;{
Hz("c5")=4186.01
Hz("h4")=3951.07
Hz("ais4")=3729.31
Hz("b4")=3729.31
Hz("a4")=3520
Hz("gis4")=3322.44
Hz("as4")=3322.44
Hz("g4")=3135.96
Hz("fis4")=2959.96
Hz("ges4")=2959.96
Hz("f4")=2793.83
Hz("e4")=2637.02
Hz("dis4")=2489.02
Hz("es4")=2489.02
Hz("d4")=2349.32
Hz("cis4")=2217.46
Hz("des4")=2217.46
Hz("c4")=2093
Hz("h3")=1975.53
Hz("ais3")=1864.66
Hz("b3")=1864.66
Hz("a3")=1760
Hz("gis3")=1661.22
Hz("as3")=1661.22
Hz("g3")=1567.98
Hz("fis3")=1479.98
Hz("ges3")=1479.98
Hz("f3")=1396.91
Hz("e3")=1318.51
Hz("dis3")=1244.51
Hz("es3")=1244.51
Hz("d3")=1174.66
Hz("cis3")=1108.73
Hz("des3")=1108.73
Hz("c3")=1046.5
Hz("h2")=987.767
Hz("ais2")=932.328
Hz("b2")=932.328
Hz("a2")=880
Hz("gis2")=830.609
Hz("as2")=830.609
Hz("g2")=783.991
Hz("fis2")=739.989
Hz("ges2")=739.989
Hz("f2")=698.456
Hz("e2")=659.255
Hz("dis2")=622.254
Hz("es2")=622.254
Hz("d2")=587.33
Hz("cis2")=554.365
Hz("des2")=554.365
Hz("c2")=523.251
Hz("h1")=493.883
Hz("ais1")=466.164
Hz("b1")=466.164
Hz("a1")=440
Hz("gis1")=415.305
Hz("as1")=415.305
Hz("g1")=391.995
Hz("fis1")=369.994
Hz("ges1")=369.994
Hz("f1")=349.228
Hz("e1")=329.628
Hz("dis1")=311.127
Hz("es1")=311.127
Hz("d1")=293.665
Hz("cis1")=277.183
Hz("des1")=277.183
Hz("c1")=261.626
Hz("h")=246.942
Hz("ais")=233.082
Hz("b")=233.082
Hz("a")=220
Hz("gis")=207.652
Hz("as")=207.652
Hz("g")=195.998
Hz("fis")=184.997
Hz("ges")=184.997
Hz("f")=174.614
Hz("e")=164.814
Hz("dis")=155.563
Hz("es")=155.563
Hz("d")=146.832
Hz("cis")=138.591
Hz("des")=138.591
Hz("c")=130.813
Hz("H")=123.471
Hz("Ais")=116.541
Hz("B")=116.541
Hz("A")=110
Hz("Gis")=103.826
Hz("As")=103.826
Hz("G")=97.9989
Hz("Fis")=92.4986
Hz("Ges")=92.4986
Hz("F")=87.3071
Hz("E")=82.4069
Hz("Dis")=77.7817
Hz("Es")=77.7817
Hz("D")=73.4162
Hz("Cis")=69.2957
Hz("Des")=69.2957
Hz("C")=65.4064
Hz("H1")=61.7354
Hz("Ais1")=58.2705
Hz("B1")=58.2705
Hz("A1")=55
Hz("Gis1")=51.9131
Hz("As1")=51.9131
Hz("G1")=48.9994
Hz("Fis1")=46.2493
Hz("Ges1")=46.2493
Hz("F1")=43.6535
Hz("E1")=41.2034
Hz("Dis1")=38.8909
Hz("Es1")=38.8909
Hz("D1")=36.7081
Hz("Cis1")=34.6478
Hz("Des1")=34.6478
Hz("C1")=32.7032
Hz("H2")=30.8677
Hz("Ais2")=29.1352
Hz("B2")=29.1352
Hz("A2")=27.5
;}
Global NewList Tones.l() ;{
ForEach Hz()
  AddElement(Tones())
  Tones() = Hz()
Next
SortList(Tones(),#PB_Sort_Ascending)
ForEach Tones()
  If Tones() = last
    DeleteElement(Tones())
  Else
    last = Tones()
  EndIf
Next

;}
Global NewMap Hz_reverse.s() ;{
ForEach Hz()
  If last = Hz()
    Continue
  EndIf
  Hz_reverse(StrF(Hz())) = MapKey(Hz())
  last = Hz()
Next

;}
Global NewMap Modus.s() ;{
Modus("Dorisch") = "2 1 2 2 2 1 2"
; Modus("Hypodorisch")
Modus("Phrygisch") = "1 2 2 2 1 2 2"
; Modus("Hypophrygisch")
Modus("Lydisch") = "2 2 2 1 2 2 1"
; Modus("Hypolydisch")
Modus("Mixolydisch") = "2 2 1 2 2 1 2"
; Modus("Hypomixolydisch")
Modus("Äolisch") = "2 1 2 2 1 2 2"
; Modus("Hypoäolisch")
Modus("Ionisch") = "2 2 1 2 2 2 1"
; Modus("Hypoionisch")
Modus("Lokrisch") = "1 2 2 1 2 2 2"
; Modus("Hypolokrisch")
;}

Procedure Spiele(List Song.Ton())
  NewList Notes.Note()
  Delay = 0
  
  ForEach Song()
    AddTone(Delay,Song()\ms,hz(Song()\Ton))
    delay + Song()\ms
  Next
  
  Mem = CreateMusic(Notes())
 
  Sound = CatchSound(#PB_Any,Mem)
  PlaySound(sound)
  Delay(Delay)
  
  FreeList(Song())
  FreeSound(sound)
  FreeMemory(Mem)
EndProcedure

Procedure Akkord(Grundton.f,Modus,Umstellung.a=0)
EndProcedure

Procedure Tonleiter(Start.s,Anzahl,Modus.s,List Lied.Ton(),TonDauer=100)
  f.l = Hz(Start)
  If f <= 0
    Debug "Tonleiter-Start-Ton "+Start+" nicht gefunden."
    ProcedureReturn 0
  EndIf
  
  Mode$ = Modus(Modus)
  If Len(Mode$) <= 0
    Debug "Modus "+Modus+" nicht gefunden."
    ProcedureReturn 0
  EndIf
  
  ;find start on tonelist
  ForEach Tones()
    If Tones() = f
      Break
    EndIf
  Next
  
  ;Add first tone
  AddElement(Lied())
  Lied()\Ton = Start
  Lied()\ms = TonDauer
  
  For x = 1 To 7
    halftonejump = Val(StringField(Mode$,x," "))
    For y = 1 To halftonejump
      NextElement(Tones())
    Next
    AddElement(Lied())
    Lied()\Ton = Hz_reverse(StrF(Tones()))
    Lied()\ms = TonDauer
  Next
  
EndProcedure

  NewList Lied.Ton()
ForEach Modus()
  Tonleiter("c1",8,MapKey(Modus()),Lied())
Next
Spiele(Lied())
  FreeList(Lied())
  Delay(500)
Benutzeravatar
Mijikai
Beiträge: 735
Registriert: 25.09.2016 01:42

Re: Musik Erzeuger / MFSK Modulator

Beitrag von Mijikai »

Interessant, gibt es Pläne für einen Ringspeicher um die Samples ohne CatchSound abzuspielen?
Syr2
Beiträge: 26
Registriert: 11.03.2020 13:39

Re: Musik Erzeuger / MFSK Modulator

Beitrag von Syr2 »

Nö, aber wenn du mir sagst wie du's willst dann tipp ich's runter. Bin grade eher an der "Lautstärke" dran, ist gar nicht soo easy
Antworten