|
![]() |
|
Registriert seit: 29. Mär 2008 Ort: D-49626 381 Beiträge Delphi 11 Alexandria |
#1
![]() Ja, ich weiss dass BASS das kann - u.v.m. Hatte die Funktion nur noch nicht in meinem TA implementiert. Jetzt aber. Mit Warnhinweis, wenn nur "Stille" läuft. Manchmal kommt man ja auf die einfachsten Dinge nicht, weil vermeintlich zu einfach .... |
![]() |
Registriert seit: 29. Mär 2008 Ort: D-49626 381 Beiträge Delphi 11 Alexandria |
#2
Nun bin ich ein paar Schritte weiter - eigentlich (fast) fertig.
Es gab noch ein paar Kleinigkeiten zu bereinigen, die da wären: - Ein definierter Ausgangpegel mit Werten zwischen -32767/32768 (ein SmallInt), damit die Hardware nicht übersteuert und - Azsgangspegel regelbar, Ersteres gestattet sich ein wenig schwierig, weil m.M.n. die Ableitung von Maximalwerten aus dem Random-Wert nicht so ganz einfach ist. Ich habe das mittels sukzessiver Approximation folgendermaßen gelöst: Randnom bekommt zunächst einen Wert zugewiesen, mit dem "pur"-Werte bis ca. 55.000 erreicht werden. Diese Werte werden dann normalisiert, so dass man im Ergebnis maximal-Werte von +-27.500 erhält. Bei jedem Werte-Abruf wird das Min,-/Max.-Limit geprüft und Random erhöht, bis irgendwann eine Überschreitung stattfindet. Das äußert sich akustisch in schäbigen Kratzgeräuschen. Das Erhöhen wird dann agbeschalltet und Random um ca. 100 reduziert. Gefühlsmäßpg ... Theoretisch und praktisch wäre damit der passende Wert eingestellt. Wer allerdings den Generator eine Weile lang mal mit 100% laufen lässt, wird gelegentlich noch mal ein (sehr) kurzes Kratzen hören können - das resultiert daraus, das Random in den seltensten Fällen den Maximalwert ausgibt. Aber auch das registriert die o.g. Prüfroutine und reduiert Random um weitere 100. Würde man den Generator "kalt" starten, kann man hören (oder auch sehen) wie der Pegel langsam steigt. Eben das Ergebnis v. g. Annäherung. Damit alle Zufallszahlen und Pegel korrekt initialisiert werden, mache ich wie bei den guten alten Röhrenkisten ein kleines "WarmUp" in der initialisierung: Ich lasse einfach mal 1.000.000 Werte blind generieren. Das entspricht bei 44100 Samplerate etwa 23 Sekunden tatsächlicher Laufzeit. Das geht so schnell (auf meinem Rechner jedenfalls), dass man keine Verzögerung bemerkt. Wie benutzt man die Klasse nun ? Ich erzeuge zunächst 2 Instanzen PN_L und PN_R für den linken und rechten Kanal - damit beide unterschiedlich zufällig und nicht gleich sind. Global, damit die Callback-Routine darauf Zugriff hat. Aporspos Links und rechts / Stereo-Rauschen: BASS erwartet im Buffer zuerst ein SmallInt für den linken und dann ein SmallInt für den rechten Kanal usw. Die Buffer-Länge wird in BYTES angegeben. 2x SmallInt sind 4 Bytes ! Also in diesem Fall die Länge der Zählschleife = Buffer-Länge div 4. Bei Mono dann entsprechend div 2 und nur einen Wert Schreiben. Bei Multikanal-Signalen dann entsprechend der Kanalzahl anpassen. Siehe auch BASS-Hilfe betreff CallBack-Routine. Übergeben werden: Anzahl der Reihen, woraus das Rauschen berechnet wird (so ca. 8 bis 24 (max 30) sind funktionelle Werte). Was das auf sich hat, wieso und warum, dazu bitte hier nachlesen: ![]() Zum Einstellen des "Ausgangspegel" werden Werten von 0 bis 100 erwartet. Mit der procedure SetPinkNoiseLevel kann man das zur Laufzeit ändern. Die procedure GetPinkNoiseStat ist eigentlich nur eine Hilfsfunktion, die nicht benötigt wird. Mir hat sie beim "basteln" gute Dienste geleistet, in dem man selbst einige zigtausend Aufrufe tätigt und dann mittels Abruf schaut, wo die jeweilegen Werte (Bereiche) liegen. Ach ja: Gemacht ist das ganze mit Delphi 7 und läuft hier unter XP. Hier noch mal die aktualisierte Klasse:
Code:
Das kleine Progrämmchen dazu hat eigentlich nur einen Button zum Starten/Stoppen und eine TrackBar für die Lautstärke (beide Kanäle). Hier nur die Unit:
{
Generation of pink noise For basic knwoledge and derivation take a look at: http://www.firstpr.com.au/dsp/pink-noise/ by Phil Burk, http://www.softsynth.com Copyleft 1999 Phil Burk - No rights reserved. File/s: Original: http://www.firstpr.com.au/dsp/pink-noise/phil_burk_19990905_patest_pink.c ... else: patest_pink.c (https://www.assembla.com/code/portaudio/subversion/nodes/1368/portaudio/branches/v19-devel/test/patest_pink.c) Extended to use with BASS.DLL >= 2.4.10 by TERWI V 1.0 - 2014-05-16 } unit pink2; interface uses SysUtils, Types; const PINK_MAX_RANDOM_ROWS = 30; PINK_RANDOM_BITS = 24; PINK_RANDOM_SHIFT = 8; // ((sizeof(long)*8)-PINK_RANDOM_BITS) PINK_OUTVALMAX = 32767; PINK_OUTVALMIN = -32767; type TPinkNoiseStat = record Rows : array[0..PINK_MAX_RANDOM_ROWS - 1] of longword; RunningSum : longint; // Used to optimize summing of generators Index : integer; // Incremented each sample IndexMask : integer; // Index wrapped by ANDing with this mask rndMax : DWORD; // max. value for Random IncVal : boolean; // switch to align the master value to max Min : longint; // min val dependend on rand-generation Max : longint; // max val dependend on rand-generation Avg : longint; // calc average val SumMin : longint; // min val output integer (before level) SumMax : longint; // max val output integer (before level) Level : integer; // 0 to 100 (%) Default: 70 end; type TPinkNoise2 = Class private PNS : TPinkNoiseStat; function GenerateRandomNumber : longint; public Constructor Create(numRows : integer; level : integer); function GetPinkNoiseVal : longint; procedure SetPinkNoiseLevel(level : integer); procedure GetPinkNoiseStat(var _PNS : TPinkNoiseStat); end; implementation // ----------------------------------------------------------------------------- // Setup PinkNoise structure for N rows of generators. // Level is between 0 and 100 constructor TPinkNoise2.Create(numRows : integer; level : integer); var i : integer; begin // Initialize var's // Define parameter: for i := 0 to numRows - 1 do PNS.Rows[i] := 0; // filled by procedure PNS.RunningSum := 0; // Used to optimize summing of generators PNS.Index := 0; // Incremented each sample PNS.IndexMask := 0; // Index wrapped by ANDing with this mask PNS.rndMax := 65536 * 16; // max. value for Random (default) PNS.IncVal := true; // enable auto-increasing out-val (by WarmUp) PNS.Min := 2147483647; // min val dependend on rand-generation PNS.Max := -2147483647; // max val dependend on rand-generation PNS.Avg := -1; // substract for average zero PNS.SumMin := PNS.Min; // min val output integer (before level) PNS.SumMax := PNS.Max; // max val output integer (before level) // Initialize: if (numrows > PINK_MAX_RANDOM_ROWS) then numrows := PINK_MAX_RANDOM_ROWS; // for safety PNS.Index := 0; PNS.IndexMask := (1 shl numRows) - 1; // Initialize rows. for i := 0 to numRows - 1 do PNS.Rows[i] := 0; PNS.RunningSum := 0; // initialize Random Randomize; // "WarmUp" to align level: call 1 million values // (takes less than a blink of an eye...) for i := 1 to 1000000 do GetPinkNoiseVal; // Set Outputlevel (either int or float) SetPinkNoiseLevel(level); end; // ----------------------------------------------------------------------------- // Calculate pseudo-random 32 bit number based on linear congruential method. function TPinkNoise2.GenerateRandomNumber : longint; begin result := Random(PNS.rndMax); // randomMax can change during runtime end; // ----------------------------------------------------------------------------- // Generate Pink noise values between -1.0 and +1.0 function TPinkNoise2.GetPinkNoiseVal : longint; var newRandom : longint; sum : longint; OutFloat : extended; OutInt : longint; n, numZeros : integer; begin // Increment and mask index. PNS.Index := (PNS.Index + 1) and PNS.IndexMask; // If index is zero, don't update any random values. if (PNS.Index <> 0) then begin // Determine how many trailing zeros in PinkIndex. // This algorithm will hang if n==0 so test first. numZeros := 0; n := PNS.Index; while ((n and 1) = 0) do begin n := n shr 1; inc(numZeros); end; // Replace the indexed ROWS random value. // Subtract and add back to RunningSum instead of adding all the random // values together. Only one changes each time. PNS.RunningSum := PNS.RunningSum - PNS.Rows[numZeros]; newRandom := GenerateRandomNumber shr PINK_RANDOM_SHIFT; PNS.RunningSum := PNS.RunningSum + newRandom; PNS.Rows[numZeros] := newRandom; end; // Add extra white noise value. newRandom := GenerateRandomNumber shr PINK_RANDOM_SHIFT; sum := PNS.RunningSum + newRandom; // Normalize the signal (by TERWI) if (sum < PNS.Min) then PNS.Min := sum; if (sum > PNS.Max) then PNS.Max := sum; PNS.Avg := (PNS.Max - PNS.Min) div 2; sum := (sum - PNS.Min) - PNS.Avg; // Check maximum Generator-value for 0dB-output and to provide overload if (sum < PNS.SumMin) then begin PNS.SumMin := sum; if PNS.SumMin < PINK_OUTVALMIN then // Overload negativ ? begin // YES ! Sum := PINK_OUTVALMIN; // Limit value now dec(PNS.rndMax, 300); // reduce max. value at generation PNS.IncVal := false; // stop increasing val to max end; end; if (sum > PNS.SumMax) then begin PNS.SumMax := sum; if PNS.SumMax > PINK_OUTVALMAX then // Overload positiv ? begin // YES ! Sum := PINK_OUTVALMAX; // Limit value now dec(PNS.rndMax, 300); // reduce max. value at generation PNS.IncVal := false; // stop increasing val to max end; end; if PNS.IncVal then inc(PNS.rndMax, 10); // stepwise increasing max. value by generation // Set level after normalization OutInt := sum * PNS.Level div 100; // Scale to range of -1.0 to 1. OutFloat := 1 / OutInt; // not in use yet result := OutInt; end; // ----------------------------------------------------------------------------- // Set PinkNoise level: 0 - 100 % procedure TPinkNoise2.SetPinkNoiseLevel(level : integer); begin if (level > 100) then level := 100; if (level < 0) then level := 0; PNS.Level := level; end; // ----------------------------------------------------------------------------- // Get PinkNoise Statistics // ! Copy/Move seems not working. So do it in old fashion way ... var2var procedure TPinkNoise2.GetPinkNoiseStat(var _PNS : TPinkNoiseStat); var i : integer; begin for I := 0 to PINK_MAX_RANDOM_ROWS - 1 do _PNS.Rows[i] := PNS.Rows[i]; // depended row values _PNS.RunningSum := PNS.RunningSum; // Used to optimize summing of generators. _PNS.Index := PNS.Index; // Incremented each sample. _PNS.IndexMask := PNS.IndexMask; // Index wrapped by ANDing with this mask. _PNS.rndMax := PNS.rndMax; // max. value for Random _PNS.IncVal := PNS.IncVal; // enable auto-increasing out-val (by WarmUp) _PNS.Min := PNS.Min; // min val dependend on rand-generation _PNS.Max := PNS.Max; // max val dependend on rand-generation _PNS.Avg := PNS.Avg; // substract for average zero _PNS.SumMin := PNS.SumMin; // min val output integer (before level) _PNS.SumMax := PNS.SumMax; // max val output integer (before level) _PNS.Level := PNS.Level; // 0 to 100 (%) Default: 70 end; end.
Code:
Sicherlich ist das nun nicht der Weisheit letzter Schluss, aber es funktioniert prima.
unit PinkMain;
interface uses ComCtrls, Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, Bass; type TNoiseForm = class(TForm) BitBtn2: TBitBtn; TrackBar1: TTrackBar; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure BitBtn2Click(Sender: TObject); procedure TrackBar1Change(Sender: TObject); private { Private declarations } CanUseFloat : boolean; NoiseStream : HSTREAM; Toggle : boolean; public { Public declarations } end; var NoiseForm: TNoiseForm; implementation {$R *.dfm} uses Pink2; var PN_L, PN_R : TPinkNoise2; // 2 different noises for left and right channel // ----------------------------------------------------------------------------- // Don't include in a Class or Form ! function MakeNoise(handle: HSTREAM; buffer: Pointer; length: DWORD; user: Pointer): DWORD; stdcall; var buf : ^word; i, len : Integer; begin buf := buffer; len := length div 4; // Stereo for i := 0 to len - 1 do begin buf^ := word(trunc(PN_L.GetPinkNoiseVal)); // if procedure has extended result !) inc(buf); buf^ := word(trunc(PN_R.GetPinkNoiseVal)); inc(buf); end; result := length; end; // ----------------------------------------------------------------------------- procedure TNoiseForm.FormCreate(Sender: TObject); var floatable : DWORD; // floating-point channel support? 0 = no, else yes begin // check if the correct BASS-Version was loaded if (HIWORD(BASS_GetVersion) <> BASSVERSION) then begin MessageBox(0, 'An incorrect version of BASS.DLL was loaded', nil, MB_ICONERROR); Halt; // ? exit; end; // Initialize BASS with the default device if (not BASS_RecordInit(-1)) // default Device or (not BASS_Init(-1, // default Device 44100, // Samplerate 0, // Flags; 0 = 16 Bit Audio Handle, // App Window-Handle nil)) // Defaultpointer User/DirectX then begin // for safety: Free possible resources BASS_RecordFree; BASS_Free; MessageBox(0, 'Could not initialize BASS with default Device', nil, MB_ICONERROR); Halt; // ? exit; end; // Ttry creating a floating-point stream to use CanUseFloat := false; floatable := BASS_StreamCreate(44100, 2, BASS_SAMPLE_FLOAT, NIL, NIL); if boolean(floatable) then begin CanUseFloat := true; // floating-point channels are supported ! BASS_StreamFree(floatable); // free the test stream ... end; // Init the neccessary rest Toggle := false; // START NOISE PN_L := TPinkNoise2.Create(16, 70); // 16 Rows, 70% value PN_R := TPinkNoise2.Create(16, 70); // 16 Rows, 70% value // create the NoiseStream NoiseStream := BASS_StreamCreate(44100, 2, 0, @MakeNoise, NIL); end; // ----------------------------------------------------------------------------- procedure TNoiseForm.FormDestroy(Sender: TObject); begin BASS_ChannelStop(NoiseStream); // for safety BASS_StreamFree(NoiseStream); // for safety Bass_Free; PN_L.Free; // for safety PN_R.Free; // for safety end; // ----------------------------------------------------------------------------- procedure TNoiseForm.BitBtn2Click(Sender: TObject); begin if not Toggle then begin if not BASS_ChannelPlay(NoiseStream, false) then begin MessageBox(0, 'Could not start stream playback', nil, MB_ICONERROR); Exit; end; BitBtn2.Caption := 'STOP NOISE'; Toggle := true; end else begin BASS_ChannelStop(NoiseStream); BitBtn2.Caption := 'START NOISE'; Toggle := false; end; end; // ----------------------------------------------------------------------------- // Min = 0, Max = 100, Position = 70, Frequency = 10 procedure TNoiseForm.TrackBar1Change(Sender: TObject); begin PN_L.SetPinkNoiseLevel(TrackBar1.Position); PN_R.SetPinkNoiseLevel(TrackBar1.Position); end; end. Fragen und auch Verbesserungsvorsschlöge sind immer willkommen. ... nun wende ich mich wieder meinemProjekt Analyser (1/3-1/12 Oktave) mit frequenzkorrekter, logarytmischer Anzeige zu. Das was es alles so gibt, ist größtenteils ja nun nicht wirklich brauchbar. Dazu mehr aber in einem anderen Thead ... Geändert von TERWI (16. Mai 2014 um 11:53 Uhr) |
![]() |
Registriert seit: 6. Apr 2011 Ort: Berlin 3.079 Beiträge Delphi 10.4 Sydney |
#3
Nun bin ich ein paar Schritte weiter - eigentlich (fast) fertig.
Es gab noch ein paar Kleinigkeiten zu bereinigen, die da wären: - Ein definierter Ausgangpegel mit Werten zwischen -32767/32768 (ein SmallInt), damit die Hardware nicht übersteuert und - Azsgangspegel regelbar, Ersteres gestattet sich ein wenig schwierig, weil m.M.n. die Ableitung von Maximalwerten aus dem Random-Wert nicht so ganz einfach ist. Ich habe das mittels sukzessiver Approximation folgendermaßen gelöst: Randnom bekommt zunächst einen Wert zugewiesen, mit dem "pur"-Werte bis ca. 55.000 erreicht werden. Diese Werte werden dann normalisiert, so dass man im Ergebnis maximal-Werte von +-27.500 erhält.
Delphi-Quellcode:
type
TOutputArray = array of Single; function GetNoiseArray(ALength : Integer) : TOutputArray; var I : Integer; const MaxAmplitude : Integer = High(SmallInt); HalfMaxAmplitude : Integer = High(SmallInt) div 2; begin SetLength(Result, ALength); for I := Low(Result) to High(Result) do begin Result[I] := (Random(MaxAmplitude) - HalfMaxAmplitude) / HalfMaxAmplitude; end; end; procedure TForm2.Button1Click(Sender: TObject); var TestNoise : TOutputArray; begin TestNoise := GetNoiseArray(512); end; |
![]() |
Registriert seit: 29. Mär 2008 Ort: D-49626 381 Beiträge Delphi 11 Alexandria |
#4
Wird sicherlich ein Geräusch von sich geben - allerdings als weißes und nicht rosa Rauschen.
Pink Noise = 1/F Rauschen. Amplitude reduziert sich um 3dB/Oktave -> geringerer Energiegehalt zu hohen Frequenzen. Idealerweise ( ! ) würde das auf einem (richtigen) Analyser dann eine gerade Linie ergeben. Schau dir mal dir procedure GetNoiseVal genau an und die Erläuterung zu der Mathematik auf ![]() |
![]() |
Registriert seit: 6. Apr 2011 Ort: Berlin 3.079 Beiträge Delphi 10.4 Sydney |
#5
Weder hier im Thread noch auf der verlinkten Seite gibt es eine procedure GetNoiseVal!
![]() Wenn du weißes Rauschen hast, warum filterst du nicht einfach mit einen Tiefpassfilter? Für solche Signalverarbeitungssachen im Hobbybereich würde ich eh MATLAB bzw. ![]() Sonst muss man sich doch mit soviel Kleinkram rumschlagen. |
![]() |
Registriert seit: 29. Mär 2008 Ort: D-49626 381 Beiträge Delphi 11 Alexandria |
#6
@TiGü:
Ich will dir sicher nicht zu nahe treten, aber ich glaube du hast nicht wirklich verstanden, worum es hier geht. Die DSP-Page hast du, wenn überhaupt, auch nur überflogen .... Weißes Rauschen braucht man zu Audio-Zwecken so gut wie nie. Ich hatte weiter oben schon was dazu geschrieben. ![]() Weder hier im Thread noch auf der verlinkten Seite gibt es eine procedure GetNoiseVal!
Farbe vergessen ... Hast du dann auch meinen Source nicht (richtig) gelesen (und verstanden) - sonst wäre dir das sicherlich aufgefallen. ![]() Wenn du weißes Rauschen hast, warum filterst du nicht einfach mit einen Tiefpassfilter?
Ein einfacher RC-Tiefpaß hat schon 6dB ! Leider zu viel. ![]() Für solche Signalverarbeitungssachen im Hobbybereich würde ich eh MATLAB bzw. Scilab nehmen.
Was glaubst du, warum sich etliche Mathematiker die Birne zerbrechen, um ein entsprechend möglichst lineares rosa Rauschen allein durch ein (in Software umsetzbares) Rechenwerk zu Stande zu bekommen ? Die nutzen natürlich MatLab & Co, um ihre geistigen Ergüsse zu prüfen. Siehe z.B. besagte DSP-Seite ganz unten - da steht es groß und breit mit Diagramm. Rechnerisch sehr schön linear. ![]() Sonst muss man sich doch mit soviel Kleinkram rumschlagen.
Entwicklern - Hard wie Soft - wurde seit je her nix vor den Arsch getragen. Handarbeit, Nachdenken, Recherche und Ausbrobieren/Messen ist angesagt. OK - das ist heute dank dem WEB einfacher als vor 20 Jahren und mehr. Dennoch bleibt nicht nur ein wenig eigener Geistesblitz erforderlich ! Und wenn es denn nur durch ggf. uneffektive, sukzessive Approximation (ich finde den Ausdruck einfach geil) geschieht. Geändert von TERWI (16. Mai 2014 um 19:37 Uhr) |
![]() |
Registriert seit: 21. Nov 2007 115 Beiträge |
#7
Die MSEgui Signalverarbeitungs-Toolbox hat auch einen Rauschgenerator:
![]() Ein Demo mit Pulseaudio Ausgang ist hier: ![]() Das Demo braucht die MSEide+MSEgui git master Version: ![]() Edit: Das sieht eher nach brown noise aus, da ist wohl noch etwas Nacharbeit notwendig...
Martin Schreiber
Geändert von mse1 (18. Mai 2014 um 19:42 Uhr) |
![]() |
Ansicht |
![]() |
![]() |
![]() |
ForumregelnEs ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.
BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus. Trackbacks are an
Pingbacks are an
Refbacks are aus
|
|
Nützliche Links |
Heutige Beiträge |
Sitemap |
Suchen |
Code-Library |
Wer ist online |
Alle Foren als gelesen markieren |
Gehe zu... |
LinkBack |
![]() |
![]() |