Главная страница
    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.47 MB
Время: 0.039 c
4-1125138258
lelik2005
2005-08-27 14:24
2005.10.30
Помогите с созданием окна по рисунку


2-1128762913
KLOD
2005-10-08 13:15
2005.10.30
подскажите как найти нужную инфу в файле


10-1106212117
bmax
2005-01-20 12:08
2005.10.30
TWebBrowser в качестве Com-клиента


14-1128585427
MYSTERYO
2005-10-06 11:57
2005.10.30
8x видаху в 4х AGP порт. Будет ли работать?


6-1121239399
kot andrei
2005-07-13 11:23
2005.10.30
запрос пароля





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский