unit vocplay;

interface uses crt,dos;

TYPE vocheader = record
       IDstr : array[0..19] of char;
       Sampoff : word;
       Verslo  : Byte;
       Vershi  : Byte;
       ID : word;
     end;

     Voiceblock = record
       ID  : byte;
       Leng_lo : word;
       Leng_hi : byte;
       SR       : byte;
       Pack     : byte;
     end;

const
  { SoundBlaster - Constants }
  Startport          : word = $200;
  Endport            : word = $280;
  force_irq          : boolean = false;
  force_dma          : boolean = false;
  force_base         : boolean = false;
  dsp_irq            : byte = $5;        { SB interrupt, value will be}
                                        { changed by the Init       }
                                        {  routine                  }
  dma_ch             : byte = 1;         { DMA channel, default  }
                                        { = 1, on SB 16 ASP other values}
                                        { also possible ...     }
  dsp_addr            : word = $220;      { Base address of DSP.   }
                                        { Value will be changed by the Init  }
                                        { routine           }
  SbVersMin          : BYTE = 0;         { Version - ID     }
  SbVersMaj          : BYTE = 0;
  STEREO             : BOOLEAN = false;  { Playback in stereo        }
  SbRegDetected      : BOOLEAN = FALSE;  { normal SB present ?     }
  IRQDetected        : BOOLEAN = FALSE;
  SbRegInited        : BOOLEAN = FALSE;
  SbProDetected      : BOOLEAN = FALSE;  { SB Pro present ?         }
  SbProInited        : BOOLEAN = FALSE;
  Sb16Detected       : BOOLEAN = FALSE;  { SB 16 ASP present ?      }
  Sb16Inited         : BOOLEAN = FALSE;
  MixerDetected      : BOOLEAN = FALSE;  { If yess, card >= SB Pro   }

  { Voc - constants }
  block_active       : byte = 1;


  { SoundBlaster - variables }
var dsp_rdy_voc      : boolean;
    blocksz          : word;
    Transfer_Testing : boolean;
    SaveExitProc     : Pointer;             { Necessary, since custom Exitproc  }

var lastone          : boolean;
    VOC_READY        : boolean;
    inread           : array[1..25] of byte;
    vocsstereo       : boolean;
    vocf             : file;
    fsz              : longint;
    blk1,blk2        : pointer;
    voch             : vocheader;
    vblock           : voiceblock;


 function init_sb : boolean;
 {
   The init_sb function initializes the SoundBlaster card. It automatically
   detects the base address and IRQ, checks for the SoundBlaster version
   and sets the appropriate global variables. You can output the global
   variables with write_sbConfig. The function returns True if it was 
   able to initialize a SB card.
 }

 procedure write_sbConfig;
 {
  Outputs the found configuration (text mode !). Alternative:
  Direct access to the corresponding variables.
 }

 procedure Wr_dsp(v : byte);
 {
  Writes the passed value in the SoundBlaster register
 }

 FUNCTION Reset_sbCard : BOOLEAN;
 {
  Resets the SB card. Returns TRUE if successful
 }

 procedure Set_Timeconst_sb16(tc : byte);
 {
  Sets the timer constant, which is calculated according to the formula
  tc := 256-(1.000.000 / Frequency)
 }

 procedure Games_Block_Dsp(sz : word;bk : pointer;b1,b2 : boolean);
 {
  Plays back the block addressed from blk via DMA. Initializes the 
  required variables and then calls one of the three GAMES_SB 
  procedures.
 }

 procedure Games_Sb(Segm,Offs,dsize : word);
 {
  Plays back the addressed block via DMA. For SB / SB Pro
 }

 procedure Games_SbPro(Segm,Offs,dsize : word);
 {
  Plays back the addressed block via DMA. For SB Pro
 }

 procedure Games_Sb16(Segm,Offs,dsize : word);
 {
  Plays back the addressed block via DMA. For SB 16
 }


 procedure Filter_On;
 {
  Switches the Xbass filter on
 }

 procedure Filter_MID;
 {
  Switches the filter to normal operation
 }
 procedure Filter_Off;
 {
  Switches the filter to treble accentuation
 }

 procedure Set_Balance(Value : byte);
 {
  Procedure sets the balance according to the passed value.
  0 stands for left, 12 for middle and 24 stands for right
 }

 procedure Set_Volume(Value : byte);
 {
  Procedure sets the volume for the general (!) output
  (Master Volume). Permissible values range between 0 and 31
 }


 Procedure Init_Voc(filename : string);
 {
  Procedure begins outputting the VOC file passed in the filename
 }

 procedure voc_done;
 {
  Use the VOC_DONE procedure to stop the output of a VOC file.
  You must also call this procedure when the output of a VOC file
  has reached the end.
 }


implementation

TYPE
  pt = record                           { makes simple handling of     }
    ofs,sgm  :  word;                   { pointers possible    }
  end;

CONST
  filter_active       : boolean = false;
  balance            : byte = 12;
  Mastervolume       : byte = 29;
  Samfreq            : word = 22;
  PC    = 0;
  AMIGA = 1;
  interrupt_found : boolean = false;
  interrupt_check    : boolean = false;
  timer_per_second   : word = 1000;      { Number interrupts per sec. }
  Sampling_Frequency  : word = 10000;     { Sampling freq.; Default }
  dma_page           : array[0..3] of byte = ($87,$83,$81,$81);
  dma_addr            : array[0..3] of byte = (0,2,4,6);
  dma_wc             : array[0..3] of byte = (1,3,5,7);

  sb16_outputlength  : word = 0;
  last_output     : boolean = false;

VAR
 blocksize        : word;            { Size of sound buffer }
 dsp_rdy_sb16        : boolean;         { Flag for end of data }
                                        { transfer via DMA      }
 SbVersStr           : string[5];       { SB version as string  }
 oldInt              : pointer;         { For storing interrupt required   }
                                        { by SB for DMA transfer}
irqmsk              : byte;            { for interrupt handling    }
 blk                 : pointer;         { Pointer to data buffer }
 Sampling_Rate       : byte;            { value passed to DSP for}
                                        { frequency               }
 intback             : pointer;
 port21              : byte;


FUNCTION Detect_Mixer_sb16 : boolean; forward;


{
 ***************************************************************************

             S O U N D B L A S T E R   -   P R O C E D U R E S

 ***************************************************************************
}


procedure Wr_dsp(v : byte);
{
 Waits until the DSP is ready to write, and then writes the byte
 passed in "v" to the DSP
}
begin;
  while port[dsp_addr+$c] >= 128 do ;
  port[dsp_addr+$c] := v;
end;

FUNCTION SbReadByte : BYTE;
{
 The function waits until the DSP can be read and returns the 
 read value
}
begin;
  while port[dsp_addr+$a] = $AA do ;     { wait until DSP ready      }
  SbReadByte := port[dsp_addr+$a];       { write value             }
end;

procedure SBreset;
VAR bt,ct, stat : BYTE;
begin;
  PORT[dsp_addr+$6] := 1;                { dsp_addr+$6 = Reset function}
  FOR ct := 1 TO 100 DO;
  PORT[dsp_addr+$6] := 0;
  bt := 0;
  repeat
    ct := 0;
    repeat
      stat := port[dsp_addr + $E];
    until (ct > 8000) or (stat >= 128);
    inc(bt);
  until (bt > 100) or (port[dsp_addr + $A] = $AA);
end;

FUNCTION Reset_SBCard : BOOLEAN;
{
 The function resets the DSP. If resetting was successful, the function 
 returns TRUE, otherwise it returns FALSE
}
CONST  ready = $AA;
VAR ct, stat : BYTE;
BEGIN
  PORT[dsp_addr+$6] := 1;                { dsp_addr+$6 = Reset function}
  FOR ct := 1 TO 100 DO;
  PORT[dsp_addr+$6] := 0;
  stat := 0;
  ct   := 0;                            { The comparison ct < 100, since }
  WHILE (stat <> ready)                 { initialization takes about }
  AND   (ct < 100)      DO BEGIN        { 100ms                }
    stat := PORT[dsp_addr+$E];
    stat := PORT[dsp_addr+$a];
    INC(ct);
  END;
  Reset_SBCard := (stat = ready);
END;

FUNCTION Detect_SBReg : BOOLEAN;
{
 The function returns TRUE if able to initialize a SoundBlaster, otherwise
 the function returns FALSE. The dsp_addr variable is set to the base
 address of the SB.
}
VAR
  Port, Lst : WORD;
BEGIN
 Detect_SBReg := SbRegDetected;
 IF SbRegDetected THEN EXIT;            { Exit, if initialized   }
 Port := Startport;                     { Possible SB addresses between  }
 Lst  := Endport;                       { $210 and $280 !      }
 WHILE (NOT SbRegDetected)
 AND   (Port <= Lst)  DO BEGIN
   dsp_addr := Port;
   SbRegDetected := Reset_SBCard;
   IF NOT SbRegDetected THEN
     INC(Port, $10);
 END;
 Detect_SBReg := SbRegDetected;
END;

PROCEDURE SbGetDSPVersion;
{
 Determines the version of the DSP and stores the results in the global 
 variables SBVERSMAJ and SBVERSMIN as well as SBVERSSTR.
}
VAR i : WORD;
    t : WORD;
    s : STRING[2];
BEGIN
  Wr_dsp($E1);                     { $E1 = version query      }
  SbVersMaj := SbReadByte;
  SbVersMin := SbReadByte;
  str(SbVersMaj, SbVersStr);
  SbVersStr := SbVersStr + '.';
  str(SbVersMin, s);
  if SbVersMin > 9 then
    SbVersStr := SbVersStr +       s
  else
    SbVersStr := SbVersStr + '0' + s;
END;

function wrt_dsp_addr_sb16 : string;
{
 Returns the base address of the SB as a string
}
begin;
  case dsp_addr of
    $210 : wrt_dsp_addr_sb16 := '210';
    $220 : wrt_dsp_addr_sb16 := '220';
    $230 : wrt_dsp_addr_sb16 := '230';
    $240 : wrt_dsp_addr_sb16 := '240';
    $250 : wrt_dsp_addr_sb16 := '250';
    $260 : wrt_dsp_addr_sb16 := '260';
    $270 : wrt_dsp_addr_sb16 := '270';
    $270 : wrt_dsp_addr_sb16 := '280';
   END;
end;

function wrt_dsp_irq : string;
{
 Returns the IRQ of the SB as a string
}
begin;
  case dsp_irq of
     $2 : wrt_dsp_irq := '2 h';
     $3 : wrt_dsp_irq := '3 h';
     $5 : wrt_dsp_irq := '5 h';
     $7 : wrt_dsp_irq := '7 h';
    $10 : wrt_dsp_irq := '10 h';
   END;
end;

procedure Set_Timeconst_sb16(tc : byte);
{
 Procedure for setting the time constants. It calculates in accordance with
 the formula tc := 256 - (1000000 / Frequency).
}
begin;
  Wr_dsp($40);                     { $40 = Set Sample Rate    }
  Wr_dsp(tc);
end;

procedure test_transfer;
{
 For Interrupt Detection
}
begin;
   getmem(blk,3000);
   fillchar(blk^,3000,127);
   blocksize := 2000;
   last_output := true;
   Sampling_Rate := 211;
   Games_Block_Dsp(blocksize,blk,true,false);
   delay(100);
   freemem(blk,3000);
end;

procedure write_sbConfig;
{
 The procedure outputs the found configuration on the screen.
 It serves primarily as an example of how the information can
 be used
}
begin;
  clrscr;
  if SbRegDetected then begin;
    writeln('Sound card at base ',wrt_dsp_addr_sb16,'h with IRQ ',
    wrt_dsp_irq,' found.');
  end else begin;
    writeln('No SoundBlaster compatible card found !');
  end;
  if MixerDetected then begin;
    writeln('Mixer Chip found');
    if SbVersMaj < 4 then
      writeln('Found card is a',
			' SoundBlaster Pro or compatible')
    else
      writeln('Founc card is a',
      ' SoundBlaster 16 ASP or compatible');
  end else begin;
    writeln('Found card is a',
    ' SoundBlaster or compatible');
  end;
  writeln('The version number is ',SbVersStr);
end;

procedure Exit_Sb16;
{
 This procedure is called when the program is exited and sets
 the bent/deflected DMA interrupt to its initial value
}
begin;
  setintvec($8+dsp_irq,oldint);         { Restore old interrupt}
  port[$21] := Port[$21] or irqmsk;     { and set masking to }
  port[dsp_addr+$c] := $d3;              { old value         }
  Port[$20] := $20;
  Wr_dsp($D0);
end;

procedure Games_Sb16(Segm,Offs,dsize : word);
{
 This procedure plays back the block addressed via Segm:Offs with the 
 size dsize. Keep in mind that the DMA controller CANNOT work with
 more than one page ...
}
var li : word;
begin;
  port[$0A] := dma_ch+4;                { lock DMA channel          }
  Port[$0c] := 0;                       { buffer address (blk)  }
  Port[$0B] := $49;                     { for sound output           }
  Port[dma_addr[dma_ch]] := Lo(offs);    { to DMA controller          }
  Port[dma_addr[dma_ch]] := Hi(offs);
  Port[dma_wc[dma_ch]] := Lo(dsize-1);  { size of block (block   }
  Port[dma_wc[dma_ch]] := Hi(dsize-1);  { size) to DMA controller }
  Port[dma_page[dma_ch]] := Segm;
  if sb16_outputlength <> dsize then begin;
    Wr_dsp($C6);                   { DSP command 8 bit via DMA  }
    if stereo then                      { for SB16 Only for starting ! }
      Wr_dsp($20)
    else
      Wr_dsp($00);
    Wr_dsp(Lo(dsize-1));           { Size of the block to       }
    Wr_dsp(Hi(dsize-1));           { the DSP                    }
    sb16_outputlength := dsize;
  end else begin;
    Wr_dsp($45);                   { DMA Continue SB16 8-Bit    }
  end;
  Port[$0A] := dma_ch;                  { release DMA channel        }
end;

procedure Games_SbPro(Segm,Offs,dsize : word);
{
 This procedure plays back the block addressed via Segm:Offs with the
 size dsize. Keep in mind that the DMA controller CANNOT transfer
 more than one page ...
}
var li : word;
begin;
  port[$0A] := dma_ch+4;                { lock DMA channel          }
  Port[$0c] := 0;                       { buffer address (blk)  }
  Port[$0B] := $49;                     { for sound output           }
  Port[dma_addr[dma_ch]] := Lo(offs);    { to DMA controller          }
  Port[dma_addr[dma_ch]] := Hi(offs);
  Port[dma_wc[dma_ch]] := Lo(dsize-1);  { size of block (block  }
  Port[dma_wc[dma_ch]] := Hi(dsize-1);  { size) to DMA controller }
  Port[dma_page[dma_ch]] := Segm;

  Wr_dsp($48);
  Wr_dsp(Lo(dsize-1));             { Size of block to        }
  Wr_dsp(Hi(dsize-1));             { the DSP                    }
  Wr_dsp($91);
  Port[$0A] := dma_ch;                  { release DMA channel        }
end;

procedure Games_Sb(Segm,Offs,dsize : word);
{
 This procedure plays back the block addressed via Segm:Offs with the
 size dsize. Keep in mind that the DMA controller CANNOT work with
 more than one page ...
}
var li : word;
begin;
  port[$0A] := dma_ch+4;                { lock DMA channel          }
  Port[$0c] := 0;                       { buffer address (blk)  }
  Port[$0B] := $49;                     { for sound output           }
  Port[dma_addr[dma_ch]] := Lo(offs);    { to DMA controller          }
  Port[dma_addr[dma_ch]] := Hi(offs);
  Port[dma_wc[dma_ch]] := Lo(dsize-1);  { size of the block (block  }
  Port[dma_wc[dma_ch]] := Hi(dsize-1);  { size) to DMA controller }
  Port[dma_page[dma_ch]] := Segm;
  Wr_dsp($14);
  Wr_dsp(Lo(dsize-1));                  { size of block to        }
  Wr_dsp(Hi(dsize-1));                  { the DSP                    }
  Port[$0A] := dma_ch;                  { release DMA channel        }
end;

procedure Games_Block_Dsp(sz : word;bk : pointer;b1,b2 : boolean);
{
 This procedure begins outputting the data block blk with the size 
 blocksize via DMA
}
var l : longint;
    pn,offs : word;
    hbyte : byte;
    a : word;
    OldV,NewV,Help : byte;
    stereoreg : byte;
    sr : word;
    samps : byte;
begin;
  Transfer_Testing := b1;

  dsp_rdy_sb16 := false;
  l := 16*longint(pt(bk).sgm)+pt(bk).ofs;
  pn := pt(l).sgm;
  offs := pt(l).ofs;

  if Transfer_Testing then begin;
    set_timeconst_sb16(Sampling_Rate);
    if sb16Detected then begin;
      if stereo then
        Games_Sb16(pn,offs,sz*2)
      else
        Games_Sb16(pn,offs,sz);
    end else begin;
      if stereo then begin;
        SR := word(-1000000 DIV (Sampling_Rate-256));
        SR := SR * 2;
        Samps := 256 - (1000000 DIV SR);
        set_timeconst_sb16(Samps);
        Games_SbPro(pn,offs,sz*2);
      end else
        Games_Sb(pn,offs,sz);
    end;
  end else begin;
    sb16_outputlength := 0;
    set_timeconst_sb16(vblock.SR);
    if sb16Detected then begin;
      if stereo then begin;
        Games_Sb16(pn,offs,sz);
      end else begin;
        Games_Sb16(pn,offs,sz);
      end;
    end else begin;
      if stereo then begin;
        Games_SbPro(pn,offs,sz);
      end else begin;
        Games_Sb(pn,offs,sz);
      end;
    end;
  end;
end;

procedure dsp_int_sb16; interrupt;
{
 The interrupt generated at the end of a block transfer jumps to this 
 procedure. If the last_output flag is not set, new output begins 
}
var h : byte;
begin;
  if interrupt_check then begin;
    IRQDetected := true;
  end else begin;
    if Transfer_Testing then begin;
      h := port[dsp_addr+$E];
      dsp_rdy_sb16 := true;

      if not last_output then begin;
        Games_Block_Dsp(blocksize,blk,true,false);
      end;
    end else begin;
      h := port[dsp_addr+$E];
      if (fsz > blocksz) and not lastone then begin
        lastone := false;
        if block_active = 1 then begin
          Games_Block_Dsp(blocksz,blk2,false,true);
          blockread(vocf,blk1^,blocksz);
          fsz := fsz - blocksz;
          block_active := 2;
        end else begin;
          Games_Block_Dsp(blocksz,blk1,false,true);
          blockread(vocf,blk2^,blocksz);
          fsz := fsz - blocksz;
          block_active := 1;
        end;
      end else begin;
        if not lastone then begin;
          if block_active = 1 then begin
            Games_Block_Dsp(blocksz,blk2,false,true);
            lastone := true;
          end else begin;
            Games_Block_Dsp(blocksz,blk1,false,true);
            lastone := true;
          end;
        end else begin;
          dsp_rdy_sb16 := true;
          Wr_dsp($D0);
          VOC_READY := true;
        end;
      end;
    end;
  end;
  Port[$20] := $20;
end;

procedure detect_sbIRQ;
{
This routine detects the IRQ of the SoundBlaster card. To achieve this,
 the routine tests all possible interrupts. For this purpose, short blocks are
 output via DMA. If the routine jumps to the set interrupt at the end of 
 output, it has found the right one
}
const possible_irqs : array[1..5] of byte = ($2,$3,$5,$7,$10);
var i : integer;
    h : byte;
begin;
 getintvec($8+dsp_irq,intback);         { Store values !            }
 port21 := port[$21];
 getmem(blk,1200);
 fillchar(blk^,1200,127);
 set_Timeconst_sb16(211);
 Wr_dsp($D3);                           { Speaker off           }
 i := 1;
 interrupt_check := true;
 while (i <= 5) and (not IRQDetected) do
   begin;
     dsp_irq := possible_irqs[i];      { IRQ to be tested           }
     getintvec($8+dsp_irq,oldint);      { bend/deflect interrupt        }
     setintvec($8+dsp_irq,@Dsp_Int_sb16);
     irqmsk := 1 shl dsp_irq;
     port[$21] := port[$21] and not irqmsk;
     Sampling_Rate := 211;
     blocksize := 1200;              { test output          }
     Games_Block_Dsp(blocksize,blk,true,false);
     delay(150);
     setintvec($8+dsp_irq,oldint);      { Interrupt back again    }
     port[$21] := Port[$21] or irqmsk;
     h := port[dsp_addr+$E];
     Port[$20] := $20;
     inc(i);
   end;
 interrupt_check := false;
 Wr_dsp($D1);                           { speaker back on    }
 freemem(blk,1200);
 setintvec($8+dsp_irq,intback);         { Old values back !!!      }
 port[$21] := port21;
 dsp_rdy_sb16 := true;
end;

function Init_SB : boolean;
{
 This function initializes the SoundBlaster. It returns TRUE if 
 the initialization was successful, otherwise it returns FALSE.
 The speaker for sampling output is switched on. The DMA 
 ready interrupt is bent/deflected to a custom routine.
}
begin;
  if not Detect_SBReg then begin;
    Init_SB := false;
    exit;
  end;
{ SoundBlaster found      }
 if not force_irq then detect_sbIRQ;    { IRQ auto-detection         }
   test_transfer;
 if not force_irq then detect_sbIRQ;    { 2nd test for SB needed !     }
 if Detect_Mixer_sb16 then begin;
   SbProDetected := TRUE;               { SB Pro found            }
 end;
 SbGetDspVersion;
 if SbVersMaj >= 4 then begin;          { SB 16 ASP found         }
   Sb16Detected := true;
   SBProDetected := false;
 end;
 Wr_dsp($D1);                           { speaker on           }
 getintvec($8+dsp_irq,oldint);          { save old interrupt,   }
 setintvec($8+dsp_irq,@dsp_int_sb16);   { set to custom routines  }
 irqmsk := 1 shl dsp_irq;               { mask on interrupt      }
 port[$21] := port[$21] and not irqmsk;
end;


{
 ***************************************************************************

                    M I X E R  -  P R O C E D U R E S

 ***************************************************************************
}


PROCEDURE Write_Mixer(Reg, Val: BYTE);
{
Writes the value passed in Val to the register of the mixer chip 
 specified in Reg
}
begin;
 Port[dsp_addr+$4] := Reg;
 Port[dsp_addr+$5] := Val;
END;


FUNCTION Read_Mixer(Reg: BYTE) : BYTE;
{
 The function returns the contents of the register of the mixer chip 
 indexed via Reg
}
begin;
  Port[dsp_addr+$4] := Reg;
  Read_Mixer := Port[dsp_addr+$5];
end;

procedure Filter_On;
{
 This procedure toggles the Low filter on or adjusts the 
 Bass/Treble register accordingly
}
var help : byte;
begin;
 if sb16detected then begin;
   write_Mixer(68,64);                  { Treble down              }
   write_Mixer(69,64);
   write_Mixer(70,255);                 { Bass full power !          }
   write_Mixer(71,255);                 { Bass full power !          }
 end else begin;
   help := read_Mixer($0c);            { Low filter              }
   help := help or 8;
   Write_Mixer($0c,help);
   help := read_Mixer($0e);            { switch filter on         }
   help := help AND 2;
   write_Mixer($0e,help);
 end;
end;

procedure Filter_MID;
{
 This procedure sets the Low filter on or adjusts the 
 Bass/Treble register accordingly
}
var help : byte;
begin;
 if sb16detected then begin;
   write_Mixer(68,160);                 { Treble down              }
   write_Mixer(69,160);
   write_Mixer(70,192);                 { Bass full power !          }
   write_Mixer(71,192);                 { Bass full power !          }
 end else begin;
   help := read_Mixer($0e);            { switch filter off         }
   help := help OR 32;
   write_Mixer($0e,help);
 end;
end;

procedure Filter_off;
var help : byte;
begin;
 if sb16detected then begin;
   write_Mixer(68,192);                 { back to default         }
   write_Mixer(69,192);
   write_Mixer(70,160);
   write_Mixer(71,160);
 end else begin;
   help := read_Mixer($0c);            { High filter               }
   help := help OR 247;
   Write_Mixer($0c,help);
   help := read_Mixer($0e);            { switch filter on         }
   help := help AND 2;
   write_Mixer($0e,help);
 end;
end;

procedure Set_Balance(Value : byte);
{
 The procedure sets the balance according to the passed value.
 0 stands for left, 12 for middle and 24 stands for right
}
Var left,right : byte;
begin;
 if Sb16Detected then begin;
   left  := 12;
   right := 12;
   if Value < 12 then right := value;
   if Value > 12 then left  := 24-Value;
   write_Mixer(50,(left  shl 4));
   write_Mixer(51,(right shl 4));
 end else begin;
  Value := Value SHR 1;
  case Value of
     0..6 : begin;
               write_Mixer(02,(7 shl 5)+(Value shl 1));
             end;
       07 : begin;
               write_Mixer(02,(7 shl 5)+(7 shl 1));
             end;
	  08..13 : begin;
               write_Mixer(02,((13-Value) shl 5)+(7 shl 1));
	           end;
	 end;
 end;
end;

procedure Set_Volume(Value : byte);
{
 For setting the playback volume. Permissible values range from 0 to 31
}
begin;
  if sb16detected then begin;
    write_Mixer(48,(Value shl 3));
    write_Mixer(49,(Value shl 3));
  end else begin;
    if MixerDetected then begin;
      Value := Value Shr 2;
      write_Mixer($22,(value shl 5) + (value shl 1));
    end;
  end;
end;

procedure reset_Mixer; assembler;
{
 Resets the mixer chip to its default values
}
asm
  mov dx,dsp_addr+$4
  mov al,0
  out dx,al
  mov cx,50
@loop:
  loop @loop
  inc dx
  out dx,al
end;

FUNCTION Detect_Mixer_sb16 : BOOLEAN;
{
 Function for detecting the mixer chip. TRUE, if mixer was, 
 otherwise FALSE
}
VAR SaveReg : WORD;
    NewReg  : WORD;
BEGIN
  Detect_Mixer_sb16 := MixerDetected;
  IF (NOT SbRegDetected)                { Abort if no SouncBlaster card }
  OR MixerDetected THEN EXIT;           { exists    }
                                        { or mixer chip already      }
                                        { initalized               }
  Reset_Mixer;
  SaveReg := Read_Mixer($22);           { save register           }
  Write_Mixer($22, 243);                { If the written value   }
  NewReg  := Read_Mixer($22);           { matches the value     }
                                        { that is read back, it means  }
                                        { access is possible, thus   }
                                        { a mixer exists        }
  IF NewReg = 243 THEN begin;
    MixerDetected := TRUE;
    STEREO := True;
  end;
  Write_Mixer($22, SaveReg);            { Old register back      }
  Detect_Mixer_sb16 := MixerDetected;
END;


procedure exit_song;
begin;
 Port[dsp_addr+$C] := $D3;
 halt(0);
end;

{$F+}
procedure MODExitProc;
var mlj : byte;
 begin
 ExitProc := SaveExitProc;
 Exit_Sb16;
end;
{$F-}

{
  **************************************************************************
               V O C  -  P l a y e r      R o u t i n e s

    for demonstrating the output of VOC - files, no separate 
    VOC block handling integrated
  **************************************************************************
}


procedure Init_Voc(filename : string);
const VOCid : string = 'Creative Voice File'+#$1A;
var ch : char;
    IDstr : string;
    ct : byte;
    h : byte;
    error : integer;
    srlo,srhi : byte;
    SR : word;
    Samplinsz : word;
    stereoreg : byte;
begin;
  Transfer_Testing := false;
  VOC_READY   := false;
  vocsstereo := stereo;
  stereo := false;

  assign(vocf,filename);
  reset(vocf,1);
  if filesize(vocf) < 5000 then begin;
    VOC_READY   := true;
    exit;
  end;
  blockread(vocf,voch,$19);
  IDstr := voch.IDstr;
  if IDstr <> VOCid then begin;
    { ID wrong ! }
    VOC_READY   := true;
    exit;
  end;

  Blockread(vocf,inread,20);
  vblock.ID := inread[2];

  if vblock.ID = 1 then begin;
    vblock.SR := inread[6];
  end;

  if vblock.ID = 8 then begin;
    SR := inread[6]+(inread[7]*256);
    Samplinsz := 256000000 div (65536 - SR);
    if inread[9] = 1 then begin; {stereo}
      if sb16detected then samplinsz := samplinsz shr 1;
      stereo := true;
    end;
    vblock.SR := 256 - longint(1000000 DIV samplinsz);
  end;

  if vblock.ID = 9 then begin;
    Samplinsz := inread[6]+(inread[7]*256);
    if inread[11] = 2 then begin; {stereo}
      stereo := true;
      if sbprodetected then samplinsz := samplinsz * 2;
      vblock.SR := 256 - longint(1000000 DIV (samplinsz));
    end else begin;
      vblock.SR := 256 - longint(1000000 DIV samplinsz);
    end;
  end;


  if vblock.SR < 130 then vblock.SR := 166;
  set_timeconst_sb16(vblock.SR);

  blocksz := filesize(vocf) - 31;
  if blocksz > 2500 then blocksz := 2500;
  blockread(vocf,blk1^,blocksz);

  ch := #0;
  fsz := filesize(vocf) - 32;
  fsz := fsz - blocksz;
  Block_active := 1;

  if fsz > 1 then begin;
    blockread(vocf,blk2^,blocksz);
    fsz := fsz - blocksz;
  end;

 Wr_dsp($D1);
 lastone := false;

 if not sb16Detected then begin;
   if Stereo then begin;
     stereoreg := Read_Mixer($0E);
     stereoreg := stereoreg OR 2;
     Write_Mixer($0E,stereoreg);
   end else begin;
     stereoreg := Read_Mixer($0E);
     stereoreg := stereoreg AND $FD;
     Write_Mixer($0E,stereoreg);
   end;
 end;

 Games_Block_Dsp(blocksz,blk1,false,true);
end;

procedure voc_done;
var h : byte;
begin;
 lastone := true;
 repeat until dsp_rdy_sb16;
 close(vocf);
 Reset_SBCard;
 stereo := vocsstereo;
end;

begin;
 SaveExitProc := ExitProc;
 ExitProc := @MODExitProc;
 dsp_rdy_sb16 := true;
 getmem(blk1,2500);
 getmem(blk2,2500);
end.
