Ver. 1.0 Beta, Nie masz kompilatora? Teraz mo瞠sz pisa skrypty ONLINE! Wersja podstawowa -nie zawiera wszystkich polece Pascala. S逝篡 do nauki podstaw

Tworzenie muzyki w Turbo Pascalu, muzyka z karty muzycznej. Odtwarzanie Wave i MIDI

Pascal

Wsteczwstecz VESA, tworzenie szybkiej grafiki
W g鏎w g鏎 Zaawansowany kurs pascala
Dalejdalej Tworzenie gier w Turbo Pascalu

Tworzenie muzyki w Turbo Pascalu, muzyka z karty muzycznej. Odtwarzanie Wave i MIDI

O muzyce i d德i瘯ach


W tych artyku豉ch szczeg馧owo przedstawiono pr鏏y odtwarzania muzyki z karty muzycznej a tak瞠 z g這郾iczka wbudowanego w komputer (za pomoc instrukcji Sound).


Tre嗆 tworz g堯wnie kody 廝鏚這we, dlatego wymagana jest cho cz窷ciowa umiej皻no嗆 Pascala

Muzyka i d德i瘯 w Turbo Pascalu
Poni瞠j prezentacja modu逝 Wavplay -znajdziesz go w internecie jako FreeWare. Mo積a si na jego podstawie nauczy programowania kart d德i瘯owych.

Polecam ksi捫k: Programowanie gier 2D i 3D w j瞛yku Turbo Pascal


Ten modu zatrzymuje dzia豉nie programu podczas odtwarzania d德i瘯u, ale da si go przerobi by tak nie by這. Powodzenia...

Odtwarzanie plik闚 wave w pascalu


   W pascalu nie ma du篡ch problem闚 z odtworzeniem d德i瘯闚. Poni窺zy modu pozwala na odtworzenie wave'闚 8-bitowych, o cz瘰totliwo軼i pr鏏kowania do 11khz. 疾by nagra taki d德i瘯 najlepiej pos逝篡 si programem CoolEdit2000. W internecie powinna by jego darmowa wersja Shareware.
   Mo積a oczywi軼ie samemu programowo wytworzy fal, kt鏎 p騧niej odtworzy komputer.

Wykorzystanie modu逝


   Najpierw trzeba wywo豉 funkcj Init('nazwapliku.wav');
P騧niej tylko Play;
   Je郵i Twoja karta muzyczna spe軟ia standardy Sound Blastera powinienne us造sze d德i瘯.


{$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 廝鏚這 pr鏏 z kart sound blaster
Poniewa zainteresowanie d德i瘯iem w turbo pascal'u jest na najwi瘯szym poziomie, postanowi貫m opublikowa swoje stare kody zwi您ane z muzyk. Najprawdopodobniej nie zadzia豉j od razu, bo wymagaj pliku wave o okre郵onej 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豉d demonstruje odtwarzanie gamy d德i瘯闚 za pomoc pascal'a.


Tworzenie Gamy d德i瘯闚, cz瘰totliwo軼i nut


W du篡m przybli瞠niu: C = 538Hz, D=615Hz, (nagra貫m widmo d德i瘯u C granego na flecie i zbada貫m cz瘰totliwo嗆 najg這郾iejszego tonu) E = D * D / C, F = E * D / C itd..


Ka盥y d德i瘯 gamy ma w豉sn cz瘰totliwo嗆, nast瘼ny jest po prostu kolejnym elementem ci庵u geometrycznego. Ten sam d德i瘯 wy窺zej oktawy ma dok豉dnie dwukrotnie wy窺z cz瘰totliwo嗆. D德i瘯闚 w oktawie jest 8. Jest 8 d德i瘯闚 granych normalnie, s te bemole i krzy篡ki. Ka盥y kolejny d德i瘯 jest wy窺zy cz瘰totliwo軼i od poprzedniego o oko這 71/65. Taki pomiar mo積a uzyska mierz帷 2 s御iednie progi gitary. Ich stosunek da nam r騜nic wysoko軼i ton闚. Za pierwszy d德i瘯 np. C mo積a przyj望 dowoln cz瘰totliwo嗆 (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.

Programy ON-LINE!

Strona korzysta z plik闚 cookie w celu 鈍iadczenia us逝g Google (reklamy, statytyki) oraz Facebook. Je郵i chcesz zablokowa pliki cookies wy豉cz je w swojej przegl康arce. Potrzebujesz pomocy? kliknij