{$A+,B-,D+,E+,F-,G+,I-,L+,N-,O-,P-,Q-,R-,S-,T-,V-,X+,Y+}
unit gus_mod;
{
 *************************************************************************
 ***                   ABACUS'  "PC UNDERGROUND"                       ***
 ***                  ================================                 ***
 ***                                                                   ***
 ***                       Modplayer-Unit GUS_MOD                      ***
 ***                                                                   ***
 *** The GUS_MOD unit plays back MODs using the Gravis Ultra-          ***
 *** sound, the most popular sound card in the Demo Scene.             ***
 ***                                                                   ***
 *** This unit was used to program the (FREEWARE) Mod-Player TCP V1.0  ***
 ***                                                                   ***
 ***                                                                   ***
 *** Author          : Boris Bertelsons  (InspirE)                     ***
 *** Filename        : GUS_MOD.PAS                                     ***
 *** Last update     : 06/28/94                                        ***
 *** Version         : 2.0                                             ***
 *** Compiler        : Turbo Pascal 6.0 and above                      ***
 *************************************************************************
}

interface
function  _gus_modload(name : string) : boolean;
{
 Loads the file passed in NAME into memory and GUS RAM. The
 function returns the value TRUE if the MOD file loads perfectly,
 otherwise the function returns the value FALSE.
}

procedure _gus_modstart;
{
 Starts output of a loaded MOD via the timer interrupt
}

procedure _gus_mod_end;
{
 Ends output of an MOD
}

procedure _gus_initialize; { Initializes the GUS }

function _gus_init_env : boolean;
{
 Initializes the GUS, no hardware detection, but rather checks the
 ULTRASND environment variable
}

procedure _gus_set_chanelpos;
{ Sets the position of the GUS channels }

{
 *************************************************************************
 ***               T Y P E -  D e c l a r a t i o n s                  ***
 *************************************************************************
}
type Song_header = record         { Global info about MOD file  }
       ID : string[25];
       SongName : string[30];
       Songlength : byte;
       Arrang : array[0..255] of byte;
       Num_Patts : byte;
       Num_Inst : byte;
     end;

type Modinfo = record
       Voices : word;
       Title  : string[20];
       Patt_num : word;
     end;

Type Runinfo = record
        Amplitude : array[1..8] of byte;
        Line,
        Pattnr   : integer;
        Volumes  : array[1..8] of byte;
        speed    : byte;
        bpm      : byte;
     end;

type
 PChannelInfo = ^TChannelInfo;
 TChannelInfo = record
   InstNr     : byte;             { Hardware variables       }
   Mempos     : longint;
   End1       : longint;
   Loop_Start : longint;
   Loop_End   : longint;

   Volume     : integer;          { MOD variables            }
   Frequency  : word;
   Looping    : byte;
   Tone       : integer;
   Start_Tone : integer;
   Destination_Tone   : integer;
   Effect     : byte;
   Operand    : byte;

   Effectx,                       { Effect variables         }
   Effecty      : integer;
   Arpegpos     : integer;
   slidespeed   : integer;
   vslide       : integer;
   retrig_count : byte;
   vibpos       : byte;
   vibx         : byte;
   viby         : byte;
 end;

 PInstrumenrInfo = ^TInstrumentInfo;
 TInstrumentInfo = record
   Name       : string[22];
   Mempos     : longint;
   End1       : longint;
   l_Start    : longint;
   l_end      : longint;
   Size       : word;
   Loop_Start : word;
   Loop_End   : word;
   Volume     : word;
   Looping    : byte;
 end;


{
 *************************************************************************
 ***             Global Constants and Variables                       ***
 *************************************************************************
}
Const
  Play_Chanel : array[1..14]      { for masking out channels }
    of byte = (1,1,1,1,1,1,1,     { 1 = GUS channel will be played       }
               1,1,1,1,1,1,1);    { 0 = GUS channel will not be played }

var Channels        : array[0..31] of PChannelInfo;
    Instruments     : array[0..31] of PInstrumenrInfo;
    MOD_Voices      : word;          { Number of voices (4/8) }
    MOD_Patternsize : word;         { Size of a MOD pattern in bytes  }
    stop_Thevoice   : array[1..8] of boolean;
    vh              : Song_Header;  { Global Song - Definitions }
    Modinfptr       : pointer;
    Modinf          : Modinfo;
    Runinf          : Runinfo;
    chpos           : array[1..8] of integer; { Pos. of channels in semicircle}


implementation
uses dos,crt,design,fselect;

const VibratoTable : array[0..63] of integer =(
	0,24,49,74,97,120,141,161,
	180,197,212,224,235,244,250,253,
	255,253,250,244,235,224,212,197,
	180,161,141,120,97,74,49,24,
	0,-24,-49,-74,-97,-120,-141,-161,
	-180,-197,-212,-224,-235,-244,-250,-253,
	-255,-253,-250,-244,-235,-224,-212,-197,
	-180,-161,-141,-120,-97,-74,-49,-24);

const Voice_Divisor : array[14..32] of byte =
       (43,40,37,35,33,31,30,28,27,26,25,24,23,22,21,20,20,19,18);
      Voice_Base : array[14..14] of longint =
       (88195);

const GUS_Environment : boolean = true;
  Modinstance : byte = 31;        { Number of instruments in a   }
                                  { MOD file (15 or 31)            }
  ModId : array[1..3] of          { IDs for 4-channel MODs     }
        String = ('M.K.','FLT4','4CHN');
  Chn6 : string = '6CHN';         { ID for 6-channel MODs       }
  chn8 : string = '8CHN';         { ID for 8-channel MODs       }
  ModIds : string                 { All MOD Ids for detection  }
    = 'M.K.FLT44CHN6CHN8CHN';
  Interrupt_speed : word = 50;    { Number of interrupt calls         }
  Num_Voices = 14;                { We are using 14 GUS channels ...  }
  U_Ram_Freepos : longint = 2;    { For managing GUS - RAM      }

  Play_Voice = 0; Stop_Voice = 3; { Constants for selecting the type   }
  Bit8       = 0; Bit16      = 4; { of voice to play ...      }
  No_Loop    = 0; With_Loop   = 8;
  Unidirect  = 0; Bidirect   = 16;
  Go_forw    = 0; Go_Back    = 64;

var GUS_envstr : string;
    GUS_BASE : word;
  oldv : array[0..15] of integer;
  tickcounter,                    { For speed control    }
  ticklimit    : word;
  oldtimer   : pointer;           { Pointer to old timer int.  }
  i            : Integer ;        { probably the most popular variable ;)  }
  gusmf        : file;            { For handling the MOD file        }
  Pattern      : array[0..127]    { Pointer to pattern in RAM    }
                 of pointer;


{$L Gusasm}
procedure U_StartVoice(Nr,Mode : byte); external;
{
 Starts the Gus channel passed in Nr in mode mode set by 
 Mode
}

procedure u_Voicefreq(Nr : byte;Freq : word); external;
{
 Sets the frequency Freq for the channel set in Nr
}

procedure u_VoiceBalance(Nr,balance : byte); external;
{
 For setting the balance of channels specified in Nr. Values from
 0 to 15 are allowed for balance, with 0 for left, 7 for middle and 15
 for right
}

procedure u_VoiceVolume(Nr : byte; Vol : word); external;
{
 Use this procedure to set the volume Vol for the channels specified in Nr
}

procedure u_delay; external;
{
 For waiting while accessing self-modified registers of GF1,
 for internal use
}

function  detect_gus : word; external;
{
 For detecting the GUS. The function returns a 0 if a card 
 was found, and a 1, if no GUS was detected. At the same time,
 this function sets the correct base port for the GUS.
}

procedure u_Initialize; external;
{
 Initializes the Gravis Ultrasound.
}

procedure Ultra_Mem2Gus(samp : pointer;start : longint;length1 : word); external;
{
 Use this procedure to copy a sample from RAM to GUS RAM.
 The sample addressed via samp is transferred by means of the Poke  
 method. Specify the length of the sample to be transferred in length1.
}

procedure gus_speaker_on; external;
{
 Switches on the GUS speaker.
}

procedure u_Voicedata(start,lsta,send : longint;Nr : word); external;
{
 Sets parameters for a channel. Start refers to the starting position of 
 the voice in GUS RAM, lsta is the start of the loop and send is the 
 end position of the channel. Use Nr to choose the number of the channel.
}

function  Ffactor(t:word) : word; external;
{
 The Ffactor function returns the corresponding frequency of the note
 number t for the GUS from the Mod-Frequency table
}

function  Notennr(height : word) : byte; external;
{
 Use this function to determine the number of the note from the value 
 for pitch passed in height from the MOD file.
}

procedure voice_rampin(Voice:byte;vol : word); external;
{
 This function is used to prevent samples from crackling at the 
 beginning. The voice selected in Voice is not immediately set
 to the volume passed in vol. Instead, the fastest possible GUS ramp 
 slides it from 0 to the volume.
 The procedure is a replacement for u_VoiceVolume.
}

procedure voice_slidein(nr,speed : byte;vol : word); external;
{
 Use this procedure to fade in a GUS channel. Nr is the number of  
 the channel to be faded. You pass the destination volume in vol. 
 The upper two bits specify the ramp speed and the lower 6 bits give
 the increment factor. A value of 63 gives you the fastest ramp, while
 a value of 192 is the slowest ramp.
}

procedure dos_getmem(var zeiger:pointer;menge:word); external;
{
 This procedure is a replacement for the Pascal Getmem procedure. 
 However, it uses DOS memory, thus it is vital for TSRs so that they  
 don't always allocate a constant memory area, but rather are able to 
 adapt the memory requirements to each MOD.
}

procedure dos_freemem(pointer:pointer); external;
{
 Dos_Freemem is the equivalent of the Pascal Freemem procedure. 
 Don't specify a size for the amount of memory to be freed up.
}

procedure init_gus_base(base : word); external;
{
 Initializes the Gravis Ultrasound with the address passed in Base.
}


{$L loadin}
procedure loadin; external;      { Ansi - Pic }


procedure init_the_gus(base : word);
begin;
  init_gus_base(base);
end;

procedure u_init;
var li : integer;
begin;
   u_Initialize;                  { Init in Assembler - section }
end;

FUNCTION ConvertString(Source : Pointer; Size : BYTE):String;
{
 Converts an ASCIIZ string to a Pascal string
}
VAR
   WorkStr : String;
BEGIN
   Move(Source^,WorkStr[1],Size);
   WorkStr[0] := CHR(Size);
   if pos(#0,Workstr) <> 0 then WorkStr[0] := chr(pos(#0,Workstr)-1);
   ConvertString := WorkStr;
END;

procedure Load_Instrument(Nr : byte);
{
 Loads the instrument with the number nr into GUS RAM
}
var gr : longint;
    samp : pointer;
begin;
   gr := Instruments[nr]^.Size;
   if gr > 10 then begin;      { Load only if  > 10, otherwise not worth it ! }
     dos_getmem(samp,gr);
     Blockread(gusmf,samp^,gr);
     U_Ram_freepos := U_Ram_freepos + (16-(U_Ram_freepos MOD 16));
     Instruments[nr]^.Mempos := U_Ram_freepos;
     Ultra_Mem2Gus(samp,Instruments[nr]^.Mempos,gr);
     dos_freemem(samp);           { initialize variables for Voices  }
     Instruments[nr]^.l_start :=
        Instruments[nr]^.Mempos + Instruments[nr]^.Loop_Start;
     if Instruments[nr]^.Looping = With_loop then begin;
        Instruments[nr]^.end1 :=
        Instruments[nr]^.Mempos + Instruments[nr]^.Loop_End;
     end else begin;
       Instruments[nr]^.end1 := Instruments[nr]^.Mempos + gr - 25;
     end;
     Inc(U_Ram_Freepos,gr);       { continue setting management pointer   }
   end;
end;

procedure New_Interrupt_Speed(speed : word);
{
 Sets the speed of the interrupt according to BpM.
}
var counter : word;
    loc,hic : byte;
begin;
 interrupt_speed := round(speed / 2.5);
 counter := 1193180 DIV interrupt_speed;
 loc := lo(counter);
 hic := hi(counter);
 asm
  cli
  mov dx,43h
  mov al,36h
  out dx,al
  mov dx,40h
  mov al,loc
  out dx,al
  mov al,hic
  out dx,al
  sti
 end;
end;

procedure _gus_set_chanelpos;
{
 Sets the position of the GUS channels
}
begin;
  u_VoiceBalance(1,chpos[1]);
  u_VoiceBalance(2,chpos[2]);
  u_VoiceBalance(3,chpos[3]);
  u_VoiceBalance(4,chpos[4]);
  u_VoiceBalance(5,chpos[5]);
  u_VoiceBalance(6,chpos[6]);
  u_VoiceBalance(7,chpos[7]);
  u_VoiceBalance(8,chpos[8]);
end;

procedure display_loading(s : string);
{
 Displays the progress in loading the sample.
}
var li,slen : integer;
var z : integer;
begin;
  for z := 0 to 12 do begin;
    move(ptr(seg(loadin),ofs(loadin)+z*34*2)^,ptr($B800,z*160+8*160+44)^,34*2);
  end;
  while pos('\',s) <> 0 do begin;
    delete(s,1,pos('\',s));
  end;
  slen := length(s);
  slen := (15 - slen) div 2;
  for li := 1 to slen do s := ' '+s;
  gotoxy(33,13);
  write(s);
end;

function _gus_modload(name : string) : boolean;
{
 Loads the MOD file passed in name. Requirements are that the 
 specified file in the path exists and is not write protected.
}
var dummya : array[0..30] of byte;{ For string handling       }
    daptr : pointer;              { Pointer to dummya                }
    dumw : word;                  { Dummy variables for reading/inputting <! zum Einlesen !>     }
    dumb : byte;
    Restlength1 : longint;        { For determining the pattern number     }
    li : integer;
    ID : array[1..4] of char;     { ID of the MOD file         }
    ias : integer;                { Instrument dependent start position  }
begin;
  U_Ram_freepos := 32;
  for li := 0 to 15 do begin;
    new(Channels[li]);
    channels[li]^.vibpos := 0;
  end;
  for li := 0 to 31 do begin;
     new(Instruments[li]);
     Instruments[li]^.Name := '';
  end;

  runinf.Line := 0;
  runinf.Pattnr := -1;
  tickcounter := 0;
  ticklimit := 6;
  runinf.speed := 6;
  runinf.bpm := 125;
  ias := 0;
  daptr := @dummya;

  assign(gusmf,name);             { open file and initialize length}
  reset(gusmf,1);

  save_screen;
  display_loading(name);

  Restlength1 := filesize(gusmf);
  Restlength1 := Restlength1  - 1084;

  seek(gusmf,1080);               { check whether MOD with 15/31 instruments}
  Blockread(gusmf,ID,4);
  if pos(ID,ModIDs) = 0 then begin;
    { 15 instruments ? }
    seek(gusmf,600);
    Blockread(gusmf,ID,4);
    if pos(ID,ModIDs) = 0 then begin;
      { Not a valid .MOD file }
      writeln('Not a valid .MOD file !!!');
      halt(0);
    end else begin;
      Modinstance := 15;
      ias := -16*30;
    end;
  end;

  if (ID = MODId[1]) or      { Voice number of MOD file ?       }
     (ID = MODId[2]) or
     (ID = MODId[3])
  then begin;
    MOD_Voices := 4;
    MOD_Patternsize := 4*256;
  end else
    if (ID = CHn6) then begin;
      _gus_modload := false;
      exit;
    end else
      if (ID = CHn8) then begin;
        MOD_Voices := 8;
        MOD_Patternsize := 8*256;
      end;

  seek(gusmf,0);
  Blockread(gusmf,dummya,20);     { Get file name        }
  vh.SongName := ConvertString(daptr,20);
  seek(gusmf,950+ias);            { Song length in patterns    }
  Blockread(gusmf,vh.Songlength,1);
  seek(gusmf,952+ias);            { Read in arrangement              }
  Blockread(gusmf,vh.Arrang,128);

  vh.Num_Inst := Modinstance;     { Read in (15/31) instruments       }
  seek(gusmf,20+ias);

  for li := 1 to 32 do Instruments[li]^.Name := '';

  for li := 1 to vh.Num_Inst do begin;
    Blockread(gusmf,dummya,22);   { Instruments - Name               }
    Instruments[li]^.Name := ConvertString(daptr,22);

    Blockread(gusmf,dumw,2);      { Length of sample                 }
    Instruments[li]^.Size := swap(dumw) * 2;

    Blockread(gusmf,dumb,1);      { read in volume               }
    Blockread(gusmf,dumb,1);
    Instruments[li]^.Volume := dumb;

    Blockread(gusmf,dumw,2);      { read in start of loop           }
    Instruments[li]^.Loop_Start := swap(dumw) * 2;
    Blockread(gusmf,dumw,2);

    dumw := swap(dumw) * 2;       { read in loop end from Start+Length }
    Instruments[li]^.Loop_End := Instruments[li]^.Loop_Start+dumw;

    if (Instruments[li]^.Loop_End -      { looping in instrument ?           }
        Instruments[li]^.Loop_Start) >= 10 then begin;
      Instruments[li]^.Looping := with_loop;
    end else begin;
      Instruments[li]^.Looping := no_loop;
    end;
    Dec(Restlength1,Instruments[li]^.Size);
  end;

  Vh.Num_Patts := Restlength1 DIV MOD_Patternsize ; { Pattern number ?    }
  seek(gusmf,1084+ias);

  for li := 1 to Vh.Num_Patts do begin; { read in pattern            }
    dos_getmem(Pattern[li],MOD_Patternsize );
    Blockread(gusmf,Pattern[li]^,MOD_Patternsize );
  end;

  for li := 1 to vh.Num_Inst do begin; { read in instruments         }
    Load_Instrument(li);
    screen[16,23+li].a := 5;
  end;

  close(gusmf);

  for i := 1 to 31 do begin; { initialize channel variables         }
    u_VoiceBalance (i,7) ;
    u_VoiceVolume (i,0) ;
    u_VoiceFreq (i,12000);
    U_StartVoice(i,Stop_Voice);
    u_Voicedata(0,0,0,i);
  end;
  runinf.Line := 0;                     { runtime - init. variables }
  runinf.Pattnr := -1;
  tickcounter := 0;
  ticklimit := 6;
  runinf.speed := 6;
  runinf.bpm := 125;
  if MOD_Voices = 4 then begin;  { arrrange channels in semicircle      }
    chpos[1] := 2;
    chpos[2] := 5;
    chpos[3] := 9;
    chpos[4] := 12;
    _gus_set_chanelpos;;
  end;
  if MOD_Voices = 8 then begin;
    chpos[1] := 1;
    chpos[2] := 3;
    chpos[3] := 5;
    chpos[4] := 7;
    chpos[5] := 7;
    chpos[6] := 9;
    chpos[7] := 11;
    chpos[8] := 13;
    _gus_set_chanelpos;;
  end;

  new_interrupt_Speed(runinf.bpm);
  restore_screen;
  Modinf.Voices   := MOD_Voices;   { constant MOD info in structure    }
  Modinf.Title    := vh.Songname;  { to be passed                      }
  Modinf.Patt_num := Vh.Songlength;
  _gus_modload    := true;
end;


procedure effect_vibrato(nr : byte);
{
 Vibrato procedure swapped from effect handling
}
var vibswap : integer;
begin;
  inc(Channels[nr]^.vibpos,Channels[nr]^.vibx);
  if Channels[nr]^.vibpos > 64 then
    dec(Channels[nr]^.vibpos,64);
  vibswap :=
    (VibratoTable[Channels[nr]^.vibpos] * Channels[nr]^.viby) div 256;
  inc(Channels[nr]^.Start_Tone,vibswap);
  if Channels[nr]^.Start_Tone < 1 then
    Channels[nr]^.Start_Tone := 1;
  Channels[nr]^.Frequency :=
    longint(Voice_Base[14] div Channels[nr]^.Start_Tone);
  u_VoiceFreq(nr,Channels[nr]^.Frequency);
end;


procedure E_toneportamento(nr : byte);
{
 TonePortamento procedure swapped from effect handling 
}
begin;
  if Channels[nr]^.slidespeed < 0 then
  begin
    inc(Channels[nr]^.Start_Tone,Channels[nr]^.slidespeed);
    if Channels[nr]^.Start_Tone < Channels[nr]^.Destination_Tone then
      Channels[nr]^.Start_Tone := Channels[nr]^.Destination_Tone;
  end else begin
    inc(Channels[nr]^.Start_Tone,Channels[nr]^.slidespeed);
    if Channels[nr]^.Start_Tone > Channels[nr]^.Destination_Tone then
      Channels[nr]^.Start_Tone := Channels[nr]^.Destination_Tone;
  end;

  if Channels[nr]^.Start_Tone < 1 then
    Channels[nr]^.Start_Tone := 1;
  Channels[nr]^.Frequency :=
    longint(Voice_Base[14] div Channels[nr]^.Start_Tone);
  u_VoiceFreq(nr,Channels[nr]^.Frequency);
  oldv[nr] := Channels[nr]^.Start_Tone;
end;

procedure EI_toneportamento(nr : byte);
{
 Init for vibrato procedure swapped from effect handling
}
begin;
  { determine Inc factor }
  if Channels[nr]^.Operand <> 0 then
  begin;
    if Channels[nr]^.Start_Tone > Channels[nr]^.Destination_Tone then
    begin;
      Channels[nr]^.slidespeed := -(Channels[nr]^.Operand);
    end else begin;
      Channels[nr]^.slidespeed := (Channels[nr]^.Operand);
    end;
  end;
  if Channels[nr]^.Start_Tone < 1 then
    Channels[nr]^.Start_Tone := 1;
  Channels[nr]^.Frequency :=
    longint(Voice_Base[14] div Channels[nr]^.Start_Tone);
  u_VoiceFreq(nr,Channels[nr]^.Frequency);
  oldv[nr] := Channels[nr]^.Start_Tone;
end;

procedure Initialize_Effects(nr : byte);
var swaplong      : longint;
    vibswap       : integer;
begin;
  if Channels[nr]^.Effect = 0 then exit;
  case Channels[nr]^.Effect of
    0 : begin; { Arpeggio }
          Channels[nr]^.Arpegpos := 0;
          Channels[nr]^.Effectx := Channels[nr]^.Operand shr 4;
          Channels[nr]^.Effecty := Channels[nr]^.Operand and $0f;

          inc(Channels[nr]^.Arpegpos);
          case (Channels[nr]^.Arpegpos MOD 3) of
            0 : begin; {ap = 3 !}
                  Channels[nr]^.Start_Tone :=
                  Channels[nr]^.Tone + Channels[nr]^.Effecty;
                end;
            1 : begin; {ap = 1 !}
                  Channels[nr]^.Start_Tone :=
                  Channels[nr]^.Tone;
                end;
            2 : begin; {ap = 2 !}
                  Channels[nr]^.Start_Tone :=
                  Channels[nr]^.Tone + Channels[nr]^.Effectx;
                end;
          end;
          if Channels[nr]^.Start_Tone < 1 then
            Channels[nr]^.Start_Tone := 1;
          Channels[nr]^.Frequency :=
            longint(Voice_Base[14] div Channels[nr]^.Start_Tone);
          u_VoiceFreq(nr,Channels[nr]^.Frequency);
        end;
    1 : begin;  { Portamento up }
          dec(Channels[nr]^.Start_Tone,Channels[nr]^.Operand);
          if Channels[nr]^.Start_Tone < 1 then
            Channels[nr]^.Start_Tone := 1;
          Channels[nr]^.Frequency :=
            longint(Voice_Base[14] div Channels[nr]^.Start_Tone);
          u_VoiceFreq(nr,Channels[nr]^.Frequency);
        end;
    2 : begin;  { Portamento down }
          inc(Channels[nr]^.Start_Tone,Channels[nr]^.Operand);
          if Channels[nr]^.Start_Tone < 1 then
            Channels[nr]^.Start_Tone := 1;
          Channels[nr]^.Frequency :=
            longint(Voice_Base[14] div Channels[nr]^.Start_Tone);
          u_VoiceFreq(nr,Channels[nr]^.Frequency);
        end;
    3 : begin; { Tone Portamento }
          EI_toneportamento(nr);
        end;
    4 : begin;  { Vibrato  *new* }
          Channels[nr]^.vibx := Channels[nr]^.Operand shr 4;
          Channels[nr]^.viby := Channels[nr]^.Operand and $0f;
          effect_vibrato(nr);
        end;
    5 : begin; {NOTE SLIDE + VOLUME SLIDE:   *new* }
          { init }
          if Channels[nr]^.Operand <= $0f then
          begin;
            Channels[nr]^.vslide := -(Channels[nr]^.Operand AND $0f);
            Channels[nr]^.slidespeed := -(Channels[nr]^.Operand AND $0f);
          end else begin;
            Channels[nr]^.vslide := (Channels[nr]^.Operand shr 4);
            Channels[nr]^.slidespeed := (Channels[nr]^.Operand shr 4);
          end;
          { volume slide }
          inc(Channels[nr]^.volume,Channels[nr]^.vslide);
          if Channels[nr]^.volume < 0 then Channels[nr]^.volume := 0;
          if Channels[nr]^.volume > 63 then Channels[nr]^.volume := 63;
          u_VoiceVolume(Nr,Channels[nr]^.volume);
          { Note slide }
          inc(Channels[nr]^.Start_Tone,Channels[nr]^.slidespeed);
          if Channels[nr]^.Start_Tone < 1 then
            Channels[nr]^.Start_Tone := 1;
          Channels[nr]^.Frequency :=
            longint(Voice_Base[14] div Channels[nr]^.Start_Tone);
          u_VoiceFreq(nr,Channels[nr]^.Frequency);
        end;
    6 : begin;  { Vibrato & Volume slide  *new* }
          { init }
          Channels[nr]^.vibx := Channels[nr]^.Operand shr 4;
          Channels[nr]^.viby := Channels[nr]^.Operand and $0f;
          if Channels[nr]^.Operand <= $0f then
          begin;
            Channels[nr]^.vslide := -(Channels[nr]^.Operand AND $0f);
          end else begin;
            Channels[nr]^.vslide := (Channels[nr]^.Operand shr 4);
          end;
          { volume slide }
          inc(Channels[nr]^.volume,Channels[nr]^.vslide);
          if Channels[nr]^.volume < 0 then Channels[nr]^.volume := 0;
          if Channels[nr]^.volume > 63 then Channels[nr]^.volume := 63;
          u_VoiceVolume(Nr,Channels[nr]^.volume);
          { vibrato }
          effect_vibrato(nr);
        end;
    7 : begin; { tremolo  *new* }
           Channels[nr]^.vibx := Channels[nr]^.Operand shr 4;
           Channels[nr]^.viby := Channels[nr]^.Operand and $0f;
           inc(Channels[nr]^.vibpos,Channels[nr]^.vibx);
           if Channels[nr]^.vibpos > 64 then
             dec(Channels[nr]^.vibpos);
           vibswap :=
             (VibratoTable[Channels[nr]^.vibpos] * Channels[nr]^.viby) div 256;
           inc(Channels[nr]^.Volume,vibswap);
           if Channels[nr]^.Volume < 0 then Channels[nr]^.Volume := 0;
           if Channels[nr]^.Volume > 63 then Channels[nr]^.Volume := 63;
           u_VoiceVolume(nr,Channels[nr]^.volume);
        end;
    8 : begin; { not used !!! }
          {
           Not used officially. Therefore well suited for synchronizing 
           specific events in a demo ...
          }
        end;
    9 : begin;  { Sample - Offset *new* }
          swaplong := longint((Channels[nr]^.Operand+1)) * 256;
          Channels[nr]^.Mempos := Channels[nr]^.Mempos+swaplong;
          u_Voicedata(Channels[nr]^.Mempos,Channels[nr]^.Loop_Start,
                    Channels[nr]^.End1,nr);
          U_StartVoice(nr,Play_Voice+Bit8+Channels[nr]^.Looping+Unidirect);
        end;
   $a : begin;  { Volume sliding  *new* }
          if Channels[nr]^.Operand <= $0f then
          begin;
            Channels[nr]^.vslide := -(Channels[nr]^.Operand AND $0f);
          end else begin;
            Channels[nr]^.vslide := (Channels[nr]^.Operand shr 4);
          end;
          inc(Channels[nr]^.volume,Channels[nr]^.vslide);
          if Channels[nr]^.volume < 0 then Channels[nr]^.volume := 0;
          if Channels[nr]^.volume > 63 then Channels[nr]^.volume := 63;
          u_VoiceVolume(Nr,Channels[nr]^.volume);
        end;
   $b : begin; { Position Jump *ok* }
          runinf.Line := 64;
          runinf.Pattnr := Channels[nr]^.Operand;
        end;
   $c : begin; { Set Note Volume *ok* }
          if Channels[nr]^.Operand > 63 then Channels[nr]^.Operand := 63;
          if Channels[nr]^.Operand < 1 then
          begin
            Channels[nr]^.volume := 0;
            u_VoiceVolume(nr,0);
            U_StartVoice(nr,Stop_Voice);
            stop_Thevoice[nr] := true;
          end else begin
            Channels[nr]^.volume := Channels[nr]^.Operand;
            u_VoiceVolume(Nr,Channels[nr]^.volume);
            Runinf.Volumes[nr] := 63;
          end;
        end;
   $d : begin; { Patterm Break *ok* }
          runinf.Line := 64;
        end;
   $e : begin;  { Enhanced Effect - command }
          case (Channels[nr]^.Operand shr 4) of
            1 : begin; { Fine slide up }
                  dec(Channels[nr]^.Start_Tone,Channels[nr]^.Operand and $0f);
                  if Channels[nr]^.Start_Tone < 1 then Channels[nr]^.Start_Tone := 1;
                  Channels[nr]^.Frequency :=
                    longint(Voice_Base[14] div Channels[nr]^.Start_Tone);
                  u_VoiceFreq(nr,Channels[nr]^.Frequency);
                end;
            2 : begin; { Fine slide down }
                  inc(Channels[nr]^.Start_Tone,Channels[nr]^.Operand and $0f);
                  if Channels[nr]^.Start_Tone < 1 then Channels[nr]^.Start_Tone := 1;
                  Channels[nr]^.Frequency :=
                    longint(Voice_Base[14] div Channels[nr]^.Start_Tone);
                  u_VoiceFreq(nr,Channels[nr]^.Frequency);
                end;
            9 : begin; { Retriggering !!! *new* }
                  Channels[nr]^.Retrig_count :=
                    Channels[nr]^.Operand and $0f;
                end;
           $a : begin; { fine volume slide up }
                  Channels[nr]^.vslide := (Channels[nr]^.Operand AND $0f);
                  inc(Channels[nr]^.volume,Channels[nr]^.vslide);
                  if Channels[nr]^.volume < 0 then Channels[nr]^.volume := 0;
                  if Channels[nr]^.volume > 63 then Channels[nr]^.volume := 63;
                  u_VoiceVolume(Nr,Channels[nr]^.volume);
                end;
           $b : begin; { fine volume slide down }
                  Channels[nr]^.vslide := (Channels[nr]^.Operand AND $0f);
                  dec(Channels[nr]^.volume,Channels[nr]^.vslide);
                  if Channels[nr]^.volume < 0 then Channels[nr]^.volume := 0;
                  if Channels[nr]^.volume > 63 then Channels[nr]^.volume := 63;
                  u_VoiceVolume(Nr,Channels[nr]^.volume);
                end;
           $c : begin;  { Cut Voice *ok* }
                  stop_Thevoice[nr] := true;
                end;
           end;
        end;
   $f : begin; { Set Speed  *ok* }
          if Channels[nr]^.Operand <= $f then begin;
            ticklimit := Channels[nr]^.Operand;
            runinf.speed := ticklimit;
          end else begin;
            runinf.bpm := Channels[nr]^.Operand;
            new_interrupt_Speed(Channels[nr]^.Operand);
          end;
        end;
  end;
end;

procedure play_pattern_gus;
{
 This procedure is called periodically. It plays back a line of the MOD
 file.
}
var li        : integer;
    dumw      : word;
    The_Line : array[1..8,0..3] of Byte;
    Effect    : byte;
    Tone       : word;
    Inst      : byte;
begin;
{
 **************************************************************************
 ***   Move forward in Mod                                                 ***
 **************************************************************************
}
  inc(runinf.Line);              { Move forward one line              }
  if runinf.Line > 64 then runinf.Line := 1;
  if runinf.Line = 1 then begin; { New Pattern ?                   }
    inc(runinf.Pattnr);
    if runinf.Pattnr > vh.Songlength then runinf.Pattnr := 1;
  end;
                                  { load notes                       }
  move(ptr(seg(pattern[vh.Arrang[runinf.Pattnr]+1]^),
       ofs(pattern[vh.Arrang[runinf.Pattnr]+1]^)+
          (runinf.Line-1)*4*Mod_Voices)^,
       The_Line,4*8);

{
 **************************************************************************
 ***   Process voices                                                   ***
 **************************************************************************
}
  for li := 1 to MOD_Voices do begin;
    if play_chanel[li] = 1 then begin;
      stop_Thevoice[li] := false;

      Tone  := ((The_Line[li,0] AND $0f) shl 8)+The_Line[li,1];
      Inst := (The_Line[li,0] AND $f0)+((The_Line[li,2] AND $F0) SHR 4);
      Channels[li]^.Effect   := The_Line[li,2] AND $0f;
      Channels[li]^.Operand := The_Line[li,3];

      Channels[li]^.Start_Tone := oldv[li];

      if Tone <> 0 then begin;  { Tone entered ??? }
        if Channels[li]^.Effect = 3 then begin;
          Channels[li]^.Destination_Tone := Tone;
        end else begin;
          Channels[li]^.Tone := Tone;
          Channels[li]^.Start_Tone := Tone;
          oldv[li] := Channels[li]^.Start_Tone;
        end;
      end;

      If Inst <> 0 then begin; { use new instrument ??? }
        Channels[li]^.InstNr     := Inst;
        Channels[li]^.Mempos     := Instruments[Channels[li]^.InstNr]^.Mempos;
        Channels[li]^.Loop_Start := Instruments[Channels[li]^.InstNr]^.l_start;
        Channels[li]^.End1       := Instruments[Channels[li]^.InstNr]^.end1;
        Channels[li]^.volume     := Instruments[Channels[li]^.InstNr]^.volume;
        Channels[li]^.Looping    := Instruments[Channels[li]^.InstNr]^.Looping;
        u_Voicedata(Channels[li]^.Mempos,Channels[li]^.Loop_Start,
                    Channels[li]^.End1,li);
      end;
      Channels[li]^.Retrig_count := 0;

      Initialize_Effects(li);


      If (Tone <> 0) then begin; { Note struck }
        Channels[li]^.Frequency := longint(Voice_Base[14] div Channels[li]^.Start_Tone);
        u_VoiceFreq(li,Channels[li]^.Frequency); { set frequency }


        if Channels[li]^.Effect = $c then begin; { Extra, because otherwise too early ! }
          if Channels[li]^.Operand > 63 then Channels[li]^.Operand := 63;
          if Channels[li]^.Operand < 1 then
          begin
            Channels[li]^.volume := 0;
            u_VoiceVolume(li,0);
            U_StartVoice(li,Stop_Voice);
            stop_Thevoice[li] := true;
          end else begin
            Channels[li]^.volume := Channels[li]^.Operand;
            u_VoiceVolume(li,Channels[li]^.volume);
            Runinf.Volumes[li] := 63;
          end;
        end else begin;
          if Channels[li]^.volume > 63 then Channels[li]^.volume := 63;
           voice_rampin(li,Channels[li]^.volume);
           Runinf.Volumes[li] := 63;
        end;

        U_StartVoice(li,Stop_Voice); { stop old voice }

        u_Voicedata(Channels[li]^.Mempos,Channels[li]^.Loop_Start,
                    Channels[li]^.End1,li);
        if not stop_Thevoice[li] then begin; { start new voice }
          U_StartVoice(li,Play_Voice+Bit8+Channels[li]^.Looping+Unidirect);
          Runinf.Amplitude[li] := Channels[li]^.volume * 4; { For Equalizer }
        end;
      end; { Note struck }
    end else begin;
      u_VoiceVolume(li,0);
    end;
  end; {for}
end;

procedure tick_effects;
var li : integer;
    vibswap : integer;
begin;
  for li := 1 to MOD_Voices do begin;
    if runinf.volumes[li] > 0 then
      dec(runinf.volumes[li]);
    case Channels[li]^.Effect of { runtime - process effects         }
      0 : begin;
            inc(Channels[li]^.Arpegpos);
            case (Channels[li]^.Arpegpos MOD 3) of
              0 : begin; {ap = 3 !}
                    Channels[li]^.Start_Tone :=
                    Channels[li]^.Tone + Channels[li]^.Effecty;
                  end;
              1 : begin; {ap = 1 !}
                    Channels[li]^.Start_Tone :=
                    Channels[li]^.Tone;
                  end;
              2 : begin; {ap = 2 !}
                    Channels[li]^.Start_Tone :=
                    Channels[li]^.Tone + Channels[li]^.Effectx;
                  end;
             end;
          end;
      1 : begin;
          {!"! new }
            Channels[li]^.Operand := Channels[li]^.Operand and $0F;
          {!"! new end }
            dec(Channels[li]^.Start_Tone,Channels[li]^.Operand);
            if Channels[li]^.Start_Tone < 1 then
              Channels[li]^.Start_Tone := 1;
            Channels[li]^.Frequency :=
              longint(Voice_Base[14] div Channels[li]^.Start_Tone);
            u_VoiceFreq(li,Channels[li]^.Frequency);
          end;
      2 : begin;
          {!"! new }
            Channels[li]^.Operand := Channels[li]^.Operand and $0F;
          {!"! new end }
            inc(Channels[li]^.Start_Tone,Channels[li]^.Operand);
            if Channels[li]^.Start_Tone < 1 then
              Channels[li]^.Start_Tone := 1;
            Channels[li]^.Frequency :=
              longint(Voice_Base[14] div Channels[li]^.Start_Tone);
            u_VoiceFreq(li,Channels[li]^.Frequency);
          end;
      3 : begin; { Tone Portamento }
            E_toneportamento(li);
          end;
      4 : begin;  { vibrato  *new* }
            effect_vibrato(li);
          end;
     5 : begin;
           { volume slide }
           inc(Channels[li]^.volume,Channels[li]^.vslide);
           if Channels[li]^.volume < 0 then Channels[li]^.volume := 0;
           if Channels[li]^.volume > 63 then Channels[li]^.volume := 63;
           u_VoiceVolume(li,Channels[li]^.volume);
           { Note slide }
           inc(Channels[li]^.Start_Tone,Channels[li]^.slidespeed);
            if Channels[li]^.Start_Tone < 1 then
              Channels[li]^.Start_Tone := 1;
           Channels[li]^.Frequency :=
             longint(Voice_Base[14] div Channels[li]^.Start_Tone);
           u_VoiceFreq(li,Channels[li]^.Frequency);
         end;
     6 : begin;
           { volume slide }
           inc(Channels[li]^.volume,Channels[li]^.vslide);
           if Channels[li]^.volume < 0 then Channels[li]^.volume := 0;
           if Channels[li]^.volume > 63 then Channels[li]^.volume := 63;
           u_VoiceVolume(li,Channels[li]^.volume);
           { vibrato }
           inc(Channels[li]^.vibpos,Channels[li]^.vibx);
           if Channels[li]^.vibpos > 64 then
             dec(Channels[li]^.vibpos);
           vibswap :=
             (VibratoTable[Channels[li]^.vibpos] * Channels[li]^.viby) div 256;
           inc(Channels[li]^.Start_Tone,vibswap);
            if Channels[li]^.Start_Tone < 1 then
              Channels[li]^.Start_Tone := 1;
           Channels[li]^.Frequency :=
             longint(Voice_Base[14] div Channels[li]^.Start_Tone);
           u_VoiceFreq(li,Channels[li]^.Frequency);
         end;
     7 : begin; { tremolo  *new* }
            inc(Channels[li]^.vibpos,Channels[li]^.vibx);
            if Channels[li]^.vibpos > 64 then
              dec(Channels[li]^.vibpos);
            vibswap :=
              (VibratoTable[Channels[li]^.vibpos] * Channels[li]^.viby) div 256;
            inc(Channels[li]^.Volume,vibswap);
            if Channels[li]^.Volume < 0 then Channels[li]^.Volume := 0;
            if Channels[li]^.Volume > 63 then Channels[li]^.Volume := 63;
            u_VoiceVolume(li,Channels[li]^.volume);
         end;
    8 : begin; { not used !!! }
        end;
    $a : begin; { Volume sliding   **new* }
           inc(Channels[li]^.volume,Channels[li]^.vslide);
           if Channels[li]^.volume < 0 then Channels[li]^.volume := 0;
           if Channels[li]^.volume > 63 then Channels[li]^.volume := 63;
           u_VoiceVolume(li,Channels[li]^.volume);
         end;
    $e : begin;  { Enhanced effect - command }
          case (Channels[li]^.Operand shr 4) of
              9: begin; { Retriggering !!! }
                   if Channels[li]^.Operand and $0f <> 0 then begin;
                     dec(Channels[li]^.Retrig_count);
                     if Channels[li]^.Retrig_count = 0 then begin;
                       Channels[li]^.Retrig_count := Channels[li]^.Operand and $0f;
                       u_Voicedata(Channels[li]^.Mempos,Channels[li]^.Loop_Start,
                              Channels[li]^.End1,li);
                       U_StartVoice(li,Play_Voice+Bit8+Channels[li]^.Looping+Unidirect);
                     end;
                   end;
                 end;
           end;
        end;
    end;
  end;
end;

{$F+}
procedure mytimer; interrupt;
{
 My Timer Interrupt
}
begin;
  tick_effects;
  inc(tickcounter);
  if tickcounter >= ticklimit then begin;
    Tickcounter := 0;
    Play_Pattern_gus;
  end;
  Port[$20] := $20;
end;

procedure do_nothing; interrupt;
{
 Dummy interrupt. Program switches to this interrupt when output is paused/stopped.
}
begin;
  port[$20] := $20;
end;

procedure _gus_modstart;
{
 Starts output of MOD file via the timer interrupt. MOD file
 must already be loaded !
}
var counter : word;
    loc,hic : byte;
begin;
 counter := 1193180 DIV interrupt_speed;
 loc := lo(counter);
 hic := hi(counter);
 asm
  cli
  mov dx,43h
  mov al,36h
  out dx,al
  mov dx,40h
  mov al,loc
  out dx,al
  mov al,hic
  out dx,al
 end;
 getintvec(8,oldtimer);
 setintvec(8,@Mytimer);
 asm sti end;
end;


procedure _gus_player_pause;
{
 Pauses output via the timer interrupt
}
var li : integer;
begin;
 setintvec(8,@Do_nothing);
 for li := 0 to 31 do
   u_VoiceVolume (li,0) ;
end;

procedure _gus_player_continue;
{
 Continues output via the timer interrupt.
}
var li : integer;
begin;
 setintvec(8,@Mytimer);
 for li := 1 to 31 do
   Voice_Rampin(li,Channels[li]^.volume);
end;

procedure timerint_reset;
{
 Resets the timer interrupt to its original value.
}
begin;
 asm
  cli
  mov dx,43h
  mov al,36h
  out dx,al
  xor ax,ax
  mov dx,40h
  out dx,al
  out dx,al
 end;
 setintvec(8,oldtimer);
 asm sti end;
end;

procedure dispose_mod;
{
 Removes a loaded MOD from RAM. The samples on the GUS are
 NOT deleted.
}
begin;
  for i := 0 to 31 do begin;
    U_StartVoice(i,Stop_Voice);
  end;
  for i := 1 to Vh.Num_Patts do begin;
    dos_freemem(Pattern[i]);
  end;
  for i := 0 to 15 do begin;
    dispose(Channels[i]);
  end;
  for i := 0 to 31 do begin;
     dispose(Instruments[i]);
  end;
end;

procedure _gus_mod_end;
{
 Ends output of a MOD
}
begin;
  timerint_reset;
  dispose_mod;
end;

procedure _gus_initialize;
{
 Initializes the GUS
}
begin;
  u_init;
  gus_speaker_on;
end;

procedure get_from_environment;
{
 Determines the base address of the GUS from the ULTRASND 
 environment variable
}
var apos,ipos,dpos : integer;
    astr,istr,dstr,gusstr : string;
    code : integer;
begin;
  GUS_envstr := GetEnv('ULTRASND');

 { detect GUS base }
  gusstr := Copy(GUS_envstr,1,3);
  val(gusstr,GUS_BASE,code);
  if code <> 0 then begin;
    GUS_Environment := false;
  end else
    GUS_Environment := true;
end;

function dec_2_hex(w : word) : word;
{
 Converts a decimal number to a hex number. Important for handling 
 environment
}
const exp : array[1..4] of word = (4096,256,16,0);
var c,hs : string;
    v,i,li : integer;
begin;
  str(w,hs);
  while length(hs) < 4 do hs := '0'+hs;
  w := 0;
  for li := 1 to 4 do begin;
    c := hs[li];
    val(c,v,i);
    w := w + v * exp[li];
  end;
  dec_2_hex := w;
end;

procedure write_environment;
{
 Outputs the GUS BASE address determined from the environment 
}
begin;
  if GUS_Environment then begin;
    writeln('þ GUS_BASE: ',GUS_BASE);
    writeln('þ initializing Gravis Ultrasound Card');
    gus_base := dec_2_hex(gus_base);
    init_the_gus(Gus_base);
    delay(777);
  end else begin;
    writeln('The environment variable ULTRASND is not set !');
    delay(777);
  end;
end;

function _gus_init_env : boolean;
{
 Initializes the GUS, no hardware detection but rather checks the 
 ULTRASND environment variable
}
begin;
  clrscr;
  get_from_environment;
  write_environment;
  _gus_init_env := gus_environment;
end;

begin;
end.
