home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / sound.swg / 0060_SB-Adlib FM Synth Code.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-03-26  |  8.9 KB  |  368 lines
  1. {
  2.  
  3. > Is there a way to play WAV files with TP7.0 for DOS (on SB) ?
  4.  
  5. I once posted my routine in the german PASCALecho.
  6.  
  7. Sblast... UNIT for digital Soundeffects in games by DMA and a complete test
  8. of the SB-configs by Dirk Hoeschen (_aptain |-|eadcrash
  9. }
  10.  
  11. UNIT SBlast;
  12.  
  13. interface
  14. Uses Crt,Dos;
  15.  
  16. Const
  17.    DMA_ADDX_REG  = $02;
  18.    DMA_COUNT_REG = $03;
  19.    DMA_MASK_REG  = $0A;
  20.    DMA_MODE_REG  = $0B;
  21.    DMA_FF_REG    = $0C;
  22.    DMA_PAGE_REG  = $83;
  23.    DMA_Mode      = $49;
  24.    DMA_BufSize   = $1000-1;
  25.    DMA_activ : Boolean=false;
  26.    SbregDetected : Boolean = false;
  27.    psound : Boolean = true;
  28.    dsp_adr : word =$0;
  29.    dsp_irq : byte =$0;
  30.    DMA_CH  : byte =$1; {don't change it if you'r not shure}
  31.  
  32.  function  Detect_Reg_Sb : Boolean;
  33.  { Find Sbadress! Adresse nachher in dsp_adr.
  34.    false if no SBcard availiable}
  35.  
  36.  function  Reset_Sb : Boolean;
  37.  
  38.  Function  GetDSPversion: String;
  39.  { Get Versionsnummer the Yamaha OPL}
  40.  
  41.  Procedure Find_DSP_Irq(Mode: Byte; VAR irq : byte);
  42.  { If IRQ=0 then no interrupt was found.
  43.    if Mode=1 FIND_IRQ only tests the Interrupt in IRQ}
  44.  
  45.  function  wr_dsp_adr : String; {writes the address on the screen}
  46.  
  47.  procedure wr_dsp(v : byte);
  48.  function  Sbreadbyte : byte;
  49.  procedure Sb_Befehl110h(v : byte);
  50.  
  51.  procedure Set_frequence(freq : Word);
  52.  
  53.  Procedure Lautsprecher_Ein;
  54.  Procedure Lautsprecher_Aus;
  55.  
  56.  procedure Play_DMA(count : Word);
  57.  Procedure Play_Wave(fname : pathstr);
  58.  
  59.  Procedure Stop_DMA;
  60.  Procedure Continue_DMA;
  61.  Procedure Stop_Playing;
  62.  
  63. implementation
  64. Type
  65.     Page = Array [0..64000] of byte;
  66.     Page_point = ^Page;
  67.     Wave_head = ReCord
  68.          TypeID : Longint; {normally Riff}
  69.          Length : Longint; {Length of file }
  70.          WaveID : Array[0..3] of byte;{WAVE}
  71.          fmtID  : Array[0..3] of byte;{fmt}
  72.          CHlength : Longint;{Laenge des Chunks}
  73.          Wformat : Word;{0=Left /1=Right /2 Stereo}
  74.          Wchannels: Word;{# of channels 2=Stereo}
  75.          Wrate : Longint;{frequence}
  76.          Wbps  : Longint;{Bits per second}
  77.          BytespSample : Word;
  78.          BitspSample : Word;
  79.          DataID : Array[0..3] of byte;{Data}
  80.          Filler : Longint;
  81.     end;
  82.  
  83. Var
  84.    Tbuf, SbintSave : Pointer;
  85.    Soundbuf : Page_point;
  86.    Rem_size : Word;
  87.    ppage, pofs :Word;
  88.    frate : Word;
  89.    IRQ_found: Boolean;
  90.  
  91. function Reset_Sb : Boolean;
  92. const ready = $AA;
  93. var ct,Stat : byte;
  94. BEGIN
  95.   port[dsp_adr+$6]:=1;
  96.   delay(100);
  97.   port[dsp_adr+$6]:=0;
  98.   stat:=0;
  99.   ct  :=0;
  100.   while (stat <> ready) and (Ct< 100) do begin
  101.    Stat:=port[dsp_adr+$E];
  102.    Stat:=port[dsp_adr+$A];
  103.    Inc(ct);
  104.   end;
  105.   Reset_Sb := (Stat = ready);
  106. END;
  107.  
  108. function wr_dsp_adr : String;
  109. BEGIN
  110.   case dsp_adr of
  111.     $210 : wr_dsp_adr := '210 Hex';
  112.     $220 : wr_dsp_adr := '220 Hex';
  113.     $230 : wr_dsp_adr := '230 Hex';
  114.     $240 : wr_dsp_adr := '240 Hex';
  115.     $250 : wr_dsp_adr := '250 Hex';
  116.     $260 : wr_dsp_adr := '260 Hex';
  117.     $270 : wr_dsp_adr := '270 Hex';
  118.     $280 : wr_dsp_adr := '280 Hex';
  119.   end;
  120. END;
  121.  
  122. function Detect_Reg_Sb : Boolean;
  123. var Port, Lst : Word;
  124. BEGIN
  125.   Detect_Reg_Sb := SBRegDetected;
  126.   Port := $210;
  127.   Lst := $280;
  128.   while (not SBRegDetected) and (Port <= Lst) do begin
  129.     Dsp_adr:=Port;
  130.     SbRegDetected:= Reset_Sb;
  131.     if not SBRegDetected then inc(Port,$10);
  132.   end;
  133.   Detect_Reg_Sb := SBRegDetected;
  134. END;
  135.  
  136. procedure wr_dsp(v : byte);
  137. BEGIN
  138.   While port[dsp_adr+$c] >= 128 do;
  139.   port[dsp_adr+$c] := v;
  140. END;
  141.  
  142. function SbReadByte: Byte;
  143. BEGIN
  144.   While port[dsp_adr+$a] = $AA do;
  145.   SbReadByte := port[dsp_adr+$a];
  146. END;
  147.  
  148. procedure Sb_Befehl110h(v : byte);
  149. BEGIN
  150.   wr_dsp($10);
  151.   wr_dsp(v);
  152. END;
  153.  
  154. procedure Set_frequence(freq : Word);
  155. var tc: byte;
  156. BEGIN
  157.   tc := trunc(256-(1000000/freq));
  158.   {Die samplefrequenz berechnet sich aus
  159.    256-10000000/Hz}
  160.   wr_dsp($40); {40h set frequence}
  161.   wr_dsp(tc);
  162. END;
  163.  
  164. Procedure Lautsprecher_Ein;
  165. BEGIN  wr_dsp($D1); END;
  166.  
  167. Procedure Lautsprecher_Aus;
  168. BEGIN  wr_dsp($D3); END;
  169.  
  170. Procedure Stop_DMA;
  171. BEGIN  wr_dsp($D0); END;
  172.  
  173. Procedure Continue_DMA;
  174. BEGIN  wr_dsp($D4); END;
  175.  
  176. Function GetDSPversion: String;
  177. var s : String[2];
  178.     SbVersMaj : byte;
  179.     SbVersMin : byte;
  180.     SbVersStr : String[5];
  181. BEGIN
  182.   GetDSPVersion:=';-)';
  183.   wr_dsp($E1);
  184.   SbVersMaj := SbreadByte;
  185.   SbVersMin := SbreadByte;
  186.   Str(SbversMaj , SbVersStr);
  187.   SbVersStr:= SbVersStr + '.';
  188.   Str(SbversMin , s);
  189.   If Sbversmin > 9 then
  190.     SbVersStr:= SbVersStr + s
  191.   else
  192.     SbVersStr:= SbVersStr + '0' + s;
  193.   GetDSPVersion:=SBversStr;
  194. END;
  195.  
  196. Procedure Start_DMA_transfer(len : word);
  197. { Wie gesagt, hier wird der DMA-controller initialisiert
  198.   und der Befehl $14=Play 8Bit uncompressed via DMA an
  199.   die SB-karte gesendet. Sobald die laenge und die Adresse
  200.   uebergeben ist, startet der Transfer. }
  201. type pt = record
  202.        ofs, sgm : Word;
  203.     end;
  204. var L : Longint;
  205.     pn, ofs :Word;
  206.     dummy: byte;
  207. BEGIN
  208.    dummy:=Port[DSP_adr+$0E];
  209.    l := 16*longint(ppage)+pofs;
  210.    pn := Pt(l).sgm; {Man beachte die Berechnung der Page}
  211.    ofs := Pt(l).ofs;
  212.    Port[DMA_MAsk_Reg]:=DMA_CH+4;
  213.    Port[DMA_FF_Reg]:=0;
  214.    Port[DMA_Mode_Reg]:=Dma_Mode;
  215.    Port[DMA_ADDX_Reg]:=Lo(ofs);
  216.    Port[DMA_ADDX_Reg]:=hi(ofs);
  217.    Port[DMA_PAGE_Reg]:=pn;
  218.    Port[DMA_COUNT_Reg]:=Lo(len);
  219.    Port[DMA_COUNT_Reg]:=hi(len);
  220.    Port[DMA_MAsk_Reg]:=DMA_CH; {DMA 1 freigeben};
  221.    wr_dsp($14);
  222.    wr_dsp(Lo(len));
  223.    wr_dsp(hi(len));
  224. END;
  225.  
  226. Procedure Stop_Playing;
  227. begin
  228.  if psound then begin
  229.    Stop_DMA;
  230.    Port[DMA_MAsk_Reg]:=DMA_CH+4;
  231.    Port[$21]:=Port[$21] or (1 shl DSP_Irq);
  232.    Port[$20]:=$20;
  233.    SetIntVec($8+ DSP_Irq,SBIntSave);
  234.  end;
  235. end;
  236.  
  237. Procedure DummySBint ; Interrupt;
  238. Begin
  239.    IRQ_found:=True;
  240. end;
  241.  
  242. Procedure Find_DSP_Irq(Mode: Byte; VAR irq : byte);
  243. const possible_IRQs : Array[1..5] Of Byte = ($7,$5,$2,$3,$10); { Das System
  244. dieser Routine ist einfach, aber auch nicht ganz  ungefaerlich. DummySBint wird
  245. nacheinander in die moeglichen  Soundblasterinterrupts eingeklinkt. Dannach ein
  246. kurzer DMA-  transfer gestartet. Wenn der IRQ stimmt, dann setzt der dummy
  247.   interrupt ein flag.}
  248. var c : byte;
  249. BEGIN
  250.   getmem(tbuf,100);
  251.   Ppage:=seg(tBuf^);
  252.   Pofs:=Ofs(tBuf^);
  253.   Lautsprecher_Aus;
  254.   Set_Frequence(1000);
  255.   IRQ_found:=false;
  256.   If mode=1 then Begin
  257.       GetIntVec($8+Irq,SBIntSave);
  258.       SetIntVec($8+IRQ,@DummySBInt);
  259.       Port[$21]:=Port[$21] and not (1 shl IRQ);
  260.       wr_dsp($D0);
  261.       Start_DMA_transfer(20);
  262.       Delay(200);
  263.       Stop_Playing;
  264.       Port[$21]:=Port[$21] or (1 shl IRQ);
  265.       Port[$20]:=$20;
  266.       SetIntVec($8+Irq,SBIntSave);
  267.   end else begin
  268.     c:=1;
  269.     Repeat
  270.       IRQ:=Possible_IRQs[c];
  271.       GetIntVec($8+Irq,SBIntSave);
  272.       SetIntVec($8+IRQ,@DummySBInt);
  273.       Port[$21]:=Port[$21] and not (1 shl IRQ);
  274.       wr_dsp($D0);
  275.       Start_DMA_transfer(20);
  276.       Delay(200);
  277.       Inc(c);
  278.       Stop_Playing;
  279.       Port[$21]:=Port[$21] or (1 shl IRQ);
  280.       Port[$20]:=$20;
  281.       SetIntVec($8+Irq,SBIntSave);
  282.     Until (IRQ_found) or (c=6);
  283.   end;
  284.   If not IRQ_found then IRQ:=0;
  285.   Lautsprecher_Ein;
  286.   freemem(tbuf,100);
  287. END;
  288.  
  289. Procedure SBint ; Interrupt;
  290. { Diese procedure wird in den SB-interrupt eingeklinkt und
  291.   angesprungen, wenn der DMA-Block vollstaendig ausgegeben
  292.   wurde}
  293. Begin
  294.   If Rem_Size<50 then begin
  295.      DMA_ACtiv:=False  {End of dma_transfer}
  296.      Dispose(Soundbuff);
  297.   end else If Rem_size<= DMA_bufsize then begin
  298.      Pofs:=Pofs+DMA_Bufsize;
  299.      Start_DMA_transfer(Rem_size);
  300.      Rem_Size:=0;     {nix mehr uebrig}
  301.     end else begin
  302.      Pofs:=Pofs+DMA_Bufsize;
  303.      Start_DMA_transfer(DMA_bufsize);
  304.      Rem_Size:=Rem_Size-DMA_bufsize;
  305.    end;
  306.    Port[$20]:=$20;
  307. end;
  308.  
  309. procedure Play_DMA(count : Word);
  310. var
  311.     L : Longint;
  312.     hbyte : byte;
  313.     a : word;
  314.     Oldv, Newv, Hilfe :byte;
  315. Begin
  316.    Ppage:=Seg(Soundbuff^);
  317.    Pofs:=Ofs(Soundbuff^);
  318.    a:=Count;
  319.    If a<= DMA_bufsize then begin
  320.       Rem_Size:=0;
  321.    end else begin
  322.       Rem_Size:=a-DMA_bufsize;
  323.       a:=DMA_bufsize;
  324.    end;
  325.    Lautsprecher_Ein;
  326.    Set_Frequence(Frate);
  327.    GetIntVec($8+DSP_Irq,SBIntSave);
  328.    SetIntVec($8+DSP_Irq,@SBInt);
  329.    Port[$21]:=Port[$21] and not (1 shl DSP_Irq);
  330.    wr_dsp($D0);
  331.    Start_DMA_TRANSFER(a);
  332.    DMA_activ:=True;
  333. end;
  334.  
  335. Procedure Play_Wave(fname :Pathstr);
  336. Var
  337.    size : LongInt;
  338.    IdStr : String[4];
  339.    Header : Wave_Head;
  340.    F : File;
  341. begin
  342.   if psound then begin
  343.    size := 0;
  344.    Assign(f,Fname);
  345.    reset(f,1);
  346.    With Header do begin
  347.     blockread(f,Header,sizeOf(Header));
  348.     IdStr:=chr(WaveID[0])+chr(WaveID[1])+chr(WaveID[2])+chr(WaveID[3]);
  349.     if IdStr = 'WAVE' then begin
  350.      size := Length-Sizeof(header);
  351.      If size>50 then begin
  352.         frate:=Wrate;
  353.         New(Soundbuff);
  354.         blockread(f,Soundbuff^,size);
  355. {Soundbuff^ is an ARRAY to buffer the WAVe. I know, that the
  356.  unit is very dirty here, but its only do demonstrate how
  357.  it works.}
  358.         Play_DMA(size);
  359.      end;
  360.     end;
  361.    end;
  362.    close(f);
  363.   end;
  364. end;
  365.  
  366. BEGIN;
  367. END.
  368.