home *** CD-ROM | disk | FTP | other *** search
/ PC Interdit / pc-interdit.iso / sound / voc / vocplay.pas < prev    next >
Pascal/Delphi Source File  |  1994-10-30  |  27KB  |  914 lines
  1. unit vocplay;
  2.  
  3. interface uses crt,dos;
  4.  
  5. TYPE vocheader = record
  6.        Ident : array[0..19] of char;
  7.        Sampoff : word;
  8.        Verslo  : Byte;
  9.        Vershi  : Byte;
  10.        Ident_code : word;
  11.      end;
  12.  
  13.      Voiceblock = record
  14.        Ident_code  : byte;
  15.        Long_lo : word;
  16.        Long_hi : byte;
  17.        SR       : byte;
  18.        Pack     : byte;
  19.      end;
  20.  
  21. const
  22.   { Soundblaster - Constantes }
  23.   Startport          : word = $200;
  24.   Endport            : word = $280;
  25.   force_irq          : boolean = false;
  26.   force_dma          : boolean = false;
  27.   force_base         : boolean = false;
  28.   dsp_irq            : byte = $5;        { Interruption de la SB,}
  29.                                         {modification de la valeur}
  30.                                         { par la routine INIT    }
  31.   dma_ch             : byte = 1;         { Canal DMA, standard  }
  32.                                         { = 1, sur SB 16 ASP ; autres}
  33.                                         { valeurs nécessaires ...     }
  34.   dsp_adr            : word = $220;      { Adresse de base  des DSP.   }
  35.                                         { La routine init  }
  36.                                         { change la valeur   }
  37.   SbVersMin          : BYTE = 0;         { Identification de la version }
  38.   SbVersMaj          : BYTE = 0;
  39.   STEREO             : BOOLEAN = false;  { En Stereo ?     }
  40.   SbRegDetected      : BOOLEAN = FALSE;  { SB normale installée ?     }
  41.   IRQDetected        : BOOLEAN = FALSE;
  42.   SbRegInited        : BOOLEAN = FALSE;
  43.   SbProDetected      : BOOLEAN = FALSE;  { SB Pro installée ?         }
  44.   SbProInited        : BOOLEAN = FALSE;
  45.   Sb16Detected       : BOOLEAN = FALSE;  { SB 16 ASP installée ?      }
  46.   Sb16Inited         : BOOLEAN = FALSE;
  47.   MixerDetected      : BOOLEAN = FALSE;  { Sinon, utilisez la carte >= SB Pro   }
  48.  
  49.   { Voc - Constantes }
  50.   bloc_actif        : byte = 1;
  51.  
  52.  
  53.   { Soundblaster - Variables }
  54. var dsp_rdy_voc      : boolean;
  55.     T_Bloc           : word;
  56.     Transfer_Testing : boolean;
  57.     SaveExitProc     : Pointer;             { Nécessaire, Exitproc intégré  }
  58.  
  59. var lastone          : boolean;
  60.     VOC_READY        : boolean;
  61.     inread           : array[1..25] of byte;
  62.     vocsstereo       : boolean;
  63.     vocf             : file;
  64.     fgr              : longint;
  65.     blk1,blk2        : pointer;
  66.     voch             : vocheader;
  67.     vblock           : voiceblock;
  68.  
  69.  
  70. procedure voc_done;
  71.  
  72. procedure Init_Voc(filename : string);
  73.  
  74. FUNCTION Detect_Mixer_sb16 : BOOLEAN;
  75.  
  76. procedure Jouer_Block_Dsp(gr : word;bk : pointer;b1,b2 : boolean);
  77.  
  78. procedure write_sbConfig;
  79.  
  80. function Init_SB : boolean;
  81.  
  82. implementation
  83.  
  84. TYPE
  85.   pt = record                           { permet, d'une façon très simple, }
  86.     ofs,sgm  :  word;                   { la prise en charge de pointeurs  }
  87.   end;
  88.  
  89. CONST
  90.   filter_activ       : boolean = false;
  91.   balance            : byte = 12;
  92.   Mastervolume       : byte = 29;
  93.   Samfreq            : word = 22;
  94.   PC    = 0;
  95.   AMIGA = 1;
  96.   interrupt_trouve : boolean = false;
  97.   interrupt_check    : boolean = false;
  98.   timer_per_second   : word = 1000;      { Nombre d'interrupts par séc. }
  99.   Sampling_frequence  : word = 10000;     { Valeur par déf.: La fréquence de : Sampling}
  100.   dma_page           : array[0..3] of byte = ($87,$83,$81,$81);
  101.   dma_adr            : array[0..3] of byte = (0,2,4,6);
  102.   dma_wc             : array[0..3] of byte = (1,3,5,7);
  103.  
  104.   sb16_outputLong  : word = 0;
  105.   Dern_sortie     : boolean = false;
  106.  
  107. VAR
  108.  TailleBloc        : word;            { Taille des Sound-Puffers    }
  109.  dsp_rdy_sb16        : boolean;         { Flag pour terminer la trans-}
  110.                                         { mission de données via DMA  }
  111.  SbVersStr           : string[5];       { la version-SB comme String  }
  112.  oldInt              : pointer;         { pour une sauvegarde de      }
  113.                                         { l'interrupt dont à besoin le}
  114.                                         { SB pour le transfert de la DMA}
  115.  irqmsk              : byte;            { prise en charge d'Interrupt }
  116.  blk                 : pointer;         { Pointeur sur le tampon de données }
  117.  Sampling_Rate       : byte;            { la valeur de la fréquence }
  118.                                         { passée à la DSP         }
  119.  intback             : pointer;
  120.  port21              : byte;
  121.  
  122.  
  123. {
  124. ***********************************************************************
  125.                         PROCEDURES - SOUND BLASTER
  126. ***********************************************************************
  127. }
  128.  
  129. procedure Wr_dsp(v : byte);
  130. {
  131.  Attend jusqu'à ce que la DSP soit prête à l'écriture, et écrit alors
  132.  dans la DSP l'octet transmis dans "v"
  133. }
  134. begin;
  135.   while port[dsp_adr+$c] >= 128 do ;
  136.   port[dsp_adr+$c] := v;
  137. end;
  138.  
  139. FUNCTION SbReadByte : BYTE;
  140. {
  141.  La fonction attend, jusqu'à ce que la DSP puisse être lue et
  142.  retourne alors la valeur lue.
  143. }
  144. begin;
  145.   while port[dsp_adr+$a] = $AA do ;     { attend que DSP soit prête }
  146.   SbReadByte := port[dsp_adr+$a];       { lit une valeur }
  147. end;
  148.  
  149. procedure SBreset;
  150. VAR bt,ct, stat : BYTE;
  151. begin;
  152.   PORT[dsp_adr+$6] := 1;                { dsp_adr+$6 = Resettfunktion}
  153.   FOR ct := 1 TO 100 DO;
  154.   PORT[dsp_adr+$6] := 0;
  155.   bt := 0;
  156.   repeat
  157.     ct := 0;
  158.     repeat
  159.       stat := port[dsp_adr + $E];
  160.     until (ct > 8000) or (stat >= 128);
  161.     inc(bt);
  162.   until (bt > 100) or (port[dsp_adr + $A] = $AA);
  163. end;
  164.  
  165.  
  166.  
  167. FUNCTION Reset_SBCard : BOOLEAN;
  168. {
  169.  La fonction effectue un reset du DSP. Si le reset réussit,
  170.  elle retourne TRUE, sinon FALSE
  171. }
  172. CONST  ready = $AA;
  173. VAR ct, stat : BYTE;
  174. BEGIN
  175.   PORT[dsp_adr+$6] := 1;                { dsp_adr+$6 = fonction de reset }
  176.   FOR ct := 1 TO 100 DO;
  177.   PORT[dsp_adr+$6] := 0;
  178.   stat := 0;
  179.   ct   := 0;                            { Comparaison  ct < 100, car }
  180.   WHILE (stat <> ready)                 { l'initialisation dure    }
  181.   AND   (ct < 100)      DO BEGIN        { environ 100ms             }
  182.     stat := PORT[dsp_adr+$E];
  183.     stat := PORT[dsp_adr+$a];
  184.     INC(ct);
  185.   END;
  186.   Reset_SBCard := (stat = ready);
  187. END;
  188.  
  189.  
  190. FUNCTION Detect_SBReg : BOOLEAN;
  191. {
  192.  La fonction retourne TRUE, quand une carte Soundblaster a pu  être
  193.  initialisée, sinon FALSE. La variable dsp_adr reçoit
  194.  l'adresse de base de la SB.
  195. }
  196. VAR
  197.   Port, Lst : WORD;
  198. BEGIN
  199.  Detect_SBReg := SbRegDetected;
  200.  IF SbRegDetected THEN EXIT;            { Exit, lorsque l'initialisation est faite }
  201.  Port := Startport;                     { Adresse SB possibles }
  202.  Lst  := Endport;                       { entre $210 et $280 !      }
  203.  WHILE (NOT SbRegDetected)
  204.  AND   (Port <= Lst)  DO BEGIN
  205.    dsp_adr := Port;
  206.    SbRegDetected := Reset_SBCard;
  207.    IF NOT SbRegDetected THEN
  208.      INC(Port, $10);
  209.  END;
  210.  Detect_SBReg := SbRegDetected;
  211. END;
  212.  
  213. PROCEDURE SbGetDSPVersion;
  214. {
  215.  Fournit le numéro de version de la DSP et le dépose dans les variables
  216.  globales SBVERSMAJ et SBVERSMIN, ainsi que SBVERSSTR.
  217. }
  218. VAR i : WORD;
  219.     t : WORD;
  220.     s : STRING[2];
  221. BEGIN
  222.   Wr_dsp($E1);                     { $E1 = interroge le numéro de version }
  223.   SbVersMaj := SbReadByte;
  224.   SbVersMin := SbReadByte;
  225.   str(SbVersMaj, SbVersStr);
  226.   SbVersStr := SbVersStr + '.';
  227.   str(SbVersMin, s);
  228.   if SbVersMin > 9 then
  229.     SbVersStr := SbVersStr +       s
  230.   else
  231.     SbVersStr := SbVersStr + '0' + s;
  232. END;
  233.  
  234. function wrt_dsp_adr_sb16 : string;
  235. {
  236.  Renvoie l'adresse de Base comme String
  237. }
  238. begin;
  239.   case dsp_adr of
  240.     $210 : wrt_dsp_adr_sb16 := '210';
  241.     $220 : wrt_dsp_adr_sb16 := '220';
  242.     $230 : wrt_dsp_adr_sb16 := '230';
  243.     $240 : wrt_dsp_adr_sb16 := '240';
  244.     $250 : wrt_dsp_adr_sb16 := '250';
  245.     $260 : wrt_dsp_adr_sb16 := '260';
  246.     $270 : wrt_dsp_adr_sb16 := '270';
  247.     $270 : wrt_dsp_adr_sb16 := '280';
  248.    END;
  249. end;
  250.  
  251. function wrt_dsp_irq : string;
  252. {
  253.  Renvoie l'IRQ de la SB comme String
  254. }
  255. begin;
  256.   case dsp_irq of
  257.      $2 : wrt_dsp_irq := '2 h';
  258.      $3 : wrt_dsp_irq := '3 h';
  259.      $5 : wrt_dsp_irq := '5 h';
  260.      $7 : wrt_dsp_irq := '7 h';
  261.     $10 : wrt_dsp_irq := '10 h';
  262.    END;
  263. end;
  264.  
  265. procedure Set_Timeconst_sb16(tc : byte);
  266. {
  267.  Procedure utilisée pour définir la constante Time. Le calcule s'effectue
  268.  selon la formule  tc := 256 - (1000000 / frequence).
  269. }
  270. begin;
  271.   Wr_dsp($40);                     { $40 = Définition de la Sample Rate    }
  272.   Wr_dsp(tc);
  273. end;
  274.  
  275. procedure test_Transmission;
  276. begin;
  277.    getmem(blk,3000);
  278.    fillchar(blk^,3000,127);
  279.    TailleBloc := 2000;
  280.    Dern_sortie := true;
  281.    Sampling_Rate := 211;
  282.    Jouer_Block_Dsp(TailleBloc,blk,true,false);
  283.    delay(100);
  284.    freemem(blk,3000);
  285. end;
  286.  
  287. procedure write_sbConfig;
  288. {
  289.  La procédure imprime la configuration qu'elle a rencontré sur l'écran.
  290.  Elle est d'abord un exemple comment on peut utiliser une information.
  291. }
  292. begin;
  293.   clrscr;
  294.   if SbRegDetected then begin;
  295.     writeln('Carte son ',wrt_dsp_adr_sb16,'h avec IRQ ',
  296.     wrt_dsp_irq,' trouvé.');
  297.   end else begin;
  298.     writeln('Aucune carte son compatible SoundBlaster détectée !');
  299.   end;
  300.   if MixerDetected then begin;
  301.     writeln('Mixer - Chip trouvé');
  302.     if SbVersMaj < 4 then
  303.       writeln('La carte détectée est',
  304.             ' une Soundblaster Pro ou compatible')
  305.     else
  306.       writeln('La carte détectée est une',
  307.       ' Soundblaster 16 ASP ou compatible');
  308.   end else begin;
  309.     writeln('La carte détectée est une',
  310.     ' Soundblaster ou compatible');
  311.   end;
  312.   writeln('Le numéro de la version : ',SbVersStr);
  313. end;
  314.  
  315. procedure Exit_Sb16;
  316. {
  317.  Cette procédure se fait appeller lorsque vous quittez le programme
  318.  et ramène l'interruption masqué de la DMA à sa valeur intiale.
  319. }
  320. begin;
  321.   setintvec($8+dsp_irq,oldint);         { Rétablir l'ancienne interruption}
  322.   port[$21] := Port[$21] or irqmsk;     { et ramène la masque }
  323.   port[dsp_adr+$c] := $d3;              { à son ancienne valeur    }
  324.   Port[$20] := $20;
  325.   Wr_dsp($D0);
  326. end;
  327.  
  328. procedure Jouer_Sb16(Segm,Offs,dsize : word);
  329. {
  330.  Cette procédure fait jouer le bloc de la taille dsize adressé par
  331.  Segm:Offs. Il faut faire attention, que le contrôleur DMA
  332.  NE PEUT PAS être efficace au-delà d'une page ...
  333. }
  334. var li : word;
  335. begin;
  336.   port[$0A] := dma_ch+4;                { fermer canal DMA         }
  337.   Port[$0c] := 0;                       { Adresse du tampon (blk)  }
  338.   Port[$0B] := $49;                     { pour la  sortie son      }
  339.   Port[dma_adr[dma_ch]] := Lo(offs);    { pour le contrôleur DMA  }
  340.   Port[dma_adr[dma_ch]] := Hi(offs);
  341.   Port[dma_wc[dma_ch]] := Lo(dsize-1);  { Taille d'un bloc   }
  342.   Port[dma_wc[dma_ch]] := Hi(dsize-1);  { vers le contrôleur DMA}
  343.   Port[dma_page[dma_ch]] := Segm;
  344.   if sb16_outputLong <> dsize then begin;
  345.     Wr_dsp($C6);                   { Commande DSP de 8-Bit sur DMA  }
  346.     if stereo then                      { pour le démarrage de SB16 ! }
  347.       Wr_dsp($20)
  348.     else
  349.       Wr_dsp($00);
  350.     Wr_dsp(Lo(dsize-1));           { Taille du bloc       }
  351.     Wr_dsp(Hi(dsize-1));           { vers la DSP                    }
  352.     sb16_outputLong := dsize;
  353.   end else begin;
  354.     Wr_dsp($45);                   { DMA continue SB16 8-Bit    }
  355.   end;
  356.   Port[$0A] := dma_ch;                  { libérer canal DMA  }
  357. end;
  358.  
  359. procedure Jouer_SbPro(Segm,Offs,dsize : word);
  360. {
  361.  Cette procédure fait jouer le bloc de la taille dsize adressé par
  362.  Segm:Offs. Il faut faire attention, que le contrôleur DMA
  363.  NE PEUT PAS être efficace au-delà d'une page ...
  364.  
  365. }
  366. var li : word;
  367. begin;
  368.   port[$0A] := dma_ch+4;                { fermer canal DMA           }
  369.   Port[$0c] := 0;                       { Adresse du tampon   (blk)  }
  370.   Port[$0B] := $49;                     { pour l'émission du son     }
  371.   Port[dma_adr[dma_ch]] := Lo(offs);    { vers le DMA-Controller          }
  372.   Port[dma_adr[dma_ch]] := Hi(offs);
  373.   Port[dma_wc[dma_ch]] := Lo(dsize-1);  { Taille du bloc (block-  }
  374.   Port[dma_wc[dma_ch]] := Hi(dsize-1);  { groesse) vers le contrôleur DMA }
  375.   Port[dma_page[dma_ch]] := Segm;
  376.  
  377.   Wr_dsp($48);
  378.   Wr_dsp(Lo(dsize-1));             { Taille du bloc vers      }
  379.   Wr_dsp(Hi(dsize-1));             { la  DSP                    }
  380.   Wr_dsp($91);
  381.   Port[$0A] := dma_ch;                  { libérer canal DMA       }
  382. end;
  383.  
  384. procedure Jouer_Sb(Segm,Offs,dsize : word);
  385. {
  386.  Cette procédure exécute le bloc adressé par Segm:Offs
  387.  de taille dsize. Il faut noter que le contrôleur DMA ne peut PAS
  388.  travailler en accédant aux pages...
  389. }
  390. var li : word;
  391. begin;
  392.   port[$0A] := dma_ch+4;                { Bloque le canal DMA }
  393.   Port[$0c] := 0;                       { Adresse du tampon (blk)  }
  394.   Port[$0B] := $48+dma_ch;              { Pour la sortie du son }
  395.   Port[dma_adr[dma_ch]] := Lo(offs);    { au DMA-Controller }
  396.   Port[dma_adr[dma_ch]] := Hi(offs);
  397.   Port[dma_wc[dma_ch]] := Lo(dsize-1);  { Taille du bloc }
  398.   Port[dma_wc[dma_ch]] := Hi(dsize-1);  { au DMA-Controller }
  399.   Port[dma_page[dma_ch]] := Segm;
  400.   Wr_dsp($14);
  401.   Wr_dsp(Lo(dsize-1));                  { Taille du bloc }
  402.   Wr_dsp(Hi(dsize-1));                  { à la DSP }
  403.   Port[$0A] := dma_ch;                  { Libère le canal DMA }
  404. end;
  405.  
  406. procedure Jouer_Block_Dsp(gr : word;bk : pointer;b1,b2 : boolean);
  407. {
  408.  La procédure démarre la sortie du bloc de données blk de la taille
  409.  TailleBloc via DMA
  410. }
  411. var l : longint;
  412.     pn,offs : word;
  413.     hbyte : byte;
  414.     a : word;
  415.     OldV,NewV,Aide : byte;
  416.     stereoreg : byte;
  417.     sr : word;
  418.     samps : byte;
  419. begin;
  420.   Transfer_Testing := b1;
  421.  
  422.   dsp_rdy_sb16 := false;
  423.   l := 16*longint(pt(bk).sgm)+pt(bk).ofs;
  424.   pn := pt(l).sgm;
  425.   offs := pt(l).ofs;
  426.  
  427.   if Transfer_Testing then begin;
  428.     set_timeconst_sb16(Sampling_Rate);
  429.     if sb16Detected then begin;
  430.       if stereo then
  431.         Jouer_Sb16(pn,offs,gr*2)
  432.       else
  433.         Jouer_Sb16(pn,offs,gr);
  434.     end else begin;
  435.       if stereo then begin;
  436.         SR := word(-1000000 DIV (Sampling_Rate-256));
  437.         SR := SR * 2;
  438.         Samps := 256 - (1000000 DIV SR);
  439.         set_timeconst_sb16(Samps);
  440.         Jouer_SbPro(pn,offs,gr*2);
  441.       end else
  442.         Jouer_Sb(pn,offs,gr);
  443.     end;
  444.   end else begin;
  445.     sb16_outputLong := 0;
  446.     set_timeconst_sb16(vblock.SR);
  447.     if sb16Detected then begin;
  448.       if stereo then begin;
  449.         Jouer_Sb16(pn,offs,gr);
  450.       end else begin;
  451.         Jouer_Sb16(pn,offs,gr);
  452.       end;
  453.     end else begin;
  454.       if stereo then begin;
  455.         Jouer_SbPro(pn,offs,gr);
  456.       end else begin;
  457.         Jouer_Sb(pn,offs,gr);
  458.       end;
  459.     end;
  460.   end;
  461. end;
  462.  
  463.  
  464.  
  465. procedure dsp_int_sb16; interrupt;
  466. {
  467.  On passe à cette procédure avec l'interruption générée à la fin
  468.  d'un transfert de bloc. Si le flag dern_sortie n'a pas été posé,
  469.  une nouvelle sortie démarre.
  470. }
  471. var h : byte;
  472. begin;
  473.   if interrupt_check then begin;
  474.     IRQDetected := true;
  475.   end else begin;
  476.     if Transfer_Testing then begin;
  477.       h := port[dsp_adr+$E];
  478.       dsp_rdy_sb16 := true;
  479.  
  480.       if not dern_sortie then begin;
  481.         Jouer_Block_Dsp(taillebloc,blk,true,false);
  482.       end;
  483.     end else begin;
  484.       h := port[dsp_adr+$E];
  485.       if (fgr > t_bloc) and not lastone then begin
  486.         lastone := false;
  487.         if bloc_actif = 1 then begin
  488.           Jouer_Block_Dsp(t_bloc,blk2,false,true);
  489.           blockread(vocf,blk1^,t_bloc);
  490.           fgr := fgr - t_bloc;
  491.           bloc_actif := 2;
  492.         end else begin;
  493.           Jouer_Block_Dsp(t_bloc,blk1,false,true);
  494.           blockread(vocf,blk2^,t_bloc);
  495.           fgr := fgr - t_bloc;
  496.           bloc_actif := 1;
  497.         end;
  498.       end else begin;
  499.         if not lastone then begin;
  500.           if bloc_actif = 1 then begin
  501.             Jouer_Block_Dsp(t_bloc,blk2,false,true);
  502.             lastone := true;
  503.           end else begin;
  504.             Jouer_Block_Dsp(t_bloc,blk1,false,true);
  505.             lastone := true;
  506.           end;
  507.         end else begin;
  508.           dsp_rdy_sb16 := true;
  509.           Wr_dsp($D0);
  510.           VOC_READY := true;
  511.         end;
  512.       end;
  513.     end;
  514.   end;
  515.   Port[$20] := $20;
  516. end;
  517.  
  518. procedure detect_sbIRQ;
  519. {
  520.  Cette routine reconnaît l'interruption de la carte Sound Blaster. Pour cela
  521.  on teste toutes les interruptions possibles. On envoie des blocs courts
  522.  via DMA. Si la sortie se conclut par le saut à l'interruption indiquée,
  523.  celle-ci a été trouvée.
  524. }
  525. const irqs_possibles : array[1..5] of byte = ($2,$3,$5,$7,$10);
  526. var i : integer;
  527.     h : byte;
  528. begin;
  529.  getintvec($8+dsp_irq,intback);         { Sauvegarde les valeurs ! }
  530.  port21 := port[$21];
  531.  getmem(blk,1200);
  532.  fillchar(blk^,1200,127);
  533.  set_Timeconst_sb16(211);
  534.  Wr_dsp($D3);                           { Eteint le haut-parleur }
  535.  i := 1;
  536.  interrupt_check := true;
  537.  while (i <= 5) and (not IRQDetected) do
  538.    begin;
  539.      dsp_irq := irqs_possibles[i];      { IRQ à tester }
  540.      getintvec($8+dsp_irq,oldint);      { Interruption détournée }
  541.      setintvec($8+dsp_irq,@Dsp_Int_sb16);
  542.      irqmsk := 1 shl dsp_irq;
  543.      port[$21] := port[$21] and not irqmsk;
  544.      Sampling_Rate := 211;
  545.      tailleBloc := 1200;              { Sortie pour test }
  546.      Jouer_Block_Dsp(tailleBloc,blk,true,false);
  547.      delay(150);
  548.      setintvec($8+dsp_irq,oldint);      { Rétablit l'interrupt }
  549.      port[$21] := Port[$21] or irqmsk;
  550.      h := port[dsp_adr+$E];
  551.      Port[$20] := $20;
  552.      inc(i);
  553.    end;
  554.  interrupt_check := false;
  555.  Wr_dsp($D1);                           { Rétablit le haut-parleur }
  556.  freemem(blk,1200);
  557.  setintvec($8+dsp_irq,intback);         { Rétablit les valeurs !!!      }
  558.  port[$21] := port21;
  559.  dsp_rdy_sb16 := true;
  560. end;
  561.  
  562. function Init_SB : boolean;
  563. {
  564.  Cette fonction initialise le Soundblaster. Elle renvoie TRUE,
  565.  si l'initialisation a été réussie, sinon FALSE.
  566.  Le haut-parleur pour la sortie Sampling se fait activer. L'interruption
  567.  DMA-Ready est masquée
  568.  }
  569. begin;
  570.   if not Detect_SBReg then begin;
  571.     Init_SB := false;
  572.     exit;
  573.   end;
  574. { Soundblaster trouve      }
  575.  if not force_irq then detect_sbIRQ;    { auto-détection IRQ        }
  576.    test_Transmission;
  577.  if not force_irq then detect_sbIRQ;    { nécessité d'un 2ème Test pour la SB  }
  578.  if Detect_Mixer_sb16 then begin;
  579.    SbProDetected := TRUE;               { SB Pro détectée           }
  580.  end;
  581.  SbGetDspVersion;
  582.  if SbVersMaj >= 4 then begin;          { SB 16 ASP détectée         }
  583.    Sb16Detected := true;
  584.    SBProDetected := false;
  585.  end;
  586.  Wr_dsp($D1);                           { activer haut parleur       }
  587.  getintvec($8+dsp_irq,oldint);          { sauvegarder ancienne interruption   }
  588.  setintvec($8+dsp_irq,@dsp_int_sb16);   { positionner sur sa propre routine  }
  589.  irqmsk := 1 shl dsp_irq;               { masquer interruption     }
  590.  port[$21] := port[$21] and not irqmsk;
  591. end;
  592.  
  593.  
  594. {
  595.  ***************************************************************************
  596.  
  597.                       P R O C E D U R E S   D E   M I X A G E
  598.  
  599.  ***************************************************************************
  600. }
  601.  
  602.  
  603. PROCEDURE Write_Mixer(Reg, Val: BYTE);
  604. {
  605.  Ecrit la valeur transférée dans Val dans le registre du Mixer-Chip
  606.  indiqué par  Reg
  607. }
  608.  
  609. begin;
  610.  Port[dsp_adr+$4] := Reg;
  611.  Port[dsp_adr+$5] := Val;
  612. END;
  613.  
  614.  
  615. FUNCTION Read_Mixer(Reg: BYTE) : BYTE;
  616. {
  617.  La fonction renvoie le contenu du registre du mixer-chip via  Reg
  618. }
  619. begin;
  620.   Port[dsp_adr+$4] := Reg;
  621.   Read_Mixer := Port[dsp_adr+$5];
  622. end;
  623.  
  624. procedure Filter_On;
  625. {
  626.  La procédure contrôle le filtre des basses, c'est à dire
  627.  il procède au réglage des régistres Bass/Treble correspondants
  628. }
  629. var Aide : byte;
  630. begin;
  631.  if sb16detected then begin;
  632.    write_Mixer(68,64);                  { baisser Treble         }
  633.    write_Mixer(69,64);
  634.    write_Mixer(70,255);                 { basse Power maximal !          }
  635.    write_Mixer(71,255);                 { basse Power maximal !          }
  636.  end else begin;
  637.    Aide := read_Mixer($0c);            { Filtre basse              }
  638.    Aide := Aide or 8;
  639.    Write_Mixer($0c,Aide);
  640.    Aide := read_Mixer($0e);            { activer filtre         }
  641.    Aide := Aide AND 2;
  642.    write_Mixer($0e,Aide);
  643.  end;
  644. end;
  645.  
  646. procedure Filter_MID;
  647. {
  648.  C'est une procédure qui contrôle le filtre des basses c'est à dire il
  649.  contrôle le régistre Bass/Treble correspondant.
  650. }
  651. var Aide : byte;
  652. begin;
  653.  if sb16detected then begin;
  654.    write_Mixer(68,160);                 { baisser Treble             }
  655.    write_Mixer(69,160);
  656.    write_Mixer(70,192);                 { basse Power maximal !     }
  657.    write_Mixer(71,192);                 { basse Power maximal !     }
  658.  end else begin;
  659.    Aide := read_Mixer($0e);            { desactiver filtre         }
  660.    Aide := Aide OR 32;
  661.    write_Mixer($0e,Aide);
  662.  end;
  663. end;
  664.  
  665. procedure Filter_aus;
  666. var Aide : byte;
  667. begin;
  668.  if sb16detected then begin;
  669.    write_Mixer(68,192);                 { revenir aux valeurs par défaut }
  670.    write_Mixer(69,192);
  671.    write_Mixer(70,160);
  672.    write_Mixer(71,160);
  673.  end else begin;
  674.    Aide := read_Mixer($0c);            { filtre des hauteurs               }
  675.    Aide := Aide OR 247;
  676.    Write_Mixer($0c,Aide);
  677.    Aide := read_Mixer($0e);            { active le filtre         }
  678.    Aide := Aide AND 2;
  679.    write_Mixer($0e,Aide);
  680.  end;
  681. end;
  682.  
  683. procedure Set_Balance(Valeur : byte);
  684. {
  685.  La procédure règle la balance selon les valeurs transmises.
  686.  0 indique la position toute à gauche, 12 correspond au milieu et 24 toute à
  687.  droite.
  688.  }
  689. Var left,right : byte;
  690. begin;
  691.  if Sb16Detected then begin;
  692.    left  := 12;
  693.    right := 12;
  694.    if Valeur < 12 then right := Valeur;
  695.    if Valeur > 12 then left  := 24-Valeur;
  696.    write_Mixer(50,(left  shl 4));
  697.    write_Mixer(51,(right shl 4));
  698.  end else begin;
  699.   Valeur := Valeur SHR 1;
  700.   case Valeur of
  701.      0..6 : begin;
  702.                write_Mixer(02,(7 shl 5)+(Valeur shl 1));
  703.              end;
  704.        07 : begin;
  705.                write_Mixer(02,(7 shl 5)+(7 shl 1));
  706.              end;
  707.       08..13 : begin;
  708.                write_Mixer(02,((13-Valeur) shl 5)+(7 shl 1));
  709.                end;
  710.      end;
  711.  end;
  712. end;
  713.  
  714. procedure Set_Volume(Valeur : byte);
  715. {
  716.  Pour régler le volume lors de l'écoute. Les valeurs peuvent se situer entre 0 et 31
  717. }
  718. begin;
  719.   if sb16detected then begin;
  720.     write_Mixer(48,(Valeur shl 3));
  721.     write_Mixer(49,(Valeur shl 3));
  722.   end else begin;
  723.     if MixerDetected then begin;
  724.       Valeur := Valeur Shr 2;
  725.       write_Mixer($22,(Valeur shl 5) + (Valeur shl 1));
  726.     end;
  727.   end;
  728. end;
  729.  
  730. procedure reset_Mixer; assembler;
  731. {
  732.  Le Mixer Chip reçoit de nouveau ses valeurs par défaut
  733. }
  734. asm
  735.   mov dx,dsp_adr+$4
  736.   mov al,0
  737.   out dx,al
  738.   mov cx,50
  739. @loop:
  740.   loop @loop
  741.   inc dx
  742.   out dx,al
  743. end;
  744.  
  745. FUNCTION Detect_Mixer_sb16 : BOOLEAN;
  746. {
  747.  Fonction qui permet l'identification du Mixer-Chips. Elle retourne TRUE, si un Mixer
  748.  a été détecté, sinon FALSE
  749. }
  750. VAR SaveReg : WORD;
  751.     NewReg  : WORD;
  752. BEGIN
  753.   Detect_Mixer_sb16 := MixerDetected;
  754.   IF (NOT SbRegDetected)                { Quitter, s'il n'y a pas }
  755.   OR MixerDetected THEN EXIT;           { de carte SOUNDBLASTER    }
  756.                                         { ou s'il y avait déjà une }
  757.                                         { initalisation d'un Mixer-Chip }
  758.   Reset_Mixer;
  759.   SaveReg := Read_Mixer($22);           { Sauvegarde des registres  }
  760.   Write_Mixer($22, 243);                { Si la valeur actuellement inscrite  }
  761.   NewReg  := Read_Mixer($22);           { ne diffère pas de la valeur }
  762.                                         { précédente, l'accès s'avère  }
  763.                                         { possible, c'est à dire,  }
  764.                                         { un mixer existe        }
  765.   IF NewReg = 243 THEN begin;
  766.     MixerDetected := TRUE;
  767.     STEREO := True;
  768.   end;
  769.   Write_Mixer($22, SaveReg);            { retour au registre précdant  }
  770.   Detect_Mixer_sb16 := MixerDetected;
  771. END;
  772.  
  773.  
  774. procedure exit_song;
  775. begin;
  776.  Port[dsp_adr+$C] := $D3;
  777.  halt(0);
  778. end;
  779.  
  780. {$F+}
  781. procedure MODExitProc;
  782. var mlj : byte;
  783.  begin
  784.  ExitProc := SaveExitProc;
  785.  Exit_Sb16;
  786. end;
  787. {$F-}
  788.  
  789. {
  790.   **************************************************************************
  791.           Les     Routines  du    V O C  -  P l a y e r
  792.  
  793.     montrent l'excution d'un fichier VOC sans
  794.     intégration d'un traitement séparé des blocs.
  795.   **************************************************************************
  796. }
  797.  
  798.  
  799.  
  800.  
  801. procedure Init_Voc(filename : string);
  802. const VOCid : string = 'Creative Voice File'+#$1A;
  803. var ch : char;
  804.     idstr : string;
  805.     ct : byte;
  806.     h : byte;
  807.     error : integer;
  808.     srlo,srhi : byte;
  809.     SR : word;
  810.     Samplingr : word;
  811.     stereoreg : byte;
  812. begin;
  813.   Transfer_Testing := false;
  814.   VOC_READY   := false;
  815.   vocsstereo := stereo;
  816.   stereo := false;
  817.  
  818.   assign(vocf,filename);
  819.   reset(vocf,1);
  820.   if filesize(vocf) < 5000 then begin;
  821.     VOC_READY   := true;
  822.     exit;
  823.   end;
  824.   blockread(vocf,voch,$19);
  825.   idstr := voch.Ident;
  826.   if idstr <> VOCid then begin;
  827.     { Identification fausse ! }
  828.     VOC_READY   := true;
  829.     exit;
  830.   end;
  831.  
  832.   Blockread(vocf,inread,20);
  833.   vblock.Ident_code := inread[2];
  834.  
  835.   if vblock.Ident_code = 1 then begin;
  836.     vblock.SR := inread[6];
  837.   end;
  838.  
  839.   if vblock.Ident_code = 8 then begin;
  840.     SR := inread[6]+(inread[7]*256);
  841.     Samplingr := 256000000 div (65536 - SR);
  842.     if inread[9] = 1 then begin; {stereo}
  843.       if sb16detected then samplingr := samplingr shr 1;
  844.       stereo := true;
  845.     end;
  846.     vblock.SR := 256 - longint(1000000 DIV samplingr);
  847.   end;
  848.  
  849.   if vblock.Ident_code = 9 then begin;
  850.     Samplingr := inread[6]+(inread[7]*256);
  851.     if inread[11] = 2 then begin; {stereo}
  852.       stereo := true;
  853.       if sbprodetected then samplingr := samplingr * 2;
  854.       vblock.SR := 256 - longint(1000000 DIV (samplingr));
  855.     end else begin;
  856.       vblock.SR := 256 - longint(1000000 DIV samplingr);
  857.     end;
  858.   end;
  859.  
  860.  
  861.   if vblock.SR < 130 then vblock.SR := 166;
  862.   set_timeconst_sb16(vblock.SR);
  863.  
  864.   t_bloc := filesize(vocf) - 31;
  865.   if t_bloc > 2500 then t_bloc := 2500;
  866.   blockread(vocf,blk1^,t_bloc);
  867.  
  868.   ch := #0;
  869.   fgr := filesize(vocf) - 32;
  870.   fgr := fgr - t_bloc;
  871.   Bloc_actif := 1;
  872.  
  873.   if fgr > 1 then begin;
  874.     blockread(vocf,blk2^,t_bloc);
  875.     fgr := fgr - t_bloc;
  876.   end;
  877.  
  878.  Wr_dsp($D1);
  879.  lastone := false;
  880.  
  881.  if not sb16Detected then begin;
  882.    if Stereo then begin;
  883.      stereoreg := Read_Mixer($0E);
  884.      stereoreg := stereoreg OR 2;
  885.      Write_Mixer($0E,stereoreg);
  886.    end else begin;
  887.      stereoreg := Read_Mixer($0E);
  888.      stereoreg := stereoreg AND $FD;
  889.      Write_Mixer($0E,stereoreg);
  890.    end;
  891.  end;
  892.  
  893.  Jouer_Block_Dsp(t_bloc,blk1,false,true);
  894. end;
  895.  
  896. procedure voc_done;
  897. var h : byte;
  898. begin;
  899.  lastone := true;
  900.  repeat until dsp_rdy_sb16;
  901.  close(vocf);
  902.  Reset_SBCard;
  903.  stereo := vocsstereo;
  904. end;
  905.  
  906. begin;
  907.  SaveExitProc := ExitProc;
  908.  ExitProc := @MODExitProc;
  909.  dsp_rdy_sb16 := true;
  910.  getmem(blk1,2500);
  911.  getmem(blk2,2500);
  912. end.
  913.  
  914.