BASS.DLL - Rauschen erzeugen / create noise

[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 !