BASS.DLL - Rauschen erzeugen / create noise

[TERWI]

Ich suche nun schon seit geraumer Zeit (Tage) im WWW, wie man mittels der BASS.DLL mit der Soundkarte ein Rauschsignal erzeugen kann.
Bevorzugt besagtes 'weißes' oder besser noch eben dieses 'rosa' (gewichtete) Rauschen.
Leider ohne wirklichen Erfolg - falsche Suchanfrage(n) ?

Ich bastele an einem Proggy zum Messen von Lautsprechern / Raumakustik.
So was gibts logo fertig in div Variationen - aber der Preis schockt dann doch ein wenig, weil ich es nur als Hobby betrachte.

Professionelles Audio-Equipment hab ich hier (Micro, Vorverstärker),
Mit der Proggerei betreff eines Spectrum-Analysers (1/10 Terz) bin ich auch so gut wie durch.

Man könnte nun daher gehen und ein Soundfile als Quelle nutzen - aber alles (wenige) was ich bisher an 'Pink-Moise' geladen habe, scheint nicht das zu sein, was es soll.
.... und ausserdem gehts auch wieder ums Prinzip der Selbermachens und verstehens !

Also ... wie funktioniert das ? Jemand ne Idee, Link oder sonstige Hilfe ?

[TForm1]

Ich kenne mich zwar mit der Bass.dll nicht aus, aber von der Theorie her kann ich Dir auf die Sprünge helfen (wenn Du das nicht sowieso schon weißt). Weißes Rauschen kann man ganz einfach generieren, indem man für jedes Sample eine Zufallszahl zwischen deiner maximalen Amplitudenauslenkung und der minimalen Amplitudenauslenkung (also zum Beispiel zwischen 0.2 und -0.2) generiert. Bei Rosa Rauschen gibt es mehrere Methoden, eine davon ist weißes Rauschen zu erzeugen und dieses dann zu filtern, sodass die Stärke nach oben hin entsprechend der Tonhöhen logarithmisch abnimmt. Ich denke dazu müsste es entsprechende Möglichkeiten in der Bass.dll geben?

[TERWI]

Ja, in der Theorie war ich auch in dieser Richtung unterwegs.

Es gibt da einen recht interessanten Artikel:
http://www.gaedtke.name/programmiere...-rosa-rauschen
der das ein wenig näher beschreibt, aber keine Details oder gar Source hergibt.

Leider bin ich nicht so dermaßen der mathematische Held, dass ich das mal eben schnell umsetzen kann.
Geschweige denn mit BASS. Hier habe ich mich zwar mittlerweile ein bischen reingefummelt, aber kenne noch lange nicht die 'Abgründe'.

Auch hab ich i.M. keine Plan, wie ich ein WAV-Signal erzeuge, dem ich zufällige Samples mitgeben und dass dann hoffentliuch ein (weißes) Rauschen ist ....

Hätte man/ich so was, wäre mein nächster Ansatz, den Param-EQ von BASS mit maximaler Kanalzahl und jeweiligen Bandbreiten in der Amplitude so einzustellen, dass annäherungsweise ein Rauschsignal mit gleicher Leistungung in den einzelnen Terzen dabei herauskommt.

.... das ist für mich wie gesagt 'Hobby' und zu 100% muss (kann und wird) das eh nicht passen.
.... also tut es sicherlich auch etwas in der Art der sukzessiven Aproximation oder so. 8-)

[glotzer]

also, so gehts:

Die bass.dll hat die Funktion BASS_StreamCreate, die einen Parameter STREAMPROC nimmt. Diese Funktion gibt die Daten zurück. Das würde bei Rauschen so aussehen:

Delphi-Quellcode:

Handle := BASS_StreamCreate(freq, chanels, flags or BASS_SAMPLE_8BITS{$IFDEF UNICODE} or BASS_UNICODE {$ENDIF}, @Callback, nil);

function Callback(handle: HSTREAM; buffer: Pointer; length: DWORD; user: Pointer): DWORD; stdcall;
var
  i: integer;
begin
  for i:=0 to length-1 do
  begin
    buffer^ := random(255); //255 ist abhängig vom Streamformat das beim erzeugen angegeben wurde. Für 255 muss es BASS_SAMPLE_8BITS sein. 
    inc(buffer);
  end;
  result := length-1;
end;

Das ganze hab ich hier im Editor geschrieben, also nicht getestet. Vom Prinzip her ist es aber richtig.

Hoffe ich konnte dir helfen.

[TERWI]

Kilo-Dank zunächst vorab !
Werde ich umgehend testen - bin aber grad nicht am Brett.

[TERWI]

Soooo ..... auf Anhieb hats erwartungsgemäß nicht geklappt.
Aber mit der Idee und ein wenig stöbern in den Samples von BASS kam das hier dabei raus:

Code:

unit uNoiseTest;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls,
  Bass;

type
  TForm1 = class(TForm)
    BitBtn2: TBitBtn;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
  private
    { Private declarations }
    NoiseStream : HSTREAM;
    Toggle      : boolean;
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses Math;

function MakeNoise(handle: HSTREAM; buffer: Pointer; length: DWORD; user: Pointer): DWORD; stdcall;
var
  buf : ^word;
  i, len : Integer;
begin
  buf := buffer;
  len := length div 2;
  for i := 0 to len - 1 do
  begin
    buf^ := 65538 - trunc(random(32767));  // Werte sind 'SIGNED'
    inc(buf);
  end;
  result := length;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  // check the correct BASS was loaded
  if (HIWORD(BASS_GetVersion) <> BASSVERSION) then
  begin
    MessageBox(0,'An incorrect version of BASS.DLL was loaded',0,MB_ICONERROR);
    exit;
  end;
  // Initialize BASS with the default device
  if NOT BASS_Init(-1, 44100, 0, Handle, nil) then
  begin
    MessageBox(0,'Could not initialize BASS',0,MB_ICONERROR);
    exit;
  end;
  Toggle := false;
  Randomize;
  NoiseStream := BASS_StreamCreate(44100, 2, 0, @MakeNoise, 0);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  BASS_ChannelStop(NoiseStream);
  BASS_StreamFree(NoiseStream);
  Bass_Free;
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
  if not Toggle then
  begin
    if not BASS_ChannelPlay(NoiseStream, true) then
    begin
      MessageBox(0,'Could not start stream playback',0,MB_ICONERROR);
      Exit;
    end;
    BitBtn2.Caption := 'STOP';
    Toggle := true;
  end
  else
  begin
    BASS_ChannelStop(NoiseStream);
    BitBtn2.Caption := 'START';
    Toggle := false;
  end;
end;

end.

Das funktioniert so weit sehr gut und rauscht so vor sich hin.
Wie erwartet kommt offentsichtlich allerdings weißes Rauschen dabei raus.
Auf vorhandenen Analysern ist der Anstieg des Spektrum deutlich erkennbar.

Anmerkung:
Man sollte so ein Signal NICHT zum Testen von Lautsprechern o.a. benutzen.
Die Wahrscheinlichkeit, dass die Mittel- aber vor allem die Hochtöner wegen des hohen Energiegehaltes ZZ (ziemlich zügig) den Geist wegen Überlastung aufgeben können, ist SEHR hoch !

.... fehlt nun noch 'was', wie man aus dem weiß ein rosa macht. (... was rotes mitwaschen ? :shock:)
Also: Kontinuierlicher Abfall von 3dB/Oktave.
Das mit dem BASS-EQ werde ich mal testen - aber elegant ist das sicher nicht.

[glotzer]

Delphi-Quellcode:

procedure TForm1.FormDestroy(Sender: TObject);
begin
  BASS_ChannelStop(NoiseStream);
  BASS_StreamFree(NoiseStream);
  Bass_Free;
end;

Hier ist alles bis auf das Bass_Free nicht nötig, da ein StreamFree immer auch den channel stopt und ein BassFree für jeden vorhandenen Stream einmal StreamFree aufruft.

Rosa Rauschen:
Wikipedia hat die Grundlagen
hier ist der Matheteili noch etwas genauer

[TERWI]

Tja nun, geschadet hats auch nicht.
Hatte auch ausversehen "len := length div 2;" vergessen und "for i = 0 to length - "1 eingesetzt.
Das rauscht zwar auch, aber das knallt beim beenden des Progs fürchterlich und das Prog wird nicht richtig beendet....
Aber auch das noch gefunden.

Und noch mal danke für die Tipps !
Bin zwar kein mathematischer Allergiker - aber auch nicht der Vorturner, der die kryptischen Hyrglyphen deuten kann.

Wenn ich das bei den mikrocontrollern richtig gelesen haben, müsste diese Funktion in der callback-funktion der "Bringer" sein ?!

Code:

void generate(double x[], int n) {
  double r;
  int i, j;

  for(i=0; i<n; i++) {
    r = rnd();
    for(j=i+1; j<n; j++)
      x[j] += r * (sqrt(j-i) - sqrt(j-i-1));
  }
}

... ich versuche mal V2.0

[TERWI]

Diese o.g. Formelei scheint irgendwie untauglich / unvollständig / falsch.
Hab das mal umgeschrieben - dabei werden die Werte in dem Array kontinuierlich größer, was doch eigentlich nicht sein sollte.
Oder ?
In die Callback eingesetzt, kommt da auf jededn Fall nix gescheites bei rum - auch nicht bei unterschiedlicher parametrisierung des Random-Zahlen.

Weil mir ebenfalls auch noch jegliches Verständis, wie das eigentlich in so einem Stream vor sich gehen soll, definiert ein Signal/Rauschen mit vom unteren Bereich abfallender Energie zu erzeigen, wäre ich auch hier um einen Lesetipp sehr dankbar.

Logo auch immer noch für den 'Rosa-Tipp'.

[TERWI]

Die Nacht war lang .... ich hab viel gesucht und noch mehr gelesen.
Immer wieder bin ich auf http://www.firstpr.com.au/dsp/pink-noise/ gelandet.
Ein bischen schwerer Stoff wie finde - aber da eh nix anderes gescheites zu finden war, habe ich mir mal einen dort verlinkten Source (in C "The final version of Phil Burk's code is here:" in dem rosa Kasten etwas unterhalb der Seitenmitte) gezogen.

Nachdem ich dann heute irgendwann mal alle Stolperfallen beseitigt hatte, rauschte es wunderschön.
Ganz offensichtlich in rosa !
Ich hab daraus mal im 1. Entwurf eine Delphi-Klasse gebastelt.
Die Funktionen und Kommentare vom org. C-Text Phil Burk habe ich 1:1 übersetzt, bzw. belassen. Man sollte es wiedererkennen.
Das ganze sieht dann so aus:

Code:

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)

type
  TPinkNoiseData = record
    pink_Rows  : array[0..PINK_MAX_RANDOM_ROWS - 1] of longword;
    pink_RunningSum : longword; // Used to optimize summing of generators.
    pink_Index      : integer;  // Incremented each sample.
    pink_IndexMask  : integer;  // Index wrapped by ANDing with this mask.
    pink_Scalar     : real;     // Used to scale within range of -1.0 to +1.0
    pink_pmax       : longword;
  end;

type
  TPinkNoise2 = Class
  private
    pink_Rows       : array[0..PINK_MAX_RANDOM_ROWS - 1] of longword;
    pink_RunningSum : longword; // Used to optimize summing of generators.
    pink_Index      : integer;  // Incremented each sample.
    pink_IndexMask  : integer;  // Index wrapped by ANDing with this mask.
    pink_Scalar     : real;     // Used to scale within range of -1.0 to +1.0
    pink_pmax       : longword;
    pinkMax         : real;
    pinkMin         : real;
    procedure InitializePinkNoise(numRows : integer);
    function  GenerateRandomNumber : longword;
  public
    Constructor Create(numRows : integer);
    Destructor  Destroy;
    function    GetPinkNoiseVal : real;
    function    GetPinkNoiseData(var PND : TPinkNoiseData) : boolean;
  end;

implementation

// -----------------------------------------------------------------------------
constructor TPinkNoise2.Create(numRows : integer);
begin
  pinkMax :=  999.0;
  pinkMin := -999.0;
  InitializePinkNoise(numRows);
end;

// -----------------------------------------------------------------------------
destructor TPinkNoise2.Destroy;
begin
//
end;

// -----------------------------------------------------------------------------
// Setup PinkNoise structure for N rows of generators.
procedure TPinkNoise2.InitializePinkNoise(numRows : integer);
var
  i    : integer;
begin
  if (numrows > PINK_MAX_RANDOM_ROWS) then numrows := PINK_MAX_RANDOM_ROWS; // for safety
  pink_Index := 0;
  pink_IndexMask := (1 shl numRows) - 1;
  // Calculate maximum possible signed random value. Extra 1 for white noise always added.
  pink_pmax := (numRows + 1) * (1 shl (PINK_RANDOM_BITS - 1));
  pink_Scalar := 1.0 / pink_pmax * 10;
  // Initialize rows.
  for i := 0 to numRows - 1 do pink_Rows[i] := 0;
  pink_RunningSum := 0;
  // initialize Random
  Randomize;
end;

// -----------------------------------------------------------------------------
// Calculate pseudo-random 32 bit number based on linear congruential method.
function TPinkNoise2.GenerateRandomNumber : longword;
begin
  result := Random(pink_IndexMask * 8);   // TRY & ERROR ?!?!?!
end;

// -----------------------------------------------------------------------------
// Generate Pink noise values between -1.0 and +1.0
function TPinkNoise2.GetPinkNoiseVal : real;
var
  newRandom   : longword;
  sum         : longword;
  output      : real;
  n, numZeros : integer;
begin
  // Increment and mask index.
  pink_Index := (pink_Index + 1) and pink_IndexMask;
  // If index is zero, don't update any random values.
  if (pink_Index <> 0) then
  begin
    // Determine how many trailing zeros in PinkIndex.
    // This algorithm will hang if n==0 so test first.
    numZeros := 0;
    n := pink_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.
    pink_RunningSum := pink_RunningSum - pink_Rows[numZeros];
    newRandom := GenerateRandomNumber shr PINK_RANDOM_SHIFT;
    pink_RunningSum := pink_RunningSum + newRandom;
    pink_Rows[numZeros] := newRandom;
  end;
  // Add extra white noise value.
  newRandom := GenerateRandomNumber shr PINK_RANDOM_SHIFT;
  sum := pink_RunningSum + newRandom;
  // Scale to range of -1.0 to 0.9999.
  output := pink_Scalar * sum;
  // Check Min/Max
  if (output > pinkMax) then
    pinkMax := output
  else
    if (output < pinkMin) then pinkMin := output;

//  result := output;
  result := sum;
end;

// -----------------------------------------------------------------------------
// Generate Pink noise values between -1.0 and +1.0
function TPinkNoise2.GetPinkNoiseData(var PND : TPinkNoiseData) : boolean;
var
  i : integer;
begin
  for I := 0 to PINK_MAX_RANDOM_ROWS - 1 do
    PND.pink_Rows[i] := pink_Rows[i];
  PND.pink_RunningSum := pink_RunningSum;
  PND.pink_Index      := pink_Index;
  PND.pink_IndexMask  := pink_IndexMask;
  PND.pink_Scalar     := pink_Scalar;
  PND.pink_pmax       := pink_pmax;
  result := true;
end;

end.

Der Test-Code ist in etwa der gleiche wie weiter oben, mit etwas veränderter Initialsierung:

Code:

// Global für CallBack
var
  PN_Left, PN_Right : TPinkNoise2;
.....
procedure TForm1.FormCreate(Sender: TObject);
var
  floatable : DWORD; // floating-point channel support? 0 = no, else yes
begin
  // check the correct BASS was loaded
  if (HIWORD(BASS_GetVersion) <> BASSVERSION) then
  begin
    MessageBox(0,'An incorrect version of BASS.DLL was loaded',nil,MB_ICONERROR);
    exit;
  end;
  // Initialize BASS with the default device
  if NOT BASS_Init(-1, 44100, 0, Handle, nil) then
  begin
    MessageBox(0,'Could not initialize BASS',nil,MB_ICONERROR);
    exit;
  end;
  Toggle := false;

  floatable := BASS_StreamCreate(44100, 2, BASS_SAMPLE_FLOAT, NIL, NIL); // try creating a floating-point stream
  if boolean(floatable) then
  begin
    BASS_StreamFree(floatable); // floating-point channels are supported! (free the test stream)
    ListBox1.Items.Add('floating-point channels are supported!');
  end;

  PN_Left  := TPinkNoise2.Create(16);
  PN_Right := TPinkNoise2.Create(16);

  NoiseStream := BASS_StreamCreate(44100, 2, 0, @MakePinkNoise, NIL);
end;

Die CallBack-Funktion für BASS.DLL dazu:

Code:

function MakePinkNoise(handle: HSTREAM; buffer: Pointer; length: DWORD; user: Pointer): DWORD; stdcall;
var
  buf : ^word;
  i, len : Integer;
begin
  buf := buffer;
  len := length div 2;
  for i := 0 to len - 1 do
  begin
    buf^ := word(trunc(PN_Left.GetPinkNoiseVal));
    inc(buf);
  end;
  result := length;
end;

Das ganze rauscht wie gesagt ganz einwandfrei vor sich hin.
Im Vergleich zu anderen Proggis, die auch rauschen können (oder auch ladbaren Files) ist eigentlich kein Unterschied zu erkennen - d.h. die Rauschleistung je Oktave/Dekade ist OK.
Ich würde sogar fast (subjektiv) behaupten, dieses Gerausche ist nicht so "zappelig" wie andere.

Natürlich ist das o.g. nocht nicht zu Ende gar gekocht.
Es gibt da für mich neben dem Verständnisproblem der eigentlichen Formel auch noch das Prob mit der Höhe der Ausgangswerte.
(Ich hab hier erst mal die Longwerte als solches genommen - normalisiert auf Float -1/+1 wäre sehr viel eleganter !)
Man darf BASS nicht mit 16-Bit-Werten > 32767 "befeuern, sonst zerrt es gehörig.
Das die Amplitude (mit Rows = 16 in der Initialisierung) passt, habe ich zunächst mal mit Versuch & Irrtum in der Funktion "GenerateRandomNumber" so hingebastelt das es passt.

Vielleicht hat ja der eine oder andere noch div. Geisteblitze dazu ?
Lasst hören !

[TERWI]

... sicher nicht wirklich das richtige Forum für die Frage/das Prob - ich versuchs aber mal trotzdem:

Bis ca. 17:00 lief alles tadellos.
Ich hatte bisweilen gut 2 Hände voll Programme gleichzeitig offen (und am laufen - Taskleiste voll), die was rauschen oder abspielen können, bzw. mir was ala (Terz-) Analyser anzeigen.
Alles kein Thema ....

ZACK - auf einmal zeigen mir alle "Lese-Programme" (sprich die Analyser) nichts mehr an !
Wieso und warum ?
Von 3/4 Proggis weiss ich genau, das diese was anderes als BASS benutzen, bzw. direkt auf die Hardware/Treiber/System zugreifen.
Liegt also wohl nicht an BASS ?! Hab ich auch schon neu kopiert.
Logo auch den Rechner div. Male neu gestartert mit 5 Minuten Stecker raus dazwischen.

Rien ne vas plus - nix geht mehr, ich kapier es nicht. Ich find auch nix im WWW dazu.
Ist da ein Dienst von Windoof "weg" ? Welcher ?
Jemand ne Idee ?

Hilfe bitte. Dringend.

[TiGü]

Schreiben die vielen gleichzeitig gestarteten Tools irgendwas auf die Festplatte?

Wenn ja, ist die vielleicht einfach voll?

[TERWI]

Nein, da wird nix geschrieben. Mögliche Idee, aber leider falsch.

... ich habs aber wieder hinbekommen ! HEUREKA ! :-D
Nach x Versuchen mit Treiber und DirectX neu aufspielen waren die Nerven schon arg strapaziert.
Ein Zufall brachte mich eben drauf, als ich ein weiteres (Test-) Programm ausprobiert habe.

-> Irgendeins von den vielen Proggis gestern hat den Aufnahme-Eingang offensichtlich auf MIKROFON gestellt.

Und diese Einstellung scheint wohl WinDoof dauerhaft zu verwalten - nicht BASS oder sonst was, denn alle Proggis reagierten gleich darauf - egal auf welcher Basis sie arbeiten.
Das kann ich nachvollziehbar reproduzieren:
- Internet-Radio-Stream von NDR2 läuft (meist immer nebenbei)
- 3+ Analyser/Anzeigen zappeln dazu auf dem Bildschirm fröhlich vor sich hin.

Nun nehme ich oben erwähntes einfache Tool, welches die Aufnahmeeingänge (hier: Mikro, Line, Steromix) umschalten kann.
Einmal von Stereomix auf Line geschaltet und Ruhe herrscht in den Displays !
Audacity war wohl gestern das Tool, was die Verwirrung gebracht hat - ich hatte da wohl unbewusst was verstellt.
Auch damit kann ich die Anzeige ab-/zuschalten.

Was lernen wir daraus ? Es kann nur einen geben .... Aufnahme-Kanal (pro vorhandenem Device !).
Eigentlich logisch und es werden manche nun Schlaumeierhaft vielleicht daherkommen und sagen: "Das hätte ich dir wohl sagen können".
.... hat aber keiner.

Für mich war das neu. Wieder was gelernt. Und ich kann endlich weitermachen ....
Also ein wenig Obacht beim Hantieren mit mehreren Audio-Proggis gleichzeitig. 8-)

[EWeiss]

Zitat:

Nun nehme ich oben erwähntes einfache Tool, welches die Aufnahmeeingänge (hier: Mikro, Line, Steromix) umschalten kann.

Kann Bass auch .. Oh entschuldige das hätte ich dir wohl sagen können.
Konnte es mir einfach nicht verkneifen.
War nur nicht Online... hehehehe

gruss

[TERWI]

:lol: Schadenfreude ist doch was schönes ....
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 ....

[TERWI]

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: http://www.firstpr.com.au/dsp/pink-noise/
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:

{
  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.

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:

Code:

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.

Sicherlich ist das nun nicht der Weisheit letzter Schluss, aber es funktioniert prima.
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 ...

[TiGü]

Zitat:

Zitat von TERWI (Beitrag 1259043)

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.

Sowas?

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;

[TERWI]

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 http://www.firstpr.com.au/dsp/pink-noise/.

[TiGü]

Weder hier im Thread noch auf der verlinkten Seite gibt es eine procedure GetNoiseVal! :wiejetzt:

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. Scilab nehmen.
Sonst muss man sich doch mit soviel Kleinkram rumschlagen.

[TERWI]

@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.

Zitat:

Weder hier im Thread noch auf der verlinkten Seite gibt es eine procedure GetNoiseVal!

Oooh, sorry tausendmal. Muss richtig heißen: GetPinkNoiseVal. Die Hauptroutine meiner Klasse.
Farbe vergessen ... Hast du dann auch meinen Source nicht (richtig) gelesen (und verstanden) - sonst wäre dir das sicherlich aufgefallen.

Zitat:

Wenn du weißes Rauschen hast, warum filterst du nicht einfach mit einen Tiefpassfilter?

Mach ich gern und sofort - wenn du mir ein taugliches 3dB/Oktav-Filter zeigst, das einfach aufzubauen und dazu noch so linear wie möglich ist ... Oder den (einfachen) mathematischen Algorithmus dazu.
Ein einfacher RC-Tiefpaß hat schon 6dB ! Leider zu viel.

Zitat:

Für solche Signalverarbeitungssachen im Hobbybereich würde ich eh MATLAB bzw. Scilab nehmen.

Das ist Simulations-Software ! Was nutzt mir die, wenn ich nicht den mathematischen Background habe und ich so nicht die Umsetzung von Hardware-Schaltungen auf Software-Code gebraten bekomme ...
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.

Zitat:

Sonst muss man sich doch mit soviel Kleinkram rumschlagen.

Ich weiß ja nicht, wie das bei dir ist: Wenn du eine Idee hast und nicht gleich auf Anhieb im WWW die passenden Lösungen mundgerecht präsentiert bekommst .... schmeißt du dann gleich alles hin und verwirfst deine (gute) Idee ?
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.

[mse1]

Die MSEgui Signalverarbeitungs-Toolbox hat auch einen Rauschgenerator:
https://gitorious.org/mseide-msegui/...sesignoise.pas
Ein Demo mit Pulseaudio Ausgang ist hier:
https://gitorious.org/mseuniverse/ms...ignal/noisegen
Das Demo braucht die MSEide+MSEgui git master Version:
https://gitorious.org/mseide-msegui/mseide-msegui
Edit:
Das sieht eher nach brown noise aus, da ist wohl noch etwas Nacharbeit notwendig...

[mse1]

MSEide+MSEgui git master 9b2b47fd benutzt nun den Filter von Paul Kellet für pink:

Code:

procedure tsignoise.sighandlerpink1(const ainfo: psighandlerinfoty);
var
 white: double;
begin
 fz:= 36969 * (fz and $ffff) + (fz shr 16); //mwc by George Marsaglia
 fw:= 18000 * (fw and $ffff) + (fw shr 16);
 white:= (integer((fz shl 16) + fw)/fscale);
 
 fb0:= 0.99886 * fb0 + white * 0.0555179;   //filter by Paul Kellet
 fb1:= 0.99332 * fb1 + white * 0.0750759; 
 fb2:= 0.96900 * fb2 + white * 0.1538520; 
 fb3:= 0.86650 * fb3 + white * 0.3104856; 
 fb4:= 0.55000 * fb4 + white * 0.5329522; 
 fb5:= -0.7616 * fb5 - white * 0.0168980; 
 foutputpo^:= (fb0+fb1+fb2+fb3+fb4+fb5+fb6+white*0.5362) *
                             famplitudepo^.value + foffsetpo^.value; 
 fb6:= white * 0.115926;
end;

[mse1]

Hier der Mittelwert von 11449 FFT's mit jeweils 65536 Punkten.

[guschtel]

hi, hast du nochmal was dran gemacht? Ansonsten großes Lob! Grüße Bernd :thumb:

[Klaus01]

Zitat:

Zitat von guschtel (Beitrag 1480115)

hi, hast du nochmal was dran gemacht? Ansonsten großes Lob! Grüße Bernd :thumb:

siehe hier: https://lists.freepascal.org/piperma...er/055334.html

Grüße
Klaus