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 !