Sound, Music & MIDI Collection 2/SMMVOL2.bin/PROG/ASMOD09S.ZIP/GUSMOD.PAS

Pascal/Delphi Source File | 1994-11-02 | 30.8 KB | 1,050 lines

{ ────────────────────────────────────────────────────────────────────────

  This code is Copyright (c) 1994 by Jonathan E. Wright and AmoebaSoft.

  To communicate with the author, send mail to: [e-mail]

  About this code:
    version 0.90p - sorry there aren't tons of comments.  Hey, be happy.

    Not all MOD effects are implemented, see ASMOD.DOC
    No DMA utilities are provided, so samples are peeked and poked to GUS RAM
    This unit automatically checks for and initializes the UltraSound if present
    Read the notes in GUSUTIL.ASM for more info

    This code is modified somewhat from that used in ASMOD and was thrown
    together rather quickly.  I had a lot of other units that were tied
    together through things like the timer interrupt but they aren't near
    neat enough to release.  And of course they had some stuff that I just
    don't *want* to release.  I managed to mangle this source up pretty bad,
    not to mention fixing some stupid things I noticed along the way. So,
    if you encounter any problems email me at the address mentioned above.

    If you use this code in any of your programs, or as a basis for anything
    else you may write, please give credit to Nelno the Amoeba.  A postcard
    from your country or town would also be nice.  Send it to:

    Nelno
    58 1/2 Woodland Rd.
    Asheville, NC 28804-3823
    USA

  ──────────────────────────────────────────────────────────────────────── }

{$A+,B-,D-,L-,Q-,O-,R-,S-,T-,V-,X+,Y-}

UNIT GUSMod;

Interface

USES
  NewCrt, DOS, GUSHeap, Types, Strings;

{ GUSUtil stuff }

CONST
  Board        : BYTE = 0;              { 3 = GUS }
  MODSpeed     : WORD = 6;              { ticks per pattern line            }
  CurLine      : WORD = 0;              { current pattern line              }
  CurPattern   : WORD = 0;              { current pattern                   }
  ScriptPos    : WORD = 0;
  MODPlaying   : BOOLEAN = FALSE;
  MODFlag      : BYTE = 0;
  MODVolume    : WORD = 100;            { MOD Volume can be 0 - 100%    }

  UpdateChannelRecs  : BOOLEAN = TRUE;
  UpdateChannelWaves : BOOLEAN = FALSE;

  ActiveVoices : WORD = 13;
  CurVoice     : BYTE = $FF;

  Stop      = 2;
  Bit16     = 4;
  Loop      = 8;
  Bidirec   = 16;
  IRQAtEnd  = 32;
  Backward  = 64;

  Scale0    = 0;
  Scale8    = 1;
  Scale64   = 2;
  Scale512  = 3;

  RampStop  = 3;
  RampRoll  = 4;
  RampLoop  = 8;
  RampBidir = 16;
  RampIRQ   = 32;
  RampDec   = 64;

VAR
  GUS_Base      : WORD;
  GUS_IRQ       : WORD;
  GUS_Status    : WORD;
  GUS_TimerCon  : WORD;
  GUS_TimerData : WORD;
  GUS_IRQDMACon : WORD;
  GUS_MidiCon   : WORD;
  GUS_MidiData  : WORD;
  GUS_Voice     : WORD;
  GUS_Command   : WORD;
  GUS_DataLo    : WORD;
  GUS_DataHi    : WORD;
  GUS_DRAMIO    : WORD;

  GUS_Mixer     : BYTE;

  PreMODInt8    : POINTER;

FUNCTION  GUS_ReadVoicePos (Voice : BYTE): LONGINT;
FUNCTION  GUS_Peek (Address : LONGINT): SHORTINT;
PROCEDURE GUS_Poke (Address : LONGINT; v : SHORTINT);
FUNCTION  GUS_Mem : WORD;
PROCEDURE GUS_SetActiveVoices (Voices : BYTE);
PROCEDURE GUS_VoiceFreq (VoiceNum : BYTE; Hertz : WORD);
PROCEDURE GUS_VoiceAddr (VoiceNum : BYTE; CurPtr, Start, EndAddr : LONGINT);
PROCEDURE GUS_VoiceVolume (VoiceNum : BYTE; Volume : WORD);
PROCEDURE GUS_VoiceMode (Voice : BYTE; Mode : BYTE);
FUNCTION  GUS_ReadVoiceMode (Voice : BYTE): BYTE;
PROCEDURE GUS_StopVoice (Voice : BYTE);
PROCEDURE GUS_StartVoice (Voice : BYTE);
PROCEDURE GUS_SpeakerOn;
PROCEDURE GUS_SpeakerOff;
PROCEDURE GUS_Reset;
PROCEDURE GUS_VoiceBalance (Voice, Balance : BYTE);
PROCEDURE GUS_RampRate (Voice, Increment, Scale : BYTE);
PROCEDURE GUS_RampVolume (Voice, StartVol, EndVol : BYTE);
PROCEDURE GUS_VolumeControl (Voice, ControlByte : BYTE);
FUNCTION  GUS_TestBaseAddress : BOOLEAN;
PROCEDURE GUS_MoveSample (DosAddr, GUSAddr : LONGINT; Len : WORD);
PROCEDURE GUS_SetClockRate (Rate : WORD);
PROCEDURE GUS_SetTimer;
PROCEDURE GUS_ResetTimer;
PROCEDURE GUS_SetIRQ;
PROCEDURE GUS_RestoreIRQ;
PROCEDURE GUS_MODInit;
PROCEDURE GUS_MODDeInit;
PROCEDURE GUS_StartMOD;
PROCEDURE GUS_StopMOD;

PROCEDURE GUS_DetectCard;
PROCEDURE GUS_LoadSample (FName : STRING; VAR GPtr : GUS_Ptr);
PROCEDURE GUS_LoadRAW (FName : STRING; VAR GPtr : GUS_Ptr);

{ GUSMOD specific stuff }

CONST
  MaxTracks = 8;

  DebugMOD  = FALSE;

TYPE
  InstrType = RECORD
                GPtr     : GUS_Ptr;
                Len      : WORD;
                FineTune : SHORTINT;
                Volume   : BYTE;
                RepOfs   : WORD;
                RepLen   : WORD;
                Name     : STRING [22];
              END;


  PatternPtr = ^PatternType;

  NoteType = RECORD
               InstNum   : BYTE;
               Period    : WORD;
               Effect    : BYTE;
               EffectArg : BYTE;
               NoteName  : BYTE;
             END;

  PatLineType = ARRAY [0..MaxTracks - 1] OF NoteType;

  PatternType = ARRAY [0..63] OF PatLineType;

  ModPtr  = ^ModType;

  ModType = RECORD
              Samples    : ARRAY [0..30] OF InstrType;
              Patterns   : ARRAY [0..127] OF PatternPtr;
              PatScript  : ARRAY [0..127] OF BYTE;
              NumPats    : BYTE;
              EndJumpPos : BYTE;
              FormatTag  : ARRAY [0..4] OF CHAR;

              NumChans   : BYTE;
              TotalPats  : BYTE;
              NumIns     : BYTE;

              Name       : STRING;
            END;

  ChannelRec = RECORD
                 ChannelOn  : BOOLEAN;
                 ChannelVol : SHORTINT;
                 ChannelHit : BYTE;
                 Wave       : ARRAY [0..79] OF SHORTINT;
               END;

PROCEDURE GUS_CreateMOD;
PROCEDURE GUS_LoadMod (FName : STRING);
PROCEDURE GUS_DisposeMOD;

CONST
  ModError : STRING = 'No Error.';

  NoteNames : ARRAY [0..61] OF STRING [3] = ('---',
                                             'C-0', 'C#0', 'D-0', 'D#0',
                                             'E-0', 'F-0', 'F#0', 'G-0',
                                             'G#0', 'A-0', 'A#0', 'B-0',
                                             'C-1', 'C#1', 'D-1', 'D#1',
                                             'E-1', 'F-1', 'F#1', 'G-1',
                                             'G#1', 'A-1', 'A#1', 'B-1',
                                             'C-2', 'C#2', 'D-2', 'D#2',
                                             'E-2', 'F-2', 'F#2', 'G-2',
                                             'G#2', 'A-2', 'A#2', 'B-2',
                                             'C-3', 'C#3', 'D-3', 'D#3',
                                             'E-3', 'F-3', 'F#3', 'G-3',
                                             'G#3', 'A-3', 'A#3', 'B-3',
                                             'C-4', 'C#4', 'D-4', 'D#4',
                                             'E-4', 'F-4', 'F#4', 'G-4',
                                             'G#4', 'A-4', 'A#4', 'B-4',
                                             '+++');

  NotePeriods : ARRAY [1..60] OF WORD = (1712, 1616, 1525, 1440,
                                         1357, 1281, 1209, 1141,
                                         1077, 1017,  961,  907,
                                          856,  808,  762,  720,
                                          678,  640,  604,  570,
                                          538,  508,  480,  453,
                                          428,  404,  381,  360,
                                          339,  320,  302,  285,
                                          269,  254,  240,  226,
                                          214,  202,  190,  180,
                                          170,  160,  151,  143,
                                          135,  127,  120,  113,
                                          107,  101,   95,   90,
                                           85,   80,   76,   71,
                                           67,   64,   60,   57);


VAR
  MODData     : ModPtr;  { pointer to MOD info for ASM routines }
  VoiceModes  : ARRAY [0..31] OF BYTE;
  ChannelInfo : ARRAY [0..MaxTracks - 1] OF ChannelRec;

Implementation

{ GUSMOD specific stuff }

CONST
  ModTags : ARRAY [0..7] OF STRING [4] = ('M.K.', 'FLT4', 'M!K!', '4CHN',
                                          'FLT8', '8CHN', 'OCTA',
                                          '6CHN');

TYPE
  BuffPtr  = ^BuffType;
  BuffType = ARRAY [0..1024] OF BYTE;

VAR
  SEP        : POINTER;
  Buff       : BuffPtr;
  Channels   : BYTE;

{$L GUSUTIL}

FUNCTION  GUS_ReadVoicePos (Voice : BYTE): LONGINT; EXTERNAL;
FUNCTION  GUS_Peek (Address : LONGINT): SHORTINT; EXTERNAL;
PROCEDURE GUS_Poke (Address : LONGINT; v : SHORTINT); EXTERNAL;
FUNCTION  GUS_Mem : WORD; EXTERNAL;
PROCEDURE GUS_SetActiveVoices (Voices : BYTE); EXTERNAL;
PROCEDURE GUS_VoiceFreq (VoiceNum : BYTE; Hertz : WORD); EXTERNAL;
PROCEDURE GUS_VoiceAddr (VoiceNum : BYTE; CurPtr, Start, EndAddr : LONGINT); EXTERNAL;
PROCEDURE GUS_VoiceVolume (VoiceNum : BYTE; Volume : WORD); EXTERNAL;
PROCEDURE GUS_VoiceMode (Voice : BYTE; Mode : BYTE); EXTERNAL;
FUNCTION  GUS_ReadVoiceMode (Voice : BYTE): BYTE; EXTERNAL;
PROCEDURE GUS_StopVoice (Voice : BYTE); EXTERNAL;
PROCEDURE GUS_StartVoice (Voice : BYTE); EXTERNAL;
PROCEDURE GUS_SpeakerOn; EXTERNAL;
PROCEDURE GUS_SpeakerOff; EXTERNAL;
PROCEDURE GUS_Reset; EXTERNAL;
PROCEDURE GUS_VoiceBalance (Voice, Balance : BYTE); EXTERNAL;
PROCEDURE GUS_RampRate (Voice, Increment, Scale : BYTE); EXTERNAL;
PROCEDURE GUS_RampVolume (Voice, StartVol, EndVol : BYTE); EXTERNAL;
PROCEDURE GUS_VolumeControl (Voice, ControlByte : BYTE); EXTERNAL;
FUNCTION  GUS_TestBaseAddress : BOOLEAN; EXTERNAL;
PROCEDURE GUS_MoveSample (DosAddr, GUSAddr : LONGINT; Len : WORD); EXTERNAL;
PROCEDURE GUS_SetClockRate (Rate : WORD); EXTERNAL;
PROCEDURE GUS_SetTimer; EXTERNAL;
PROCEDURE GUS_ResetTimer; EXTERNAL;
PROCEDURE GUS_SetIRQ; EXTERNAL;
PROCEDURE GUS_RestoreIRQ; EXTERNAL;
PROCEDURE MODInt8; EXTERNAL;            { DO NOT CALL!!!!!!!!! }
PROCEDURE GUS_StartMOD; EXTERNAL;
PROCEDURE GUS_StopMOD; EXTERNAL;

PROCEDURE FreqTable; EXTERNAL;          { DO NOT CALL!! NOT A PROCEDURE! }
PROCEDURE FreqDivisors; EXTERNAL;       { DO NOT CALL!! NOT A PROCEDURE! }

{ ╔═══════════════════════════════════════════════════════════════════════╗
  ║                                                                       ║
  ║                                                                       ║
  ╚═══════════════════════════════════════════════════════════════════════╝ }

PROCEDURE NewExit; FAR;

BEGIN
  ExitProc := SEP;

  IF GUS_Base <> 0 THEN
  BEGIN
    GUS_DisposeMOD;
    GUS_DestroyHeap;
    GUS_MODDeInit;
    GUS_RestoreIRQ;
    GUS_Reset;
  END;
END;

{ ╔═══════════════════════════════════════════════════════════════════════╗
  ║                                                                       ║
  ║ Flips the high and low bytes of the passed word.  The word is a VAR   ║
  ║ parameter so it's changed outside the scope of this procedure.        ║
  ║                                                                       ║
  ╚═══════════════════════════════════════════════════════════════════════╝ }

PROCEDURE WordFlip (VAR W : WORD); ASSEMBLER;

ASM
  les    di,[W]
  mov    ax,es:[di]
  xchg   ah,al
  mov    es:[di],ax
END;

{ ╔═══════════════════════════════════════════════════════════════════════╗
  ║                                                                       ║
  ║                                                                       ║
  ╚═══════════════════════════════════════════════════════════════════════╝ }

PROCEDURE GUS_CreateMod;

VAR
  I : INTEGER;

BEGIN
  NEW (MODData);

  WITH MODData^ DO
  BEGIN
    Name := '';

    FOR I := 0 to 127 DO
      Patterns [I] := NIL;
  END;

  IF DebugMOD THEN Writeln ('Created MOD.');
END;

{ ╔═══════════════════════════════════════════════════════════════════════╗
  ║                                                                       ║
  ║                                                                       ║
  ╚═══════════════════════════════════════════════════════════════════════╝ }

PROCEDURE GUS_DisposeMod;

VAR
  I : INTEGER;

BEGIN
  IF MODData = NIL THEN Exit;

  WITH MODData^ DO
  BEGIN
    FOR I := 0 to TotalPats - 1 DO
    BEGIN
      IF Patterns [I] <> NIL THEN
      BEGIN
        DISPOSE (Patterns [I]);
        Patterns [I] := NIL;
      END;
    END;

    FOR I := 0 to 30 DO
      IF Samples [I].Len * 2 > 0 THEN
        GUS_FreeMem (Samples [I].GPtr);

  END;

  DISPOSE (MODData);
  MODData := NIL;

  IF DebugMOD THEN Writeln ('Disposed of MOD.');
END;

{ ╔═══════════════════════════════════════════════════════════════════════╗
  ║                                                                       ║
  ║ Attempts to load the file FName as a MOD file.                        ║
  ║ Halts with exitcode 252 if unsuccessful and global ErrorCode from     ║
  ║ TYPES.PAS set to error number.                                        ║
  ║                                                                       ║
  ╚═══════════════════════════════════════════════════════════════════════╝ }

PROCEDURE GUS_LoadMod (FName : STRING);

VAR
  LNotes : ARRAY [0..7] OF WORD;

{ ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
  ■                                                                       ■
  ■                                                                       ■
  ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■ }

FUNCTION LoadNullStr (VAR F : FILE; L : BYTE): STRING;

VAR
  TempStr : PChar;

BEGIN
  GetMem (TempStr, L);
  BLOCKREAD (F, TempStr^, L);
  LoadNullStr := StrPas (TempStr);
  FreeMem (TempStr, L);
END;

{ ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
  ■                                                                       ■
  ■                                                                       ■
  ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■ }

FUNCTION LoadSampleInfo (VAR F : FILE; VAR S : InstrType): INTEGER;

BEGIN
  WITH S DO
  BEGIN
    Name := LoadNullStr (F, 22);
    IF DebugMOD THEN Writeln ('InstrName: ', Name);

    BLOCKREAD (F, Len, 2);
    WordFlip (Len);
    IF DebugMOD THEN Writeln ('  InstrLen:  ', Len * 2);

    BLOCKREAD (F, FineTune, 1);
    { convert the signed nibble to a short integer }

    IF DebugMOD THEN Writeln ('  OrigFTune: ', FineTune);
    ASM
      mov     al,S.FineTune
      rcl     al,5
      jnc     @Positive

      or      al,10000000b              { turn on shortint's sign bit }

    @Positive:
      and     al,10000111b              { turn off nibble's sign bit }
      mov     S.FineTune,al
    END;

    IF DebugMOD THEN Writeln ('  FineTune:  ', FineTune);

    BLOCKREAD (F, Volume, 1);
    IF DebugMOD THEN WriteLn ('  Volume:    ', Volume);

    BLOCKREAD (F, RepOfs, 2);
    WordFlip (RepOfs);
    IF DebugMOD THEN WriteLn ('  RepeatOfs: ', RepOfs * 2);

    BLOCKREAD (F, RepLen, 2);
    WordFlip (RepLen);
    IF DebugMOD THEN WriteLn ('  RepeatLen: ', RepLen * 2);
  END;
END;

{ ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
  ■                                                                       ■
  ■                                                                       ■
  ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■ }

PROCEDURE LoadNote (VAR F : FILE; VAR Note : NoteType; VAR LastNote : WORD);

VAR
  NBytes : ARRAY [0..3] OF BYTE;
  Count  : INTEGER;
  Best   : INTEGER;
  BestDif: INTEGER;

BEGIN
  BLOCKREAD (F, NBytes, 4);

  WITH Note DO
  BEGIN
    InstNum := (NBytes [0] AND $F0) + ((NBytes [2] AND $F0) SHR 4);
    Period := (WORD (NBytes [0] AND $0F) SHL 8) + NBytes [1];
    IF (Period > 0) THEN LastNote := Period;
    Effect := NBytes [2] AND $0F;
    EffectArg := NBytes [3];

    { find the note that matches this period, or the period closest to
      it... don't adjust the period if there is not match! }

    Best := MaxInt;
    BestDif := MaxInt;

    IF (InstNum > 0) THEN
    BEGIN
      Count := 0;
      REPEAT
        INC (Count);

        IF ABS (NotePeriods [Count] - Period) < BestDif THEN
        BEGIN
          BestDif := ABS (NotePeriods [Count] - Period);
          Best := Count;
        END;
      UNTIL (Count > 60) OR (NotePeriods [Count] = LastNote);

      IF Count <= 60 THEN
        NoteName := Count
      ELSE
      BEGIN
        IF Best < MaxInt THEN
          NoteName := Best
        ELSE
          NoteName := 61;
      END;
    END
    ELSE NoteName := 0;
  END;
END;

{ ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
  ■                                                                       ■
  ■                                                                       ■
  ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■ }

PROCEDURE LoadPatternLine (VAR F : FILE; VAR PLine : PatLineType; NumChans : BYTE);

VAR
  I : INTEGER;

BEGIN
  FOR I := 0 to NumChans - 1 DO
    LoadNote (F, PLine [I], LNotes [I]);
END;

{ ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
  ■                                                                       ■
  ■                                                                       ■
  ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■ }

FUNCTION LoadPattern (VAR F : FILE; VAR Pat : PatternPtr; NumChans : BYTE): INTEGER;

VAR
  I : INTEGER;

BEGIN
  IF Pat <> NIL THEN
  BEGIN
    MODError := 'Pattern already in use.';
    LoadPattern := 252;
    Exit;
  END;

  NEW (Pat);

  FOR I := 0 to 63 DO
    LoadPatternLine (F, Pat^ [I], NumChans);

  LoadPattern := 0;
END;

{ ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
  ■                                                                       ■
  ■                                                                       ■
  ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■ }

VAR
  Result     : WORD;
  FSize      : LONGINT;
  F          : FILE;
  Count      : INTEGER;
  AllSamples : LONGINT;
  BytesPerPat: LONGINT;
  Buff       : POINTER;
  TempWord   : LONGINT;

BEGIN
  {$I-}
  ASSIGN (F, FName);
  RESET (F, 1);
  {$I+}

  Result := IOResult;
  IF Result <> 0 THEN
    ErrorHandler (252, Result);

  FSize := FileSize (F);
  IF FSize < 1084 THEN
    ErrorHandler (252, 30);

  GUS_CreateMOD;

  WITH MODData^ DO
  BEGIN
    { read the MODs tag field }
    FillChar (FormatTag, 5, 0);

    SEEK (F, 1080);
    BLOCKREAD (F, FormatTag, 4);
    IF DebugMOD THEN Writeln ('Tag field: ', StrPas (FormatTag));

    { determine what kind of MOD this is }
    Count := 0;
    WHILE (Count < 8) AND (StrPas (FormatTag) <> ModTags [Count]) DO
      INC (Count);

    IF Count < 4 THEN
      NumChans := 4
    ELSE IF Count < 7 THEN
      NumChans := 8
    ELSE IF Count = 7 THEN
      NumChans := 6
    ELSE IF Count > 7 THEN
      ErrorHandler (252, 31);

    IF DebugMOD THEN Writeln ('Channels: ', NumChans);

    Channels := NumChans;

    SEEK (F, 0);
    Name := LoadNullStr (F, 20);
    IF DebugMOD THEN Writeln ('MOD name: ', Name);

    AllSamples := 0;
    NumIns := 31;                       { only loads 31 instrument MODs }

    FOR Count := 0 to 30 DO
    BEGIN
      IF DebugMOD THEN Writeln ('Sample #' + ST (Count));

      LoadSampleInfo (F, Samples [Count]);
      INC (AllSamples, Samples [Count].Len * 2);

      IF DebugMOD THEN ReadKey;
    END;
    IF DebugMOD THEN WriteLn ('Length of all samples = ', AllSamples);

    BytesPerPat := (4 * NumChans * 64);
    TotalPats := BYTE ((FSize - LONGINT (1084 + AllSamples)) DIV BytesPerPat);
    IF DebugMOD THEN WriteLn ('Total Patterns: ', TotalPats);

    BLOCKREAD (F, NumPats, 1);
    IF DebugMOD THEN WriteLn ('NumPats: ', NumPats);
    BLOCKREAD (F, EndJumpPos, 1);
    IF DebugMOD THEN WriteLn ('End Jump Position: ', EndJumpPos);
    BLOCKREAD (F, PatScript, 128);
    BLOCKREAD (F, FormatTag, 4);

    FOR Count := 0 to TotalPats - 1 DO
    BEGIN
      Result := LoadPattern (F, Patterns [Count], NumChans);
      IF Result <> 0 THEN
        ErrorHandler (252, Result);
    END;

    Count := 0;

    { load in the sample data }

    WHILE (Count < 31) AND NOT (EOF (F)) DO
    BEGIN
      IF Samples [Count].Len * 2 > 0 THEN
      BEGIN
        BLOCKREAD (F, TempWord, 2);

        IF Samples [Count].Len * 2 > 3 THEN
        BEGIN
          INC (NumIns);
          GetMem (Buff, Samples [Count].Len * 2 - 2);

          GUS_GetMem (Samples [Count].GPtr, Samples [Count].Len * 2 - 2);

          BLOCKREAD (F, Buff^, Samples [Count].Len * 2 - 2);

          GUS_MoveSample (LONGINT (Buff), Samples [Count].GPtr.GPtr, Samples [Count].Len * 2 - 2);

          IF DebugMOD THEN Writeln ('Loaded sample #', Count, ', size ',
                                 (Samples [Count].Len * 2 - 2), ' bytes.');
          IF DebugMOD THEN Writeln ('  Start = ', Samples [Count].Gptr.GPtr,
                                  ', End = ', Samples [Count].GPtr.GPtr + Samples [Count].GPtr.BLockSize - 1);
          FreeMem (Buff, Samples [Count].Len * 2 - 2);
        END;
      END
      ELSE
      BEGIN
        Samples [Count].GPtr.GPtr := 0;
        Samples [Count].GPtr.BlockSize := 0;
        Samples [Count].GPtr.OfsPtr := 0;
        Samples [Count].GPtr.Bank := 0;
      END;

      INC (Count);
    END;

    IF DebugMOD THEN
    BEGIN
      Writeln ('GUS_MemAvail = ', GUS_MemAvail);
      Writeln ('GUS_MaxAvail = ', GUS_MaxAvail);
      ReadKey;
    END;
  END;

  CLOSE (F);

  CurLine := 0;
  CurPattern := 0;
  ScriptPos := 0;
  MODSpeed := 6;
END;

{ ╔═══════════════════════════════════════════════════════════════════════╗
  ║                                                                       ║
  ║                                                                       ║
  ╚═══════════════════════════════════════════════════════════════════════╝ }

FUNCTION Hex (w : WORD): STRING;

CONST
 hexChars: array [0..$F] of Char = '0123456789ABCDEF';

VAR
  S : STRING;

BEGIN

 S := hexChars [Hi(w) shr 4] + hexChars [Hi(w) and $F] +
      hexChars [Lo(w) shr 4] + hexChars [Lo(w) and $F];

 { remove leading zeros }

 WHILE (S [1] = '0') AND (Length (S) > 1) DO System.DELETE (S, 1, 1);

 Hex := S;
END;

{ ╔═══════════════════════════════════════════════════════════════════════╗
  ║                                                                       ║
  ║                                                                       ║
  ╚═══════════════════════════════════════════════════════════════════════╝ }

PROCEDURE GUS_InitBase (b : WORD);

BEGIN
  GUS_Base := b;
  GUS_Status := GUS_Base + $06;
  GUS_TimerCon := GUS_Base + $08;
  GUS_TimerData := GUS_Base + $09;
  GUS_IRQDMACon := GUS_Base + $0B;
  GUS_MidiCon := GUS_Base + $100;
  GUS_MidiData := GUS_Base + $101;
  GUS_Voice := GUS_Base + $102;
  GUS_Command := GUS_Base + $103;
  GUS_DataLo := GUS_Base + $104;
  GUS_DataHi := GUS_Base + $105;
  GUS_DRAMIO := GUS_Base + $107;
END;

{ ╔═══════════════════════════════════════════════════════════════════════╗
  ║                                                                       ║
  ║                                                                       ║
  ╚═══════════════════════════════════════════════════════════════════════╝ }

PROCEDURE GUS_DetectCard;

VAR
  GUSEnv  : STRING;
  EnvStr  : ARRAY [1..5] OF STRING [20];
  EnvCnt  : INTEGER;
  Code    : INTEGER;

BEGIN
  GUSEnv := GetEnv ('ULTRASND');

  IF GUSEnv <> '' THEN
  BEGIN
    EnvCnt := 1;

    FOR EnvCnt := 1 TO 5 DO
    BEGIN
      EnvStr [EnvCnt] := '';

      WHILE (GUSEnv [1] <> ',') AND (Length (GUSEnv) > 0) DO
      BEGIN
        EnvStr [EnvCnt] := EnvStr [EnvCnt] + GUSEnv [1];
        System.DELETE (GUSEnv, 1, 1);
      END;

      System.DELETE (GUSEnv, 1, 1);
    END;

    VAL ('$' + EnvStr [1], GUS_Base, Code);
    IF Code = 0 THEN
    BEGIN
      GUS_InitBase (GUS_Base);
      VAL (EnvStr [4], GUS_IRQ, Code);
    END;

    IF Code <> 0 THEN
    BEGIN
      Print ('Error in ULTRASND environment settings.', $0F);
      Print ('Check the settings in your AUTOEXEC.BAT file.', $0F);

      GUS_InitBase (0);
      Exit;
    END;

    IF GUS_TestBaseAddress = FALSE THEN
      GUS_InitBase (0)
    ELSE
    BEGIN
      Print ('UltraSound with ' + ST (GUS_Mem) + 'K detected at address '
             + Hex (GUS_Base) + 'h, IRQ ' + ST (GUS_IRQ) + '.', $0F);

      GUS_Reset;
      GUS_InitHeap (GUS_Mem);
      GUS_SetActiveVoices (BYTE (ActiveVoices));
      GUS_SetIRQ;
      IF DebugKeys THEN Print ('GUS_SetIRQ: UltraSound enabled for IRQ ' + ST (GUS_IRQ) + '.', $0F);
      IF DebugKeys THEN Print ('GUS_MemAvail = ' + ST (GUS_MemAvail), $0F);
      IF DebugKeys THEN Print ('GUS_MaxAvail = ' + ST (GUS_MaxAvail), $0F);
    END;
  END
  ELSE
  BEGIN
    Print ('No ULTRASND environment variable settings were found.', $0F);
    Print ('The ULTRASND environment variable must be set in order for this', $0F);
    Print ('program to determine the UltraSound''s IRQ setting.', $0F);

    GUS_InitBase (0);
    Exit;
  END;
END;

{ ╔═══════════════════════════════════════════════════════════════════════╗
  ║                                                                       ║
  ║                                                                       ║
  ╚═══════════════════════════════════════════════════════════════════════╝ }

PROCEDURE GUS_LoadSample (FName : STRING; VAR GPtr : GUS_Ptr);

VAR
  F      : FILE;
  Result : WORD;
  FSize  : LONGINT;
  Buff   : POINTER;

BEGIN
  {$I-}
  ASSIGN (F, FName);
  RESET (F, 1);

  FSize := FileSize (F);

  CLOSE (F);

  IF FSize <= 65020 THEN RESET (F, FSize);
  {$I+}

  Result := IOResult;

  IF (Result = 0) AND (FSize <= 65020) THEN
  BEGIN
    GetMem (Buff, FSize);

    {$I-}
    BLOCKREAD (F, Buff^, 1);
    CLOSE (F);
    {$I+}

    Result := IOResult;

    IF Result = 0 THEN
    BEGIN
      GUS_GetMem (GPtr, FSize);
{      GUS_DMATransfer (Buff, GPtr);}
      GUS_MoveSample (LONGINT (Buff), GPtr.GPtr, FSize);
    END;

    FreeMem (Buff, FSize);
  END;

  IF Result > 0 THEN
    ErrorHandler (252, Result)
  ELSE IF FSize > 65020 THEN
    ErrorHandler (252, 28);
END;

{ ╔═══════════════════════════════════════════════════════════════════════╗
  ║                                                                       ║
  ║                                                                       ║
  ╚═══════════════════════════════════════════════════════════════════════╝ }

PROCEDURE GUS_LoadRAW (FName : STRING; VAR GPtr : GUS_Ptr);

TYPE
  BuffType = ARRAY [0..65019] OF SHORTINT;

VAR
  F      : FILE;
  Result : WORD;
  FSize  : LONGINT;
  Buff   : ^BuffType;
  Count  : WORD;

BEGIN
  {$I-}
  ASSIGN (F, FName);
  RESET (F, 1);

  FSize := FileSize (F);

  CLOSE (F);

  IF FSize <= 65020 THEN RESET (F, FSize);
  {$I+}

  Result := IOResult;

  IF (Result = 0) AND (FSize <= 65018) THEN
  BEGIN
    GetMem (Buff, FSize);

    {$I-}
    BLOCKREAD (F, Buff^, 1);
    CLOSE (F);
    {$I+}

    Buff^ [FSize] := 0;

    Result := IOResult;

    IF Result = 0 THEN
    BEGIN
      GUS_GetMem (GPtr, FSize);
      FOR Count := 0 to FSize - 1 DO
        Buff^ [Count] := SHORTINT (Buff^ [Count] XOR $80);
      GUS_MoveSample (LONGINT (Buff), GPtr.GPtr, FSize);
    END;

    FreeMem (Buff, FSize);
  END;

  IF Result > 0 THEN
    ErrorHandler (252, Result)
  ELSE IF FSize > 65020 THEN
    ErrorHandler (252, 28);
END;

{ ╔═══════════════════════════════════════════════════════════════════════╗
  ║                                                                       ║
  ║ This routine builds the MOD frequency table. If you change the # of   ║
  ║ active voices after calling this routine, you must call it again to   ║
  ║ recalculate the table or things will be screwy.                       ║
  ║                                                                       ║
  ╚═══════════════════════════════════════════════════════════════════════╝ }

PROCEDURE GUS_MODInit;

TYPE
  TablePtr = ^TableType;
  TableType = ARRAY [0..1712] OF WORD;

  DivPtr       = ^DivTableType;
  DivTableType = ARRAY [13..31] OF BYTE;

VAR
  Temp     : POINTER;
  I, J     : INTEGER;
  EndIndex : INTEGER;
  NoteFreq : WORD;
  Table    : TablePtr;
  DivTable : DivPtr;

BEGIN
  MODSpeed := 6;
  MODPlaying := FALSE;

  { get the address of the frequency table which is actually in the GUSUTIL
    code segment.  Turbo Pascal thinks FreqTable is a pointer to a PROCEDURE,
    but it is actually just a pointer to the frequency table data }
  Table := @FreqTable;
  DivTable := @FreqDivisors;

  { zero the frequency table }
  FillChar (Table^, SizeOf (TableType), 0);

  FOR I := (SizeOf (NotePeriods) DIV 2) DownTo 1 DO
  BEGIN
    IF I = 1 THEN
      EndIndex := 1712
    ELSE
      EndIndex := NotePeriods [I - 1];

    { find the correct frequency for this period }
    NoteFreq := TRUNC (7093789.2 / INT (NotePeriods [I] * 2));
    NoteFreq := NoteFreq DIV DivTable^ [ActiveVoices];

    { fill in the table with the correct frequency, up to the next frequency }
    FOR J := NotePeriods [I] to EndIndex DO
      Table^ [J] := NoteFreq;
  END;

  GetIntVec ($08, Temp);
  IF Temp <> @MODInt8 THEN
  BEGIN
    PreMODInt8 := Temp;
    SetIntVec ($08, @MODInt8);
  END;

  SetTimer0Rate (55);                   { 55 * 18.2 = 1001 interrupts / sec }
END;

{ ╔═══════════════════════════════════════════════════════════════════════╗
  ║                                                                       ║
  ║                                                                       ║
  ╚═══════════════════════════════════════════════════════════════════════╝ }

PROCEDURE GUS_MODDeInit;

VAR
  Count : INTEGER;

BEGIN
  MODPlaying := FALSE;
  CurLine := 0;
  CurPattern := 0;
  MODSpeed := 6;

  FOR Count := 0 to 3 DO
    GUS_StopVoice (Count);

  SetIntVec ($08, PreMODInt8);
END;

{ ╔═══════════════════════════════════════════════════════════════════════╗
  ║                                                                       ║
  ║                                                                       ║
  ╚═══════════════════════════════════════════════════════════════════════╝ }

BEGIN
  MODData := NIL;
  GUS_DetectCard;

  IF GUS_Base <> 0 THEN GUS_MODInit;

  SEP := ExitProc;
  ExitProc := @NewExit;
END.