O muzyce i d¼wiêkachW tych artyku³ach szczegó³owo przedstawiono próby odtwarzania muzyki z karty muzycznej a tak¿e z g³o¶niczka wbudowanego w komputer (za pomoc± instrukcji Sound). Tre¶æ tworz± g³ównie kody ¼ród³owe, dlatego wymagana jest choæ czê¶ciowa umiejêtno¶æ Pascala
Muzyka i d¼wiêk w Turbo Pascalu
Poni¿ej prezentacja modu³u Wavplay -znajdziesz go w internecie jako FreeWare. Mo¿na siê na jego podstawie nauczyæ programowania kart d¼wiêkowych. Polecam ksi±¿kê: Programowanie gier 2D i 3D w jêzyku Turbo Pascal Ten modu³ zatrzymuje dzia³anie programu podczas odtwarzania d¼wiêku, ale da siê go przerobiæ by tak nie by³o. Powodzenia... Odtwarzanie plików wave w pascalu W pascalu nie ma du¿ych problemów z odtworzeniem d¼wiêków. Poni¿szy modu³ pozwala na odtworzenie wave'ów 8-bitowych, o czêstotliwo¶ci próbkowania do 11khz. ¯eby nagraæ taki d¼wiêk najlepiej pos³u¿yæ siê programem CoolEdit2000. W internecie powinna byæ jego darmowa wersja Shareware. Mo¿na oczywi¶cie samemu programowo wytworzyæ falê, któr± pó¼niej odtworzy komputer. Wykorzystanie modu³u Najpierw trzeba wywo³aæ funkcjê Init('nazwapliku.wav'); Pó¼niej tylko Play; Je¶li Twoja karta muzyczna spe³nia standardy Sound Blastera powinienne¶ us³yszeæ d¼wiêk.
{$G+}
Unit wavplay;
{$M 4096,0,65500}
Interface
Uses DOS,Crt;
Procedure Init(GN:STRING);
Procedure Play;
Implementation
Const dma = 4096;
Type id_t = Array[1..4] of Char;
riff_t = Record
R_Ident : id_t;
length : Longint;
C_Ident : id_t;
S_Ident : id_t;
s_length: Longint;
Format ,
Modus : Word;
freq ,
byte_p_s: LongInt;
byte_sam,
bit_sam : Word;
D_Ident : id_t;
d_length: LongInt;
End;
blaster_T = Record
port : Word;
dmac ,
hdmac,
irq : Byte;
End;
buffer_T = Array[1..dma] of Byte;
Var id : riff_T;
fn : String;
wav : File;
sbb : Word;
Ende : Boolean;
blaster : Blaster_T;
alt_irq : Pointer;
dma_buf_1,
dma_buf_2,
zwi : ^Buffer_T;
Channel : Byte;
Const RIFF : id_t = ('R','I','F','F');
WAVE : id_t = ('W','A','V','E');
FMT_ : id_t = ('f','m','t',' ');
DATA : id_t = ('d','a','t','a');
DMA_Dat : Array [0..7,1..6] of Byte=
(($A,$C,$B,$0,$87,$1),
($A,$C,$B,$2,$83,$3),
($A,$C,$B,$4,$81,$5),
($A,$C,$B,$6,$82,$7),
($D4,$D8,$D6,$C0,$8F,$C2),
($D4,$D8,$D6,$C4,$8B,$C6),
($D4,$D8,$D6,$C8,$89,$CA),
($D4,$D8,$D6,$CC,$8A,$CE));
Procedure Blaster_Command(c :Byte); Assembler;
Asm
Mov dx,Word Ptr sbb
Add dx,$c
@t:In al,dx
And al,128
Jnz @t
Mov al,c
Out dx,al
End;
Procedure Init_SB(base : Word);
Var w,w2:Word;
Begin
sbb:=base;
Port[base+6]:=1; Delay(4); Port[base+6]:=0; w:=0; w2:=0;
Repeat
Repeat Inc(w); Until ((Port[base+$e] and 128)=128) or (w>29);
Inc(w2);
Until (Port[base+$a]=$AA) or (W2>30);
If w2>30 then
Begin
WriteLn('Failed to ReSet Blaster');
Halt(128);
End;
Blaster_Command($d1);
End;
Procedure Set_Stereo; Assembler;
Asm
Mov dx,Word Ptr sbb
Add dx,$4
Mov al,$e
Out dx,al
Inc dx
In al,dx
And al,253
Or al,2
Out dx,al
End;
Procedure Clear_Stereo; Assembler;
Asm
Mov dx,Word Ptr sbb
Add dx,$4
Mov al,$e
Out dx,al
Inc dx
In al,dx
And al,253
Out dx,al
End;
Function No_Wave(Var id:riff_T):Boolean;
Begin
With id do
No_Wave:=(R_Ident<>RIFF) or
(C_Ident<>WAVE) or
(S_Ident<>FMT_) or
(D_Ident<>DATA);
End;
Procedure Init(GN:STRING);
Var b : Byte;
Begin
{ WriteLn;
WriteLn('ABo WAV-Player (16bit Test) (p) 27.11.94 ABo');}
Blaster.Port:=0;
Blaster.dmac:=0;
Blaster.hdmac:=0;
Blaster.irq:=0;
fn:=GetEnv('BLASTER');
If fn='' then
Begin
WriteLn('BLASTER must be set...');
Halt(100);
End;
b:=1;
Repeat
Case fn[b] of
'A' : Repeat
Inc(b);
Blaster.Port:=Blaster.Port*16+Ord(fn[b])-48;
Until Fn[b+1]=' ';
'D' : Begin
Blaster.DMAc:=Ord(fn[b+1])-48;
Inc(b,2);
End;
'I' : Repeat
Inc(b);
Blaster.IRQ:=Blaster.IRQ*16+Ord(fn[b])-48;
Until Fn[b+1]=' ';
'H' : Begin
Blaster.hDMAc:=Ord(fn[b+1])-48;
Inc(b,2);
End;
End;
Inc(b);
Until b>Length(fn);
{ With Blaster do
WriteLn('Blaster : P',Port,' I',irq,' D',dmac,' H',hdmac);}
Init_SB(Blaster.Port);
FN:=GN;
Assign(wav,fN);
{$I-} ReSet(wav,1); {$I+}
If IOResult<>0 then
Begin
WriteLn('File "',fn,'" not found!');
Halt(2);
End;
BlockRead(wav,id,Sizeof(id));
If no_Wave(id) then
Begin
WriteLn('"',fn,'" seems to be no WAVE-File...');
Halt(128);
End;
{ Write('Wave : ',id.bit_sam,'bit ');}
If id.Modus=2 then
Begin
Set_Stereo;
{ Write('stereo ');}
End
Else
Begin
Clear_Stereo;
{ Write('mono ');}
End;
If (id.bit_sam>8) and (Blaster.hdmac>3) then
Channel:=Blaster.hdmac
Else Channel:=Blaster.dmac;
{ WriteLn(id.freq,' Hz ',id.byte_p_s,' Bytes/Sec');
WriteLn('Length : ',id.d_length,' Bytes ',id.d_length div id.byte_p_s, ' Sec');
WriteLn('Playing : ',fn);}
End;
{$F+}
Procedure Stelle_DMA(Freq: Word;Var size : Word);
Var PageNr,PageAdress,DMALength: Word;
Begin
Inline($FA);
Asm
Mov ax,Word Ptr DMA_Buf_1[2]
Shr ax,12
Mov Word Ptr PageNr,ax
Mov ax,Word Ptr DMA_Buf_1[2]
Shl ax,4
Mov Word Ptr PageAdress,ax
Mov ax,Word Ptr DMA_Buf_1
Add Word Ptr PageAdress,ax
Adc Word Ptr PageNr,0
End;
DMALength:=Size;
Freq:=256-Trunc(1000000/Freq);
If Channel>3 then
Begin
DMALength:=DMALength div 2;
PageAdress:=PageAdress div 2;
If Odd(PageNr) then
Begin
Dec(PageNr);
PageAdress:=PageAdress+$8000
End;
End;
If id.Modus=2 then
Begin
If id.bit_sam=16
then Blaster_Command($A4)
Else Blaster_Command($A8);
End
Else
If id.bit_sam=16
then Blaster_Command($A4);
Dec(DMALength);
Port[DMA_dat[Channel,1]]:=$4 or (Channel and $3);
Port[DMA_dat[Channel,2]]:=$0;
Port[DMA_dat[Channel,3]]:=$49;
Port[DMA_dat[Channel,4]]:=lo(PageAdress);
Port[DMA_dat[Channel,4]]:=hi(PageAdress);
Port[DMA_dat[Channel,5]]:=lo(PageNr);
Port[DMA_dat[Channel,6]]:=lo(DMALength);
Port[DMA_dat[Channel,6]]:=hi(DMALength);
Port[DMA_dat[Channel,1]]:=(Channel and $3);
Blaster_Command($40);
Blaster_Command(Lo(Freq));
Blaster_Command($48);
Blaster_Command(lo(DMALength));
Blaster_Command(hi(DMALength));
Blaster_Command($91);
Inline($FB);
End;
Procedure Ausgabe_IRQ; Interrupt;
Var test : Byte;
Begin
Inline($FA);
Port[$20]:=$20;
test:=Port[sbb+$e];
Ende:=True;
Inline($fB);
End;
{$F-}
Procedure Play;
Var p,s,s2 : Word;
w : LongInt;
Begin
GetMem(zwi,16);
GetMem(dma_buf_1,dma);
p:=16;
While (Seg(dma_buf_1^[1]) mod 4096)>(4096-(dma*2 div 16)) do
Begin
FreeMem(dma_buf_1,dma);
FreeMem(zwi,p);
p:=p+16;
If p>65525 then halt(111);
GetMem(zwi,p);
GetMem(dma_buf_1,dma);
End;
GetMem(dma_buf_2,dma);
FreeMem(zwi,p);
port[$21]:=Port[$21] and (255 xor (1 shl Blaster.IRQ));
GetIntVec(Blaster.IRQ+8,Alt_irq);
SetIntVec(Blaster.IRQ+8,@Ausgabe_IRQ);
w:=id.freq*id.modus;
BlockRead(wav,dma_buf_1^[1],dma,s);
Repeat
Ende:=False;
Stelle_DMA(w,s);
BlockRead(wav,dma_buf_2^[1],dma,s2);
Repeat Until Ende;
s:=s2;
zwi:=dma_buf_1;
dma_buf_1:=dma_buf_2;
dma_buf_2:=zwi;
Until EoF(wav) or Keypressed;
While KeyPressed do w:=Ord(ReadKey);
If EoF(wav) then
Begin
Ende:=False;
Stelle_DMA(w,s);
Repeat Until Ende;
End;
SetintVec(Blaster.IRQ+8,Alt_IRQ);
FreeMem(dma_buf_1,dma);
FreeMem(dma_buf_2,dma);
Port[$21]:=Port[$21] or (1 shl Blaster.IRQ);
Blaster_Command($d3);
Close(wav);
End;
Begin
End.
|
Nieoficjalne ¼ród³o prób z kart± sound blaster
Poniewa¿ zainteresowanie d¼wiêkiem w turbo pascal'u jest na najwiêkszym poziomie, postanowi³em opublikowaæ swoje stare kody zwi±zane z muzyk±. Najprawdopodobniej nie zadzia³aj± od razu, bo wymagaj± pliku wave o okre¶lonej nazwie, ale mog± byæ cenn± pomoc±. W kodzie - jak resetowaæ kartê Sound blaster, - wczytywanie pliku wave
{$N+}
program muzyka;
Uses Dos;
Const Freq:Word=8000;
Type TTWav=^TWave;
TWave=array[1..$FFFF] of Byte;
Var
Dane, D2, D3:TTWav;
Porty:Array[1..5] of Word;
S:Array[1..8] of Longint;
t, FT:Byte;
Int1CSave:pointer;
S182:Word;
B1, OK:Boolean;
Procedure Podstaw(i:Byte);
Begin
Porty[1]:=$206+i shl 4;
Porty[2]:=$20A+i shl 4;
Porty[3]:=$20C+i shl 4;
Porty[4]:=$20C+i shl 4;
Porty[5]:=$20E+i shl 4;
End;
Function Zapisz_do_SB(b:Byte):Boolean;
Begin
{While (Port[Porty[3]] and 128=0) DO ;}
IF Port[Porty[3]] and 128=128 THEN
BEGIN
port[Porty[3]]:=B;
Zapisz_do_SB:=TRUE;
END
ELSE Zapisz_do_SB:=FALSE;
{ End Else
WriteLn('7 Bit portu 2xCh nie wyzerowany');}
End;
Function Odczyt_z_SB(Var b:Byte):Boolean;
Begin
{While (Port[Porty[5]] and 128=128) DO ;}
IF Port[Porty[5]] and 128=0 THEN
BEGIN
b:=port[Porty[2]];
Odczyt_z_SB:=TRUE;
END
Else Odczyt_z_SB:=FALSE;
End;
procedure RobFale(Fn, Fn2:String);
Var F:File;
a:word;
Begin
Assign(F, Fn);
reset(F, 1);
Seek(F, $2c);
Blockread(F, Dane^, $FFFF);
Close(F);
{Assign(F, Fn2);
reset(F, 1);
Seek(F, $2c);
Blockread(F, D2^, $FFFF);
Close(F);}
For a:=1 to $FFFF do
D3^[a]:=Dane^[a]{ Else D3^[a]:=D2^[Round(22/8*a)]};
End;
procedure Krok(B:Byte);
Begin
{ Case B Of
End;}
End;
procedure GrajNowe(VAR Buf; rozmiar:Word);
Var SCzas:Byte;
Adres, strona:Word;
Begin
Zapisz_do_SB($D0);
adres:=Seg(BUF) shl 4+Ofs(Buf);
strona:=(seg(Buf)+Ofs(Buf) shr 4) shr 12;
Port[$00A]:=5;
Port[$00B]:=$49;
port[$83]:=strona;
port[$00c]:=0;
port[$002]:=lo(adres);
port[$002]:=Hi(adres);
port[$00c]:=0;
port[$003]:=lo(rozmiar);
port[$003]:=Hi(rozmiar);
port[$00a]:=$01;
SCzas:=256-(1000000 div Freq);
Zapisz_do_SB($40);
Zapisz_do_SB(SCzas);
Zapisz_do_SB($14);
Zapisz_do_SB(lo(rozmiar));
Zapisz_do_SB(Hi(rozmiar));
End;
procedure WczytajFale(P:Pointer; Fn:String; rozmiar:Word);
Var F:File;
Size:Longint;
Begin
FT:=1;
Assign(F, Fn);
reset(F, 1);
Size:=FileSize(F);
{Blockread(F, D3^, $FFFF);
S[Ft]:=S[Ft]+$FFFF;}
If Size>$2c+S[FT]+rozmiar Then
Begin
Seek(F, $2c+S[FT]);
Blockread(F, P^, rozmiar);
End
Else
Begin
Seek(F, $2c+S[FT]);
rozmiar:=Size-($2c+S[FT]);
Blockread(F, P^, rozmiar);
End;
S[Ft]:=S[Ft]+rozmiar;
Close(F);
{Move(Dane^, D3^, rozmiar);}
End;
{$F+,S-,W-}
procedure Graj;interrupt;
Begin
B1:=NOT B1;
IF B1 THEN GrajNowe(Dane^, S182) ELSE GrajNowe(D3^, S182);
IF B1 THEN WczytajFale(D3, '35-2.wav', S182) ELSE
WczytajFale(Dane, '35-2.wav', S182)
End;
{$F-,S+}
Var T1, t2:Word;
rozmiar:word;
SP:Byte;
l:longint;
begin
New(Dane);
S[FT]:=0;
{New(D2);}
New(D3);
writeln('podaj nr portu (1)=210h (2)=220h..');
readln(t);
Podstaw(t);
Port[Porty[1]]:=1;
{Delay(5);}
for l:=1 to 1 shl 18 do t1:=t1*t2;
Port[Porty[1]]:=0;
for l:=1 to 1 shl 18 do t1:=t1*t2;
{Delay(5);}
T1:=Port[Porty[5]];
T2:=Port[Porty[2]];
If not ((T1 and 128=128) and (T2=$AA)) Then
WriteLn('Reset karty nie udal sie') Else
Begin
{GetMem(Dane, $FFFF);}
Zapisz_do_SB($D1);
Zapisz_do_SB($D0);
WriteLn('Reset karty pomyslnie');
S182:=Round(Freq/18.2);
rozmiar:=$FFFF;
{WczytajFale(D3, '35-2.wav', S182);}
GetIntVec($1C,Int1CSave);
SetIntVec($1C,Addr(Graj));
repeat
{If (Port[Porty[3]] And 128)<>128 Then
Begin
GrajNowe(rozmiar);
WczytajFale('MO.wav', rozmiar);
End;
If (SP=28) and (port[$60]=156) Then
Begin}
{WriteLn(port[8]);{
End;
Sp:=Port[$60];
WriteLn(Port[porty[1]], ' ',Port[porty[2]], ' ',Port[porty[3]], ' ',Port[porty[5]], ' ');}
until port[$60]=1;
{FreeMem(Dane, $FFFF);}
Dispose(Dane);
Dispose(D3);
{Dispose(D2);}
Zapisz_do_SB($D3);
SetIntVec($1C,Int1CSave);
End;
end. |
Muzyka z PC Speaker'a
Przyk³ad demonstruje odtwarzanie gamy d¼wiêków za pomoc± pascal'a. Tworzenie Gamy d¼wiêków, czêstotliwo¶ci nutW du¿ym przybli¿eniu: C = 538Hz, D=615Hz, (nagra³em widmo d¼wiêku C granego na flecie i zbada³em czêstotliwo¶æ najg³o¶niejszego tonu) E = D * D / C, F = E * D / C itd.. Ka¿dy d¼wiêk gamy ma w³asn± czêstotliwo¶æ, nastêpny jest po prostu kolejnym elementem ci±gu geometrycznego. Ten sam d¼wiêk wy¿szej oktawy ma dok³adnie dwukrotnie wy¿sz± czêstotliwo¶æ. D¼wiêków w oktawie jest 8. Jest 8 d¼wiêków granych normalnie, s± te¿ bemole i krzy¿yki. Ka¿dy kolejny d¼wiêk jest wy¿szy czêstotliwo¶ci± od poprzedniego o oko³o 71/65. Taki pomiar mo¿na uzyskaæ mierz±c 2 s±siednie progi gitary. Ich stosunek da nam ró¿nicê wysoko¶ci tonów. Za pierwszy d¼wiêk np. C mo¿na przyj±æ dowoln± czêstotliwo¶æ (tak jakby przestroiæ gitarê), ale lepiej przyj±æ standardow± warto¶æ, ok 538Hz A teraz w praktyce:
{$N+}
PROGRAM Organki;
USES Crt;
CONST MaxNut=20;
FirstK1 = 16;
FirstK2 = 2;
C = 538;
D = 615;
VAR
Temp : Single;
Temp2 : Single;
Temp3 : Single;
Tab:ARRAY [0..MaxNut] OF Word;
PROCEDURE Generate;
VAR i:Integer;
BEGIN
Temp:=D;
Temp2:=C;
FOR i:=0 TO MaxNut DO
BEGIN
Temp3:=Temp+(Temp-Temp2)*65/71;
Temp2:=Temp;Temp:=Temp3;
Tab[i]:=Round(Temp);
END;
END;
BEGIN
Generate;
REPEAT
Sound(Tab[PORT[$60]-FirstK1]);
IF KeyPressed THEN ReadKey;
IF PORT[$60]>127 THEN NoSound;
UNTIL PORT[$60]=1;
END.
|
