Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2005.10.30;
Скачать: CL | DM;

Вниз

Как создать "розовый" шум (pink noise) c библиотекой BASS?   Найти похожие ветки 

 
Dr. Andrew   (2005-06-03 14:50) [0]

Как создать "розовый" (pink noise) шум (например, шум леса или ручья) требуемых частот, используя исключительно библиотеку BASS? Мастера, пожалуйста, приведите конкретный пример или приведите ссылку на конкретный пример. Всем спасибо за помощь!


 
Jeer ©   (2005-06-03 16:42) [1]

Шум леса или ручья (тем более) это не розовый шум.

Розовый шум это белый шум обработанный плоским фильтром низких частот.


 
Dr. Andrew   (2005-06-03 17:27) [2]

Хорошо. Тогда подскажите как с помощью библиотеки BASS создать белый шум. Пожалуйста, практический пример. Спасибо!


 
Jeer ©   (2005-06-03 18:29) [3]

Белый шум это Random или RandG из Delphi:)


 
programania ©   (2005-06-05 01:46) [4]


procedure TForm1.Button2Click(Sender: TObject);
const
d=5;    //длина шума в сек
f=22050;//частота
t1=1;   //время увеличения
t2=4;   //уменьшения

type
tb=array[0..f*d] of smallInt;

var
data:^tb;

var
i,j,h,q,s1,s2,a:integer; r:boolean;
begin
q:=f*d;
BASS_Init(-1, q, 0, application.handle);
BASS_Start;
data:=BASS_SampleCreate(q, f, 1, BASS_SAMPLE_MONO or BASS_SAMPLE_LOOP);
s1:=t1*f;
s2:=t2*f;
i:=0;
r:=true;

for j:=0 to q-1 do begin

 if r then begin inc(i);a:=1024*i div s1 end
      else begin dec(i);a:=1024*i div s2 end;
 if r and (i>s1) then begin r:=false; i:=s2 end;
 if i=0  then r:=true;

 data^[j]:=(random(64000)-32000)*a div 1024;
//розоватость шума в начале:
 if (j>0)and r then data^[j]:=(data^[j]+data^[j-1])* 3 div 4;
end;

h:=BASS_SampleCreateDone;
BASS_SamplePlayEx(h, 0{start},f,100{volume}, 0{pan}, true{loop});
end;


 
XProger ©   (2005-06-05 04:25) [5]

Благодаря programania хоть услышал что это такое :)
Для этого маленькую программку написал, если кому интересно...

program noise;

uses
Windows;

const
d  = 5;    
f  = 22050;
t1 = 1;  
t2 = 4;  

type
tb = array [0..1] of SmallInt;

TWav_Header = record
 riff            : array [0..3] of Char;
 filesize        : DWORD;
 rifftype        : array [0..3] of Char;
 chunk_id1       : array [0..3] of Char;
 chunksize1      : DWORD;
 wFormatTag      : Word;
 nChannels       : Word;
 nSamplesPerSec  : DWORD;
 nAvgBytesPerSec : DWORD;
 nBlockAlign     : Word;
 wBitsPerSample  : Word;
 chunk_id2       : array [0..3] of char;
 chunksize2      : DWORD;
end;

var
data: ^tb;

var
i, j, q, s1, s2, a : integer;
r   : boolean;
Fo  : File of Byte;
wav : TWav_Header;
begin
AssignFile(Fo, "noise.wav");
Rewrite(Fo);

q := f*d;
GetMem(data, q*2);
s1 := t1*f;
s2 := t2*f;
i  := 0;
r  := true;

for j := 0 to q - 1 do
begin
if r then
 begin
 inc(i);
 a := 1024*i div s1;
 end
else
 begin
 dec(i);
 a := 1024*i div s2;
 end;

if r and (i > s1) then
 begin
 r := false;
 i := s2;
 end;

if i = 0 then r := true;

data^[j] := (random(64000)-32000)*a div 1024;

if (j > 0) and r then
 data^[j] := (data^[j] + data^[j-1])*3 div 4
end;

with wav do
begin
riff            := "RIFF";
filesize        := q*2 + sizeof(wav) - 8;
rifftype        := "WAVE";
chunk_id1       := "fmt ";
chunksize1      := 16;
wFormatTag      := 1;
nChannels       := 1;
nSamplesPerSec  := f;
nAvgBytesPerSec := 2*f;
nBlockAlign     := 2;
wBitsPerSample  := 16;
chunk_id2       := "data";
chunksize2      := q * 2;
end;
BlockWrite(Fo, wav, sizeof(wav));
BlockWrite(Fo, data^[0], q*2);
CloseFile(Fo);
FreeMem(data);
end.

А не подскажет ли кто-нибудь ссылочку по описанию подобных алгоритмов? :)


 
Thaddy   (2005-06-06 00:47) [6]

Or look at www.musicdsp.org for examples and filters


 
Thaddy   (2005-06-06 00:48) [7]

Or look at www.musicdsp.org for examples and filters


 
XProger ©   (2005-06-06 16:20) [8]

thx!



Страницы: 1 вся ветка

Текущий архив: 2005.10.30;
Скачать: CL | DM;

Наверх




Память: 0.49 MB
Время: 0.128 c
14-1128658997
root
2005-10-07 08:23
2005.10.30
Работа со штрих кодами


14-1128709701
default
2005-10-07 22:28
2005.10.30
"Живое" пиво, срок хранения три дня


14-1127911543
pazitron_brain
2005-09-28 16:45
2005.10.30
Подскажите хорошую идею.


8-1118178605
Серёга
2005-06-08 01:10
2005.10.30
Работа с TImage


10-1106204689
Vlash
2005-01-20 10:04
2005.10.30
Блокирование клиента