Главная страница
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.036 c
4-1125147958
kami
2005-08-27 17:05
2005.10.30
Как передать содержимое файла в Clipboard


2-1128579372
Wolferio
2005-10-06 10:16
2005.10.30
Опраделить запущен ли файл на печать


14-1128505443
pazitron_brain
2005-10-05 13:44
2005.10.30
Формула активного рабочего дня.


6-1120773405
viktorovich
2005-07-08 01:56
2005.10.30
Логин и пароль из Outlook Express


2-1127728356
SMATMP
2005-09-26 13:52
2005.10.30
Bitmap.PixelFormat