BASS.DLL - Rauschen erzeugen / create noise

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