
{

 ***************************************************************************
 ***                   ABACUS'  "PC UNDERGROUND"                         ***
 ***                  ================================                   ***
 ***                                                                     ***
 ***                           Unit MOD_SB                               ***
 ***                                                                     ***
 ***  The unit provides routines for playing back MOD files from a       ***
 ***  SoundBlaster card. Since the routines are very "time-critical", we ***
 ***  wrote the deciding mix routines in 386 Assembly language. Thus,    ***
 ***  the unit WILL NOT run on 286 computers.                            ***
 ***  You can control the MOD files either from the timer interrupt or   ***
 ***  call them using the polling method.                                ***
 ***  The routines require less than 20% of the CPU time for an 8-channel***
 ***  MOD file on a 486dx-33 with an output device of 16khz.             ***
 ***                                                                     ***
 ***                                                                     ***
 *** Author           : Boris Bertelsons  (InspirE)                      ***
 *** Filename         : MOD_SB.PAS                                       ***
 *** Last update      : 04/04/94                                         ***
 *** Version          : 2.0                                              ***
 *** Compiler        : Turbo Pascal 6.0 and above                        ***
 ***************************************************************************

}

{$F+}
unit mod_sb;

interface uses crt,dos,variab;

 var andycount : word;

 procedure voc_pause;
 procedure voc_continue;
 function Init_Sb : boolean;
 {
  This function initialiszes the SoundBlaster. It automatically detects
  the base address and IRQ, checks which SoundBlaster version it is
  and sets the appropriate global variables, which can be output by
  means of write_sbConfig, for example. The function returns TRUE
  if the initialization was successful, otherwise it returns FALSE.
  The speaker for sampling output is switched on. The DMA-Ready
  interrupt is deflected/bent to a custom routine.
 }

 procedure dsp_block_sb16(sz,dsz : word;bk : pointer;b1,b2 : boolean);
 {
  Plays back the block addressed from bk via DMA
 }

 procedure mod_waitretrace(num : byte);
 {
  This procedure waits for a screen retrace when MODs 
  are being played back (otherwise flickering/Ruckeln)
 }

 procedure mod_autodetect(what : boolean);
 {
  Sets speed detection ON/OFF
 }

 procedure mod_SetSpeed(msp : word);
 {
  Sets the "Speed" variable
 }

 procedure mod_SetLoop(msl : word);
 {
  Sets the "Sound_Loops" variable
 }

 procedure mod_SetLoopflag(loop : boolean);
 {
  Sets loop flag ON/OFF, to determine whether a MOD file that has
  been played to the end should start playing at the beginning again
 }

 procedure mod_transpose(transposervalue : integer);
 {
  Sets the transposer value. Use for sound effects if necessary, to 
  fade a sound in or out. Otherwise DO NOT change.
 }

 procedure mod_Samplefreq(Rate : integer);
 {
  Sets the sample frequency for the output. Value*1000 = Frequency.
  Permissible values are 8,10,16,22
 }

 function load_modfile(modname : string;ispeed,iloop : integer;freq : byte) : integer;
 {
  Loads the Mod file specified under modname. By means of ispeed and iloop
  it is possible to specify the variables "Speed" and "Sound_Loops", however,
  it makes more sense to specify AUTO for both values
 }

 procedure end_mod;
 {
  Ends playback of a Mod file and removes it from memory
 }

 procedure periodic_on;
 {
  Turns playback of a MOD file on. Must be called to
  start
 }

 procedure periodic_off;
 {
  Stops playback of a MOD file. The MOD file remains in memory
  and can be started again by periodic_on
 }

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

 procedure calculate_music;
 {
  Calculates a piece of music. Called periodically or in a
  loop
 }

 procedure Filter_On;
 {
  Switches on the XBass filter
 }

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

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

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

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

 function Init_The_Mod : boolean;
 {
  Initializes the .MOD routines. Resets the SoundBlaster and sets
  required variables
 }

 function Reset_Sb16 : BOOLEAN;
 {
  Resets the SoundBlaster card. Returns TRUE if successful
 }

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

 procedure Fade_Musix_out;
 {
  Slowly fades out the volume. For example, can be used for end of program
 }

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

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

 procedure init_data;
 {
  Initializes variables of the unit
 }

 Procedure Init_Voc(filename : string);
 {
  Begins output of a VOC file. Parallel output of VOC
  and MOD is NOT possible
 }

 procedure voc_done;
 {
  Ends playback of a VOC file.
 }

const bpm : byte = 125;

var SaveExitProc : Pointer;             { Necessary, since its a custom Exitproc  }
 mycli : byte;                          { Flag, whether sound calculation   }
                                        { is active                      }
 music_played : boolean;                { Flag, TRUE if music has been  }
                                        { played               }
implementation

const
 Speed3 : word = 58;
 Loop3  : word = 42;

Var
 Pitch_Voice : array[1..8] of word;
 pitch : word;                       { the value of pitch, as it  }
                                     { stands in the MOD file  }
 destination : pt;                   { playback buffer in pt format }
 Modp  : pointer;                    { pointer to Rm_Song        }
 note : array[1..8] of byte;
 oldx,oldy : integer;
 current_Voice : word;

 Mixed_data   : pointer;
 Mixed_data_st : pointer;

{$L modmix}
procedure Empty_Voice; external;
{procedure Voice_normal(current_Voice : word); external;}
procedure Voice_normal; external;
procedure Voice_normal_st; external;

var Portamento_Up_Voice : array[1..8] of longint;
    Portamento_Do_Voice : array[1..8] of longint;

var MixingProcs         : array[1..8] of pointer;
    EmptyVoice          : pointer;

    effect_Voice        : array[1..8] of byte;

    Length_Voice       : array[1..8] of longint;
    Loop_Length_Voice  : array[1..8] of longint;
    Position_Voice     : array[1..8] of longint;
    Loop_Start_Voice   : array[1..8] of longint;
    Segment_Voice      : array[1..8] of longint;
    Notvol_Voice       : array[1..8] of longint;
    Incval_Voice       : array[1..8] of longint;

var nothin_done_count : word;

    var Proc : boolean;
      vocb1,
      vocb2,
      buffer1,
      buffer2 : pointer;
    shiftfactor,
    shiftfactor_stereo : word;

{

 **************************************************************************
 ***                                                                    ***
 ***                Routines  for  Timer - Handling                     ***
 ***                                                                    ***
 **************************************************************************

}

procedure SetTimerOn(Proc : pointer; Freq : word);
var ICounter : word;
    OlDv : pointer;
begin;
 asm cli end;
 ICounter := 1193180 DIV Freq;
 Port[$43] := $36;
 Port[$40] := Lo(ICounter);
 Port[$40] := Hi(ICounter);

 GetIntVec(8,OldV);
 SetIntVec(OldTimerInt,OldV);
 SetIntVec(8,Proc);
 Old_tCounter := 1;
 SecCounter  := 0;
 OldIntCounter := 0;
 asm sti end;
end;


procedure SetTimerOff;
var OldV : pointer;
begin;
  asm cli end;
  Port[$43] := $36;
  Port[$40] := 0;
  Port[$40] := 0;
  GetIntVec(OldTimerInt,OldV);
  SetIntVec(8,OldV);
  asm sti end;
end;

procedure NewTimer; interrupt;
var dr : registers;
begin;
 inc(nothin_done_count);
 inc(Seccounter);
 inc(Oldintcounter);
 if OldIntCounter = 58 then begin;
   OldIntCounter := 0;
   intr(Oldtimerint,dr);
 end;
 if SecCounter = Timer_Per_Second then begin;
   SecCounter := 0;
   inc(AndyCount);
   inc(Runsec);
   if Runsec = 60 then begin;
     inc(Runmin);
     Runsec := 0;
   end;
 end;
 if not In_Retrace then Calculate_Music;
 Port[$20] := $20;
end;


{

 **************************************************************************
 ***                                                                    ***
 ***              Routines for controlling the SoundBlaster             ***
 ***                                                                    ***
 **************************************************************************

}


procedure wr_dsp_sb16(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;
{
 Function waits until the DSP can be read and returns the
 read value
}
begin;
  while port[dsp_addr+$a] = $AA do ;     { wait till 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_sb16 : BOOLEAN;
{
 Function resets the DSP. If the reset was successful, TRUE
 is returned, otherwise 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;                            { Comparison ct < 100, since }
  WHILE (stat <> ready)                 { initialization takes    }
  AND   (ct < 100)      DO BEGIN        { approx. 100ms               }
    stat := PORT[dsp_addr+$E];
    stat := PORT[dsp_addr+$a];
    INC(ct);
  END;
  Reset_sb16 := (stat = ready);
END;

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

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;
{
 Function returns the contents of the register of the mixer chip 
 indexed from 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 :=7 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);
{
 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 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 else begin;
      outvolume := 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 mixer chip. TRUE, if mixer was found,
 otherwise FALSE
}
VAR SaveReg : WORD;
    NewReg  : WORD;
BEGIN
  Detect_Mixer_sb16 := MixerDetected;
  IF (NOT SbRegDetected)                { Abort if no SoundBlaster }
  OR MixerDetected THEN EXIT;           { card exists    }
                                        { or mixer chip already      }
                                        { initialized               }
  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 SbGetDSPVersion;
{
 Determines the DSP version and stores the result in the 
global variables SBVERSMAJ and SBVERSMIN, as well as SBVERSSTR.
}VAR i : WORD;
    t : WORD;
    s : STRING[2];
BEGIN
  wr_dsp_sb16($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. Calculates according to the 
 formula  tc := 256 - (1000000 / Frequency).
}
begin;
  wr_dsp_sb16($40);                     { $40 = Set Sample Rate    }
  wr_dsp_sb16(tc);
end;

procedure test_transfer;
begin;
   fillchar(buffer1^,3000,127);
   blocksize := 2000;
   last_output := TRUE;
   Sampling_Rate := 211;
   dsp_block_sb16(blocksize,blocksize,buffer1,TRUE,FALSE);
   delay(100);
end;

procedure write_sbConfig;
{
 Procedure outputs the found configuration on the screen.
 It serves primarily as an example of the information can
 be used
}
begin;
  clrscr;
  if SbRegDetected then begin;
    writeln('Sound card found at base ',wrt_dsp_addr_sb16,'h with IRQ ',
    wrt_dsp_irq,'.');
  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('Found 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 ends and sets
 the bent/deflected DMA-Interrupt to its initial value
}
begin;
  setintvec($8+dsp_irq,oldint);         { restore old interrupt and }
  port[$21] := Port[$21] or irqmsk;     { reset masking to old }
  port[dsp_addr+$c] := $d3;             { value          }
  Port[$20] := $20;
  wr_dsp_sb16($D0);
end;

procedure Play_Sb16(Segm,Offs,dsz,dsize : word);
{
 This procedure plays back the block addressed from 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   }
  Port[$0B] := $48+dma_ch;              { 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(dsz-1);    { Size of block (block   }
  Port[dma_wc[dma_ch]] := Hi(dsz-1);    { size) to DMA controller }
  Port[dma_page[dma_ch]] := Segm;
  if sb16_outputlength <> dsize then begin;
    wr_dsp_sb16($C6);                   { DSP command 8-bit from DMA  }
    if stereo then begin;               { for SB16 Only for starting ! }
      wr_dsp_sb16($20);
{      write('õ');}
    end else
      wr_dsp_sb16($00);
    wr_dsp_sb16(Lo(dsize-1));           { Size of block to       }
    wr_dsp_sb16(Hi(dsize-1));           { DSP                    }
    sb16_outputlength := dsize;
  end else begin;
    wr_dsp_sb16($45);                   { DMA continue SB16 8-bit    }
  end;
  Port[$0A] := dma_ch;                  { release DMA channel        }
end;

procedure Play_Sb(Segm,Offs,dsz,dsize : word);
{
 This procedure plays back the block addressed from 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   }
  Port[$0B] := $48+dma_ch;              { 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(dsz-1);    { size of block (block-  }
  Port[dma_wc[dma_ch]] := Hi(dsz-1);    { size) to DMA controller }
  Port[dma_page[dma_ch]] := Segm;
  wr_dsp_sb16($14);
  wr_dsp_sb16(Lo(dsize-1));             { size of block to       }
  wr_dsp_sb16(Hi(dsize-1));             { DSP                    }
  Port[$0A] := dma_ch;                  { release DMA channel       }
end;

procedure Play_SbPro(Segm,Offs,dsz,dsize : word);
{
 This procedure plays back the block addressed from 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  }
  Port[$0B] := $48+dma_ch;              { 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(dsz-1);    { size of block (block-  }
  Port[dma_wc[dma_ch]] := Hi(dsz-1);    { size) to DMA controller }
  Port[dma_page[dma_ch]] := Segm;

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

procedure dsp_block_sb16(sz,dsz : word;bk : pointer;b1,b2 : boolean);
{
 This procedure begins outputting the data block 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;
  Playing_MOD := b1;
  Playing_VOC := b2;

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

  if Playing_MOD then begin;
    set_timeconst_sb16(Sampling_Rate);
    if sb16Detected then begin;
      if stereo then  begin;
        Play_Sb16(pn,offs,dsz*2,sz*2);
{        write('S');}
      end else
        Play_Sb16(pn,offs,dsz,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);
        Play_SbPro(pn,offs,dsz*2,sz*2);
      end else
        Play_Sb(pn,offs,dsz,sz);
    end;
  end;

  if Playing_VOC then begin;
    sb16_outputlength := 0;
    set_timeconst_sb16(vblock.SR);
    if sb16Detected then begin;
      if stereo then begin;
        Play_Sb16(pn,offs,dsz,sz);
      end else begin;
        Play_Sb16(pn,offs,dsz,sz);
      end;
    end else begin;
      if stereo then begin;
        Play_SbPro(pn,offs,dsz,sz);
      end else begin;
        Play_Sb(pn,offs,dsz,sz);
      end;
    end;
  end;
end;


{

 **************************************************************************
 ***                                                                    ***
 ***                Routines for playing back MOD files                 ***
 ***                                                                    ***
 **************************************************************************

}

procedure get_pctunel(height : word;Var vk : longint);
{
 The procedure determines the places before and after the decimal point
 required for frequency manipulation from the passed pitch
 (as it is in the MOD file).
}
var nct : byte;
    found : boolean;
begin;
 nct := 1;
 found := FALSE;
 while (nct <= 70) and not found do   { until found or last  }
 begin;                               { value in table            }
   if height > Modoctave[nct] then
     found := TRUE;
   inc(nct);
 end;
 if found then begin;
   vk  := Incfacts[nct-tpw+12];
 end else begin;
   vk  := 0;                          { get values from table.   }
 end;
end;


{function T_Height(Nr : word) : integer;
begin;
 T_Height := Modoctave[nr];
end;}

function Notes_Nr(height : word) : integer;
var nct : byte;
    found : boolean;
begin;
 nct := 1;
 found := FALSE;
 while (nct <= 70) and not found do   { until found or last  }
 begin;                               { value in table            }
   if height > Modoctave[nct] then
     found := TRUE;
   inc(nct);
 end;
 if found then begin;
   Notes_nr := nct-1;
 end else begin;
   Notes_nr := -1;
 end;
end;

function Notevolumes(Stm : byte) : byte;
begin;
 Notevolumes := Rm_Song[mli,Stm,4];
end;

var mixed_posi : word;
    calc_size : word;

procedure inside_loop_4;
{
 The actual mixing of data takes place here. The buffer
 is filled with the calculated data. This is the MONO
 version of the routine.
}
begin;
  calc_size := blocksize;
  if Proc then
    destination := pt(buffer1)
  else
    destination := pt(buffer2);
  fillchar(mixed_data^,8000,128);
asm

    mov cx,1
@Voices_loop:
    mov mixed_posi,0
    mov current_Voice,cx
    mov si,cx
    dec si
    shl si,2
    call dword ptr Mixingprocs[si]

    inc cx
    cmp cx,Voices
    jbe @Voices_loop

    mov mixed_posi,0
    mov cx,calc_size
@Mixed_2_blk:
    les di,mixed_data
    add di,mixed_posi
    mov ax,es:[di]
    push cx
    mov cx,shiftfactor
    shr ax,cl
    pop cx
    add mixed_posi,2

    mov bx,destination.sgm   		{ write byte to destination    }
    mov es,bx
    mov bx,destination.ofs
    mul outvolume
    shr ax,6
    mov es:[bx],al
    inc destination.ofs

    loop @mixed_2_blk
end;
end;

procedure inside_loop_4_stereo;
{
 This is where the actual mixing of the data takes place. The buffer
 is filled with the calculated data. This is the MONO
 version of the routine.
}
begin;
  calc_size := blocksize;
  if Proc then
    destination := pt(buffer1)
  else
    destination := pt(buffer2);
  fillchar(mixed_data^,8000,128);
  fillchar(mixed_data_st^,8000,128);
asm
    mov cx,1
@Voices_loop:
    mov mixed_posi,0
    mov current_Voice,cx
    mov si,cx
    dec si
    shl si,2
    call dword ptr Mixingprocs[si]

    inc cx
    cmp cx,Voices
    jbe @Voices_loop

    mov mixed_posi,0
    mov cx,calc_size
@Mixed_2_blk:
    les di,mixed_data
    add di,mixed_posi
    mov ax,es:[di]
    push cx
    mov cx,shiftfactor_stereo
    shr ax,cl
    pop cx

    mov bx,destination.sgm   		{ write byte to destination   }
    mov es,bx
    mov bx,destination.ofs
    mul outvolume
    shr ax,6
    mov es:[bx],al
    inc destination.ofs

    les di,mixed_data_st
    add di,mixed_posi
    mov ax,es:[di]
    push cx
    mov cx,shiftfactor_stereo
    shr ax,cl
    pop cx
    add mixed_posi,2

    mov bx,destination.sgm   		{ write byte to destination     }
    mov es,bx
    mov bx,destination.ofs
    mul outvolume
    shr ax,6
    mov es:[bx],al
    inc destination.ofs

    loop @mixed_2_blk
end;
end;

procedure mix_start_4;
var rdiff : real;
    dummy : byte;
    var li : integer;
begin;
 for li := 1 to Voices do begin;
   if note[li] <> 0 then begin;
     pitch_Voice[li] := (Rm_Song[mli,li,1] and $0F)*256+Rm_Song[mli,li,2];
     get_pctunel(pitch_Voice[li],Incval_Voice[li]);
   end;

   ls[li] := loop_s[In_st[li]];
   ll[li] := loop_l[In_st[li]];
   if ll[li] > 30 then inl[li] := ll[li]+ls[li];
   Loop_Length_Voice[li] := ll[li];
   Loop_Start_Voice[li]  := ls[li];

   case effect_Voice[li] of
     1 : begin;
            inc(Incval_Voice[li],Portamento_up_Voice[li]);
         end;
     2 : begin;
            inc(Incval_Voice[li],Portamento_do_Voice[li]);
         end;
   end;
 end;
end;


procedure effect_handling(li : integer);
var idx : word;
    Portamento_Speed : word;
    Startnote,
    endnote : word;
    startinc,
    endinc : longint;

begin;
 if Rm_Song[mli,li,3] and $0F <= 15 then begin;
   Eff[li] := 0;
   case (Rm_Song[mli,li,3] and $0F) of
      01 : begin;
             effect_Voice[li] := 1;
             Portamento_Speed := Rm_Song[mli,li,4];
             Startnote := Notes_nr(pitch_Voice[li]);
             Endnote   := Startnote+Portamento_Speed;
             get_pctunel(Modoctave[Startnote],Startinc);
             get_pctunel(Modoctave[Endnote],Endinc);
             Portamento_up_Voice[li] := round((Endinc - Startinc) / playspeed);
           end;
      02 : begin;
             effect_Voice[li] := 2;
             Portamento_Speed := Rm_Song[mli,li,4];
             Startnote := Notes_nr(pitch_Voice[li]);
             Endnote   := Startnote-Portamento_Speed;
             get_pctunel(Modoctave[Startnote],Startinc);
             get_pctunel(Modoctave[Endnote],Endinc);
             Portamento_do_Voice[li] := round((Endinc - Startinc) / playspeed);
           end;
       9 : begin;  { Sample offset }
             Position_Voice[li] := longint(Rm_Song[mli,li,4]) shl 24;
           end;
      13 : begin;
			       mli := 64;
			     end;
      11 : begin;
			       mli := 64;
						 mlj := Rm_Song[mli,li,4];
			     end;
      12 : begin;
             Notvol_Voice[li]  := Notevolumes(li);
           end;
      14 : begin;
             case (Rm_Song[mli,li,4] shr 4) of
                12 : begin;
                       inl[li]    := 0;
                       Notvol_Voice[li]   := 0;
                       inp[li]    := 0;
                       Pnk[li]    := 0;
                     end;
             end;
           end;
      15 : begin;
             idx := Rm_Song[mli,li,4];
             if idx <= $f then begin;
               Playspeed    := idx;
               Speed := Playspeed*105 div 10;
               blocksize := Speed * Sound_Loops;
             end else begin;
               bpm := idx;
               mod_SetLoop(Sampling_Frequency div (BPM * 4));
               Speed := Playspeed*105 div 10;
               blocksize := Speed * Sound_Loops;
             end;
             if blocksize < 40 then blocksize := 40;
             if blocksize > 4000 then blocksize := 4000;
			     end;
    end;
  end;
end;

procedure nmw_all_4;
const stereoprocs : array[1..8] of pointer =
  (@Voice_normal,@Voice_normal,@Voice_normal_st,@Voice_normal_st,
   @Voice_normal,@Voice_normal,@Voice_normal_st,@Voice_normal_st);
var idx : byte;
    li : integer;
begin;
   inc(mli);
   if mli > 64 then mli := 1;
   if mli = 1 then begin;
     inc(mlj);
     if mlj > Songlength then begin;
       if mloop then begin;
         mlj := 1;
         move(rm[song[mlj]] ^,Rm_Song,2048);
       end else begin;
         asm
           call [periodic_pause]
         end;
         music_Off := TRUE;
         Mod_At_End := TRUE;
       end;
     end else begin;
         move(rm[song[mlj]] ^,Rm_Song,2048);
     end;
   end;

  for li := 1 to Voices do begin;
    effect_Voice[li] := 0;
    note[li] := (Rm_Song[mli,li,1] AND $F0)+((Rm_Song[mli,li,3] AND $F0) shr 4);
    if note[li] <> 0 then begin;
      if stereo then begin;
        Mixingprocs[li] := stereoprocs[li];
      end else begin;
        Mixingprocs[li] := @Voice_normal;
      end;
      Notes_Struck[li] := 500;
      In_St[li]  := note[li];
      inst[li]  := Ptr(pt(Samp[In_St[li]]).sgm,pt(Samp[In_St[li]]).ofs);
      Length_Voice[li]      := sam_l[In_St[li]];
      Position_Voice[li]    := 0;
      Notvol_Voice[li]      := inst_vol[in_St[li]];
      Segment_Voice[li]     := seg(inst[li]^);
    end;
    effect_handling(li);
  end;

end;


procedure initialize_mix;
begin;
  asm
    call [mix_proc]
  end;
end;

FUNCTION ConvertString(Source : Pointer; Size : BYTE):String;
VAR
   WorkStr : String;
BEGIN
   Move(Source^,WorkStr[1],Size);
   WorkStr[0] := CHR(Size);
   ConvertString := WorkStr;
END;

function init_Song : boolean;
const ID1 : string = 'FLT4';
      ID2 : string = 'M.K.';
      ID3 : string = '8CHN';
var rmod : file;
    ssz : word;                         { size of a sample        }
    inststart : longint;                { position in file where}
                                        { sample data begin }
    filsz : longint;                    { size of the MOD file  }
    Mdt : array[1..4] of char;          { for Mode type - detection     }
    helpp : ^byte;
    strptr : pointer;
    IDch : array[1..4] of char;
    IDstr : string;
    instance : byte;
    idx : integer;
begin;
 In_St[1] := 0;
 In_St[2] := 0;
 In_St[3] := 0;
 In_St[4] := 0;
 In_St[5] := 0;
 In_St[6] := 0;
 In_St[7] := 0;
 In_St[8] := 0;
 for mlj := 0 to 128 do
   Song[mlj] := 0;
 {$I-}
 assign(rmod,Mod_Name);
 reset(rmod,1);
 {$I+}
 if IOresult <> 0 then begin;
   init_song := FALSE;
   exit;
 end;
 if moddatsize <> 0 then filsz := moddatsize else
 filsz := filesize(rmod);
 inststart := filsz;
 seek(rmod,1080);
 blockread(rmod,IDch,4);
 IDstr := IDch;
 if (IDstr <> ID1) and (IDstr <> ID2)
 and (IDstr <> ID3) then begin;
   instance := 15;
 end else begin;
   instance := 31;
 end;

 if instance = 31 then begin;           { 31 Voices detected from ID     }
 for mlj := 1 to 31 do begin;
  idx := mlj;
  seek(rmod,msp+42+(idx-1)*30);
  blockread(rmod,ssz,2);
  ssz := swap(ssz) * 2;
  if ssz <> 0 then inststart := inststart - ssz;
  Sam_l[idx] := ssz;
  seek(rmod,msp+45+(idx-1)*30);
  blockread(rmod,inst_vol[idx],1);
  blockread(rmod,loop_s[idx],2);
  blockread(rmod,loop_l[idx],2);
  loop_s[idx] := swap(loop_s[idx])*2;
  loop_l[idx] := swap(loop_l[idx])*2;
 end;

 seek(rmod,msp+1080);
 blockread(rmod,Mdt,4);
 if pos('8CHN',Mdt) <> 0 then begin;
   Pattsize    := 2048;
   Voices        := 8;
   shiftfactor        := 3;
   shiftfactor_stereo := 3;
 end else begin;
 { 4-channel MOD-File }
   Pattsize    := 1024;
   Voices        := 4;
   shiftfactor        := 2;
   shiftfactor_stereo := 2;
 end;
 Mix_Proc := @mix_start_4;
 nmw_Proc       := @nmw_all_4;
 if stereo then
   inside_proc     := @inside_loop_4_stereo
 else
   inside_proc     := @inside_loop_4;


 seek(rmod,msp+inststart);
 for mlj := 1 to 31 do begin;
  idx := mlj;
  getmem(Samp[idx],Sam_l[idx]);
  blockread(rmod,Samp[idx]^,sam_l[idx]);
 end;

 filsz := inststart - 1083;
 pat_num := filsz div Pattsize;
 for mlj := 0 to pat_num-1 do begin;
   getmem(rm[mlj],2048);
   fillchar(rm[mlj]^,2048,0);
   seek(rmod,msp+1084+mlj*Pattsize);
   helpp := ptr(seg(rm[mlj]^),ofs(rm[mlj]^));
   for mli := 0 to 63 do begin;
     helpp := ptr(seg(rm[mlj]^),ofs(rm[mlj]^)+mli*32);
  	 blockread(rmod,helpp^,Pattsize div 64);
   end;
 end;
 seek(rmod,msp+952);
 blockread(rmod,Song,128);

 getmem(strptr,25);
 for i := 0 to 30 do begin;
   seek(rmod,msp+20+i*30);
   blockread(rmod,strptr^,22);
   instnames[i+1] := convertstring(strptr,22);
 end;
 seek(rmod,msp);
 blockread(rmod,strptr^,20);
 songname := convertstring(strptr,20);
 freemem(strptr,25);

 seek(rmod,msp+950); { von 470}
 blockread(rmod,Songlength,1);
 end else begin;
 for mlj := 1 to 15 do begin;
  seek(rmod,msp+42+(mlj-1)*30);
  blockread(rmod,ssz,2);
  ssz := swap(ssz) * 2;
  if ssz <> 0 then inststart := inststart - ssz;
  Sam_l[mlj] := ssz;
  seek(rmod,msp+45+(mlj-1)*30);
  blockread(rmod,inst_vol[mlj],1);
  blockread(rmod,loop_s[mlj],2);
  blockread(rmod,loop_l[mlj],2);
  loop_s[mlj] := swap(loop_s[mlj])*2;
  loop_l[mlj] := swap(loop_l[mlj])*2;
 end;

 for mlj := 16 to 31 do begin;
  Sam_l[mlj] := 0;
  loop_s[mlj] := 0;
  loop_l[mlj] := 0;
 end;

 if pos('8CHN',Mdt) <> 0 then begin;
   Pattsize    := 2048;
   Voices        := 8;
   shiftfactor        := 3;
   shiftfactor_stereo := 3;
 end else begin;
 { 4-channel MOD-File }
   Pattsize    := 1024;
   Voices        := 4;
   shiftfactor        := 2;
   shiftfactor_stereo := 2;
 end;
 Mix_Proc := @mix_start_4;
 nmw_Proc       := @nmw_all_4;
 if stereo then
   inside_proc     := @inside_loop_4_stereo
 else
   inside_proc     := @inside_loop_4;

 seek(rmod,msp+inststart);
 for mlj := 1 to 15 do begin;
   getmem(Samp[mlj],Sam_l[mlj]);
   blockread(rmod,Samp[mlj]^,sam_l[mlj]);
 end;

 filsz := inststart - 603;
 pat_num := filsz div Pattsize;
 for mlj := 0 to pat_num-1 do begin;
   getmem(rm[mlj],2048);
   fillchar(rm[mlj]^,2048,0);
   seek(rmod,msp+1084+mlj*Pattsize);
   helpp := ptr(seg(rm[mlj]^),ofs(rm[mlj]^));
   for mli := 0 to 63 do begin;
     helpp := ptr(seg(rm[mlj]^),ofs(rm[mlj]^)+mli*32);
  	 blockread(rmod,helpp^,Pattsize div 64);
   end;
 end;
 seek(rmod,msp+472);
 blockread(rmod,Song,128);

 getmem(strptr,25);
 for i := 0 to 14 do begin;
   seek(rmod,msp+20+i*30);
   blockread(rmod,strptr^,22);
   instnames[i+1] := convertstring(strptr,22);
 end;

 for i := 15 to 30 do begin;
   instnames[i+1] := '';
 end;
 seek(rmod,msp);
 blockread(rmod,strptr^,20);
 songname := convertstring(strptr,20);
 freemem(strptr,25);

 seek(rmod,msp+470);
 blockread(rmod,Songlength,1);
 end;


 mlj := 0;
 mli := 0;
 close(rmod);
 init_song := TRUE;
end;

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

procedure Free_Soundmem;
{
 Free up reserved memory
}
begin;
 if music_played then begin;
 for mlj := 0 to pat_num-1 do begin;
   freemem(rm[mlj],2048);
 end;
 end;
end;

procedure init_sbperiod(p : pointer);
begin;
  periodic_pause := p;
end;

procedure mod_SetLoopflag(loop : boolean);
begin;
 mloop := loop;
end;

procedure mod_SetMultiply(msm : word);
begin;
 modmultiply := msm;
end;

procedure mod_SetLoop(msl : word);
begin;
 Sound_Loops := msl;
 loop3 := msl;
end;

procedure mod_SetSpeed(msp : word);
begin;
 speed := msp;
 Speed3 := msp;
end;

procedure mod_autodetect(what : boolean);
begin;
 if what then mautodet := TRUE else mautodet := FALSE;
end;

procedure mod_transpose(transposervalue : integer);
begin;
  tpw := transposervalue;
end;

procedure init_data;
Var i,j : integer;
begin;
 m_played := FALSE;
 In_St[1] := 0;
 In_St[2] := 0;
 In_St[3] := 0;
 In_St[4] := 0;
 In_St[5] := 0;
 In_St[6] := 0;
 In_St[7] := 0;
 In_St[8] := 0;
 Note1 := 0;
 Note2 := 0;
 Note3 := 0;
 Note4 := 0;
 Note5 := 0;
 Note6 := 0;
 Note7 := 0;
 Note8 := 0;
 Notes_Struck[1] := 0;
 Notes_Struck[2] := 0;
 Notes_Struck[3] := 0;
 Notes_Struck[4] := 0;
 Notes_Struck[5] := 0;
 Notes_Struck[6] := 0;
 Notes_Struck[7] := 0;
 Notes_Struck[8] := 0;
 fillchar(inl,sizeof(inl),0);
 notvol1 := 0; notvol2 := 0; notvol3 := 0; notvol4 := 0;
 notvol5 := 0; notvol6 := 0; notvol7 := 0; notvol8 := 0;
 fillchar(Rm_Song,2048,0);
end;

procedure init_Paramtable;
var ls : byte;
    h : real;
begin;
{  playspeed := 6;
  for ls := 1 to 31 do begin;
    if ls <= 3 then
      ModPara[ls].mult := 100
    else
      ModPara[ls].mult := 105;
    ModPara[ls].Speed := ls*ModPara[ls].mult div 10;
    ModPara[ls].bsz := ModPara[ls].Speed*Sound_Loops;
   end;}
end;

procedure mod_Samplefreq(Rate : integer);
var h : real;
begin;
  case Rate of
     08 : begin;
            Sampling_Rate := 131;
            set_timeconst_sb16(131);
            mod_transpose(1);
            mod_SetLoop(15);
            blocksize := Speed * Sound_Loops;
            Sampling_Frequency := 8000;
            init_Paramtable;
          end;
     10 : begin;
            Sampling_Rate := 156;
            set_timeconst_sb16(156);
            mod_transpose(5);
            mod_SetLoop(19);
            blocksize := Speed * Sound_Loops;
            Sampling_Frequency := 10000;
            init_Paramtable;
          end;
     13 : begin;
            Sampling_Rate := 181;
            set_timeconst_sb16(181);
            mod_transpose(10);
            mod_SetLoop(25);
            blocksize := Speed * Sound_Loops;
            Sampling_Frequency := 13333;
            init_Paramtable;
          end;
     16 : begin;
            Sampling_Rate := 196;
            set_timeconst_sb16(196);
            mod_transpose(14);
            mod_SetLoop(32);
            blocksize := Speed * Sound_Loops;
            Sampling_Frequency := 16666;
            init_Paramtable;
          end;
     22 : begin;
            Sampling_Rate := 211;
            set_timeconst_sb16(211);
            mod_transpose(19);
            mod_SetLoop(44);
            blocksize := Speed * Sound_Loops;
            Sampling_Frequency := 22222;
            init_Paramtable;
          end;
   end;
end;

procedure Sound_handler;
var li : integer;
begin;
 if mycli <> 0 then exit;
 mycli := 1;
 if (Loop_pos > Speed) then begin;
   if phase_2 then begin;
     Nothin_done_count := 0;
     asm
       call [nmw_proc]
     end;
     Initialize_Mix;
     Loop_pos := 0;
     phase_2 := FALSE;
     phase_1 := TRUE;
     if outfading then
       if outvolume >= 2 then dec(outvolume,2);
     for li := 1 to 8 do
       if Notes_Struck[li] > 50 then dec(Notes_Struck[li],50);
   end;
 end else begin;
     asm call [inside_proc] end;
   Loop_pos := Speed+2;
 end;
 mycli := 0;
end;

procedure calculate_music; assembler;
asm
 cmp mycli,0
 jne  @end_stop
 cmp  music_Off,0
 jne   @end_stop
 pusha
 call Sound_handler
 popa
 @end_stop:
end;

procedure mod_waitretrace(num : byte);
var dl : integer;
begin;
 in_retrace := TRUE;
 for dl := 1 to num do
    calculate_music;
asm
  push dx
@l1:
  mov dx,3dah
  in al,dx
  and al,8h
  jnz @l1
@l2:
  mov dx,3dah
  in al,dx
  and al,8h
  jz @l2
  pop dx
End;
 in_retrace := FALSE;
end;


function load_modfile(modname : string;ispeed,iloop : integer;freq : byte)
         : integer;
var df : file;
    sterreg : byte;
    fsz : longint;
begin;
 Playing_MOD := TRUE;
 Playing_VOC := FALSE;
 outfading := FALSE;
 outvolume := 63;
 Mod_Name := modname;
 {$I-}
 assign(df,Mod_name);
 reset(df,1);
 {$I+}
 if IOResult <> 0 then begin;
   {$I-}
   close(df);
   load_modfile := -1;                  { File not found !     }
   exit;
 end;
 {$I-}
 fsz := filesize(df);
 close(df);
 music_played := TRUE;
 music_Off := FALSE;
 Mod_At_End := FALSE;

 if ispeed <> AUTO then Speed3 := ispeed;
 if iloop <> AUTO then Loop3  := iloop;
 if force_mono then stereo := FALSE;
 if force_sb then begin;
   if Sb16Detected then stereo := FALSE;
   Sb16Detected := FALSE;
 end;

 if SBProdetected then begin;
   if stereo then begin;
     sterreg := Read_Mixer($0e);
     write_Mixer($0e,sterreg OR 2);
   end else begin;
     sterreg := Read_Mixer($0e);
     write_Mixer($0e,sterreg AND $FD);
   end;
 end;
 init_data;
 if init_song then begin;
   phase_1 := FALSE;
   phase_2 := TRUE;
   mycli := 0;

   mod_Samplefreq(freq);
   Playspeed    := 6;
   Speed := Playspeed*105 div 10;
   bpm := 125;
   mod_SetLoop(Sampling_Frequency div (BPM * 4));
   blocksize := Speed * Sound_Loops;
   if blocksize < 100 then blocksize := 100;
   if blocksize > 4000 then blocksize := 4000;

   asm call [nmw_proc] end;
   set_timeconst_sb16(Sampling_Rate);
   Initialize_Mix;
   Runsec := 0;
   Runmin := 0;
   wr_dsp_sb16($D1);
   if sb16detected or sbprodetected then begin;
	   filter_Mid;
     Set_Balance(Balance);
     Set_Volume(Mastervolume);
   end;
   Load_Modfile := 0;
 end else begin;
   Load_Modfile := -3;                  { Error loading song }
 end;
end;

procedure end_mod;
var mlj : integer;
begin;
 Free_Soundmem;
 for mlj := 1 to 31 do begin;
   freemem(Samp[mlj],Sam_l[mlj]);
 end;
 mod_terminated := TRUE;
end;


Procedure periodic_on;
Begin
 outvolume := 64;
 last_output := FALSE;
{ for Loop_pos := 1 to Speed do begin;}
   asm call [inside_proc] end;
{ end;}
 dsp_block_sb16(blocksize,blocksize,buffer1,TRUE,FALSE);
 Proc := not Proc;
 Loop_pos := 0;
 asm
   call [nmw_proc]
 end;
 Initialize_Mix;

 init_sbperiod(@periodic_off);
 music_played := TRUE;
 SetTimerOn(@NewTimer,timer_per_second);
End;

Procedure periodic_off;
Begin
  last_output := TRUE;
  SetTimerOff;
End;

procedure Fade_Musix_out;
begin;
  outfading := TRUE;
end;

procedure MODExitProc;
var mlj : byte;
 begin
 ExitProc := SaveExitProc;
{ if music_played then periodic_off;}
 if not mod_terminated and music_played then end_mod;
 Exit_Sb16;
end;



{

 **************************************************************************
 ***                                                                    ***
 ***                 Routines for outputting VOC files                  ***
 ***                                                                    ***
 **************************************************************************

}

var pause_voc : boolean;

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;
  Playing_MOD := FALSE;
  Playing_VOC := TRUE;
  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;
    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,vocb1^,blocksz);

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

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

  wr_dsp_sb16($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;
 pause_voc := FALSE;
 dsp_block_sb16(blocksz,blocksz,vocb1,FALSE,TRUE);
end;

procedure voc_done;
var h : byte;
begin;
 lastone := TRUE;
{ repeat until dsp_rdy_sb16;}
 close(vocf);
 Reset_Sb16;
 stereo := vocsstereo;
end;


procedure voc_pause;
begin;
  pause_voc := TRUE;
end;

procedure voc_continue;
begin;
  pause_voc := FALSE;
  if block_active = 1 then begin
    dsp_block_sb16(blocksz,blocksz,vocb2,FALSE,TRUE);
    block_active := 2;
  end else begin;
    dsp_block_sb16(blocksz,blocksz,vocb1,FALSE,TRUE);
    block_active := 1;
  end;
end;

{

 **************************************************************************
 ***                                                                    ***
 ***    More SB Routines                                                ***
 ***                                                                    ***
 **************************************************************************

}

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 Playing_MOD then begin;
      h := port[dsp_addr+$E];
      dsp_rdy_sb16 := TRUE;

      if not last_output then begin;
        if Proc then
          dsp_block_sb16(blocksize,blocksize,buffer1,TRUE,FALSE)
        else
          dsp_block_sb16(blocksize,blocksize,buffer2,TRUE,FALSE);
        Proc := not Proc;
        phase_1 := FALSE;
        phase_2 := TRUE;
      end;
    end;

    IF Playing_VOC then begin;
      h := port[dsp_addr+$E];
      if (fsz > blocksz) and not lastone then begin
        lastone := FALSE;
        if block_active = 1 then begin
          if not pause_voc then
            dsp_block_sb16(blocksz,blocksz,vocb2,FALSE,TRUE);
          blockread(vocf,vocb1^,blocksz);
          fsz := fsz - blocksz;
          block_active := 2;
        end else begin;
          if not pause_voc then
            dsp_block_sb16(blocksz,blocksz,vocb1,FALSE,TRUE);
          blockread(vocf,vocb2^,blocksz);
          fsz := fsz - blocksz;
          block_active := 1;
        end;
      end else begin;
        if not lastone then begin;
          if block_active = 1 then begin
            if not pause_voc then
              dsp_block_sb16(blocksz,blocksz,vocb2,FALSE,TRUE);
            lastone := TRUE;
          end else begin;
            if not pause_voc then
              dsp_block_sb16(blocksz,blocksz,vocb1,FALSE,TRUE);
            lastone := TRUE;
          end;
        end else begin;
          dsp_rdy_sb16 := TRUE;
          wr_dsp_sb16($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. It has found the right one if the routine jumps to the set interrupt at the end of 
 output.
}
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];
 fillchar(buffer1^,1200,128);
 set_Timeconst_sb16(211);
 wr_dsp_sb16($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);      { Deflect/Bend 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          }
     dsp_block_sb16(blocksize,blocksize,buffer1,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_sb16($D1);                      { Speaker back on    }
 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
 initialization was successful, otherwise it returns FALSE. The
 speaker for sampling output is switched on. The DMA ready 
 interrupt is deflected to a custom routine. 
}
begin;
  if not detect_Reg_sb16 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;    { 2. 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_sb16($D1);                      { Speaker on           }
 getintvec($8+dsp_irq,oldint);          { Store old interrupt,   }
 setintvec($8+dsp_irq,@dsp_int_sb16);   { set to custom routine  }
 irqmsk := 1 shl dsp_irq;               { mask on interrupt     }
 port[$21] := port[$21] and not irqmsk;
end;

function init_The_Mod : boolean;
begin;
 mod_autodetect(on);  { If TRUE, speed specifications detected in song       }
 mod_SetSpeed(66);
 mod_SetMultiply(11);
 mod_Setloopflag(ON);                   { Start output at begining again,}

                                        { when is reached ?  (ON / OFF) }
 if not init_sb then                    { enable speaker, auto detection}
   init_the_mod := FALSE
 else begin;
   init_the_mod := TRUE;
   mod_Samplefreq(Samfreq);
 end;
end;


begin;
 SaveExitProc := ExitProc;
 ExitProc := @MODExitProc;
 dsp_rdy_sb16 := TRUE;
 Mod_Terminated := FALSE;
 Music_Played := FALSE;
 Mloop := TRUE;
 mli := 0;
 mlj := 0;
 tpw := 5;
 In_St[1] := 0;
 In_St[2] := 0;
 In_St[3] := 0;
 In_St[4] := 0;
 In_St[5] := 0;
 In_St[6] := 0;
 In_St[7] := 0;
 In_St[8] := 0;
 loop_pos := 0;
 mautodet := TRUE;
 modmultiply := 20;
 Sound_Loops := 10;
 Notes_Struck[1] := 0;
 Notes_Struck[2] := 0;
 Notes_Struck[3] := 0;
 Notes_Struck[4] := 0;
 Notes_Struck[5] := 0;
 Notes_Struck[6] := 0;
 Notes_Struck[7] := 0;
 Notes_Struck[8] := 0;
 EmptyVoice := @Empty_Voice;
 Mixingprocs[1] := EmptyVoice;
 Mixingprocs[2] := EmptyVoice;
 Mixingprocs[3] := EmptyVoice;
 Mixingprocs[4] := EmptyVoice;
 Mixingprocs[5] := EmptyVoice;
 Mixingprocs[6] := EmptyVoice;
 Mixingprocs[7] := EmptyVoice;
 Mixingprocs[8] := EmptyVoice;
 Getmem(mixed_data,8000);
 Getmem(mixed_data_st,8000);
 Getmem(buffer1,8000);
 Getmem(buffer2,8000);
 Getmem(vocb1,8000);
 Getmem(vocb2,8000);
 Proc := TRUE;
end.

