Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/
Code: Alles auswählen
;PlayMusik(ZufallsMusik(7,2,8))
PlayMusik("l8") ; TempieEinstellung l4 entspannung, l8 genmaeszigt, l16 flott
;ZufallsMusik(7,3,7)
ZufallsMusik(10,4,20)
Keine Sorge, für alle die dachten: 
???Code: Alles auswählen
Procedure ZufallsMusik(Pat.l,vari.l,not.l)
Zufall.s
Dim Musik.l(Pat)
Dim Melo.s(vari)
For i=0 To Pat
Musik(i)=Random(Random(vari))
Next
For u=0 To vari
k=0
c=Random(not)
Melo(u)="o"+Chr(49+Random(6)); Chr(48+Random(8))
Repeat
Melo(u)=Melo(u)+Chr(Random(8)+65); TonLaenge wird noch nicht variiert
k+1
Until k>c
Next
For i=0 To Pat
PlayMusik(Melo(Musik(i)))
Next
ProcedureReturn Zufall
EndProcedureCode: Alles auswählen
;{- Information
;Autor : Folker Linstedt / FL-Studios
;Code : FLSMUSIC.INC ... Unit / Klasse / Include fuer Musik in Form von Noten ... >> Ausbaufaehig <<
;Anfang: 30.04.2006
;Stand : 30.04.2006
;/}
;{- GLOBAL ... muss irgendwie noch anders geregelt werden
Global Oktave.l
Global TonLaenge.l
Global MusikRealTonLaenge.l
Global MGesamtTempo.l
Global MusikPausenZaehler.l
Global PlayVolume.l
Global MPEffekt.l; { Pause zwischen den Toenen }
Global PlayWithMPeffektPause.b
Global InstrumentNr.l; Ist fuer die MIDI-Unterstuetzung, kann zwischen den 128 Standard-Instrumenten
;umgeschaltet werden, oder eigene durch spezielle Verzerunngen
TonLaenge =4
Oktave = 3
MusikRealTonLaenge.l=30000; 30000 ist wohl in Ordnung
MGesamtTempo.l=1600
PlayWithMPeffektPause=0
MPEffekt=10
;}/
Procedure NotenPause(p.l)
Delay(p); Hier muss eine andere Pause integriert werden
EndProcedure
Procedure PLAYNOTE(N.s,Oktav.b,TonLaeng.l); Note
f.f;
x.f;
; Debug TonLaeng
If (N="N")
NotenPause(TonLaeng)
Else ; Endif ganz unten
; { Frequenz der einzelnen Toene ... mal Oktave ... }
Select N
Case "C" : f = 261.63
Case "#C" : f = 277.65
Case "C+" : f = 277.65
Case "D-" : f = 277.65
Case "D" : f = 293.67
Case "#D" : f = 311.65
Case "D+" : f = 311.65
Case "E-" : f = 311.65
Case "E" : f = 329.63
Case "F" : f = 349.23
Case "#F" : f = 370.615
Case "F+" : f = 370.615
Case "G-" : f = 370.615
Case "G" : f = 392.00
Case "#G" : f = 416.00
Case "G+" : f = 416.00
Case "A-" : f = 416.00
Case "A" : f = 440.00
Case "#A" : f = 466.94
Case "A+" : f = 466.94
Case "B-" : f = 466.94
Case "H-" : f = 466.94
Case "B" : f = 493.88
Case "H" : f = 493.88
EndSelect
; { (2^Oktave) 2 hoch Oktave }
x=Pow(2,Oktav-3)
GanzZahl.l=Round(f*x,0); Beep_() ist sehr empfindlich gegenueber Float, und Round liefert float
; Debug f
Beep_(GanzZahl,TonLaeng); Wenn SoundAusgabe und TonLaenge von einander unabhaengig sind ...
;If PlayWithMPeffektPause : NotenPause(p) : Else : NotenPause(TonLaeng-MPEffekt) : EndIf
If MPEffekt>0 ; Ergibt nur Sinn, wenn
; NoSound
NotenPause(MPEffekt)
EndIf
; TastenAbbruch-Funktion fehlt
; Hier koennten andere Musik-OutPuts eingebunden werden
; z.B.: CreateSound() ... WriteToDisk() ... PlayMidi() ...
;Denkbar waere auch eine Visualisierung in Form von NOTEN auf einem NotenBlatt dargestellt
EndIf ; gehoert zu IF N="N"
EndProcedure
Dim Lis.s(3)
Procedure ZahlStellen(ss.s,pos.l)
Anz=0
s.s
s=Mid(ss,pos+1,Len(ss)-pos)
l=Len(s)
For i=1 To l
If Asc(Mid(s,i,1))>=48 And Asc(Mid(s,i,1))<=57
Anz+1
Else
Break
EndIf
Next
ProcedureReturn Anz
EndProcedure
Procedure Liz(s.s,pos.l)
zahl.l
hs.s
hs=Mid(s,pos+1,4)
hs=Mid(s,pos+1,ZahlStellen(s,pos)+1)
zahl=Val(hs)
ProcedureReturn zahl
EndProcedure
Procedure PlayMusik(Li.s)
x.b; Zaehlervariable
Li=UCase(Li)
Li=Li+Chr(255)
m=Len(Li)
p=1 ; Position
richtigeTonLaenge.l
Repeat
Lis(0)=Mid(Li,p+0,1): Lis(1)=Mid(Li,p+1,1): Lis(2)=Mid(Li,p+2,1): Lis(3)=Mid(Li,p+3,1)
If Lis(0)="W" : PlayMusik("z0m5l4o3t1600") : EndIf ; Standard Wiederherstellen
richtigeTonLaenge=( MGesamtTempo * 10000 ) / MusikRealTonLaenge
For x=0 To 7
If Lis(0)=Chr(65+x)
If (Lis(1)="-") Or (Lis(1)="+")
PLAYNOTE(Lis(0)+Lis(1),Oktave,richtigeTonLaenge);
p+1; Halbtonschritt hoehere Toene
Else
PLAYNOTE(Lis(0),Oktave,richtigeTonLaenge);
Break;
EndIf;
EndIf
Next
If (Lis(0)="P") Or (Lis(0)="N") : PLAYNOTE("N",Oktave,richtigeTonLaenge) : EndIf
If Lis(0)=">"
Oktave+1
If Oktave>8 : Oktave=0 : EndIf
EndIf;
If Lis(0)="<"
Oktave-1
If Oktave<0 : Oktave=8 : EndIf
EndIf;
If (Lis(0)="#") And (Lis(1)<>Chr(255))
PLAYNOTE("#"+Lis(1),Oktave,richtigeTonLaenge);
p+1
EndIf;
If Lis(0)="O"
Oktave=Val(Lis(1));
p+1;
EndIf;
;{- { Berechnung der Notenlaenge, mormal und punktiert }
If Lis(0)="L"
If Liz(Li,p)<>0
If MusikPausenZaehler = 0
TonLaenge=Liz(Li,p);
MusikRealTonLaenge=TonLaenge * 10000;
If ZahlStellen(Li,p)<>0
If Mid(Li,p+ZahlStellen(Li,p)+1,1)= "."
MusikRealTonLaenge= TonLaenge * 2 * 10000 / 3;
p+1
EndIf;
EndIf
Else
TonLaenge=Liz(Li,p);
MusikRealTonLaenge= MusikPausenZaehler * 10000 / TonLaenge;
If ZahlStellen(Li,p)<>0
If Mid(Li,p+ZahlStellen(Li,p)+1,1)= "."
MusikRealTonLaenge=MusikPausenZaehler * 2 * 10000 / (TonLaenge * 3);
p+1
EndIf;
EndIf
EndIf;
EndIf;
EndIf;
;}/
;{- Zusaetze
If Lis(0)="T" ; Gesamt-Tempo-Aenderung.
If Liz(Li,p)<>0
MGesamtTempo = Liz(Li,p);
EndIf;
EndIf
If Lis(0)="Z" ; Zaehler / Nenner-Tausch und Bestimmung ... beeinflusst die Berechnung der Tonlaenge
MusikPausenZaehler = Liz(Li,p)
EndIf
If Lis(0)="I" ; Waehlt ein Instrument aus
InstrumentNr=Liz(Li,p);
EndIf;
If Lis(0)="M" ; Fuer den Abstand zwischen den Pausen
MPEffekt = Liz(Li,p);
EndIf;
If Lis(0)="V" ; Für die Volumenaenderung
PlayVolume= Liz(Li,p);
EndIf;
If Lis(0)="R" ; Tauscht zwischen kleiner Pause zwischen Noten JA/NEIN
If PlayWithMPeffektPause=0
PlayWithMPeffektPause=1
Else
PlayWithMPeffektPause=0
EndIf
EndIf
;}/
p+1
Until p>=m
EndProcedure
Debug "Das Boot"
;PlayMusik("t2000o3l4.fl8edefal4.>cl8<bab>c<el1g")
Debug "Axel Foley"
;PlayMusik ("l4#fl8.al8#fl16#fl8b#fel4#fl8.>#cl8<#fl16#fl8>d#c<a#f>#c#fl16<#fl8el16el8#c#gl3#fl4p>#fl8.al8#fl16#fl8b#fel4#fl8.>#cl8<#fl16#fl8>d#c<a#f>#c#fl16<#fl8el16el8#c#gl3#f")
;/ Moegliches DateiFormat
;FFTL0000 erstellt am 25.05.2001 von Folker Linstedt
;Die Ernte oder auch Popcorn
;011231124
;o4t1600
;l8dcd<al16fl8az16l5dz0>
;l8defl16el8ffl16dl8el16dl8eel16cl8dl16cl8dd
;l16<#al4>d
;l16el4f
;/
Dim Patern.b(8)
Patern(0)=0:Patern(1)=1:Patern(2)=1:Patern(3)=2:Patern(4)=3
Patern(5)=1:Patern(6)=1:Patern(7)=2:Patern(8)=4
Dim Lied.s(4)
Lied(0)="o4t1600"; TonHoehe aendern ... statt o4 = o2 z.B.
Lied(1)="l8dcd<al16fl8az16l5dz0>"
Lied(2)="l8defl16el8ffl16dl8el16dl8eel16cl8dl16cl8dd"
Lied(3)="l16<#al4>d"
Lied(4)="l16el4f"
;/ Abspielen ... ACHTUNG angenehme AbbruchsFunktion fehlt ! ! ! Lied spielt ca. 14 Sekunden
For i=0 To 8
PlayMusik(Lied(Patern(i)))
Next