home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / ASMCODE.ZIP / GUSMOD.PAS < prev    next >
Pascal/Delphi Source File  |  1994-11-02  |  32KB  |  1,050 lines
  1. { ────────────────────────────────────────────────────────────────────────
  2.  
  3.   This code is Copyright (c) 1994 by Jonathan E. Wright and AmoebaSoft.
  4.  
  5.   To communicate with the author, send mail to: NELNO@DELPHI.COM
  6.  
  7.   About this code:
  8.     version 0.90p - sorry there aren't tons of comments.  Hey, be happy.
  9.  
  10.     Not all MOD effects are implemented, see ASMOD.DOC
  11.     No DMA utilities are provided, so samples are peeked and poked to GUS RAM
  12.     This unit automatically checks for and initializes the UltraSound if present
  13.     Read the notes in GUSUTIL.ASM for more info
  14.  
  15.     This code is modified somewhat from that used in ASMOD and was thrown
  16.     together rather quickly.  I had a lot of other units that were tied
  17.     together through things like the timer interrupt but they aren't near
  18.     neat enough to release.  And of course they had some stuff that I just
  19.     don't *want* to release.  I managed to mangle this source up pretty bad,
  20.     not to mention fixing some stupid things I noticed along the way. So,
  21.     if you encounter any problems email me at the address mentioned above.
  22.  
  23.     If you use this code in any of your programs, or as a basis for anything
  24.     else you may write, please give credit to Nelno the Amoeba.  A postcard
  25.     from your country or town would also be nice.  Send it to:
  26.  
  27.     Nelno
  28.     58 1/2 Woodland Rd.
  29.     Asheville, NC 28804-3823
  30.     USA
  31.  
  32.   ──────────────────────────────────────────────────────────────────────── }
  33.  
  34. {$A+,B-,D-,L-,Q-,O-,R-,S-,T-,V-,X+,Y-}
  35.  
  36. UNIT GUSMod;
  37.  
  38. Interface
  39.  
  40. USES
  41.   NewCrt, DOS, GUSHeap, Types, Strings;
  42.  
  43. { GUSUtil stuff }
  44.  
  45. CONST
  46.   Board        : BYTE = 0;              { 3 = GUS }
  47.   MODSpeed     : WORD = 6;              { ticks per pattern line            }
  48.   CurLine      : WORD = 0;              { current pattern line              }
  49.   CurPattern   : WORD = 0;              { current pattern                   }
  50.   ScriptPos    : WORD = 0;
  51.   MODPlaying   : BOOLEAN = FALSE;
  52.   MODFlag      : BYTE = 0;
  53.   MODVolume    : WORD = 100;            { MOD Volume can be 0 - 100%    }
  54.  
  55.   UpdateChannelRecs  : BOOLEAN = TRUE;
  56.   UpdateChannelWaves : BOOLEAN = FALSE;
  57.  
  58.   ActiveVoices : WORD = 13;
  59.   CurVoice     : BYTE = $FF;
  60.  
  61.   Stop      = 2;
  62.   Bit16     = 4;
  63.   Loop      = 8;
  64.   Bidirec   = 16;
  65.   IRQAtEnd  = 32;
  66.   Backward  = 64;
  67.  
  68.   Scale0    = 0;
  69.   Scale8    = 1;
  70.   Scale64   = 2;
  71.   Scale512  = 3;
  72.  
  73.   RampStop  = 3;
  74.   RampRoll  = 4;
  75.   RampLoop  = 8;
  76.   RampBidir = 16;
  77.   RampIRQ   = 32;
  78.   RampDec   = 64;
  79.  
  80. VAR
  81.   GUS_Base      : WORD;
  82.   GUS_IRQ       : WORD;
  83.   GUS_Status    : WORD;
  84.   GUS_TimerCon  : WORD;
  85.   GUS_TimerData : WORD;
  86.   GUS_IRQDMACon : WORD;
  87.   GUS_MidiCon   : WORD;
  88.   GUS_MidiData  : WORD;
  89.   GUS_Voice     : WORD;
  90.   GUS_Command   : WORD;
  91.   GUS_DataLo    : WORD;
  92.   GUS_DataHi    : WORD;
  93.   GUS_DRAMIO    : WORD;
  94.  
  95.   GUS_Mixer     : BYTE;
  96.  
  97.   PreMODInt8    : POINTER;
  98.  
  99. FUNCTION  GUS_ReadVoicePos (Voice : BYTE): LONGINT;
  100. FUNCTION  GUS_Peek (Address : LONGINT): SHORTINT;
  101. PROCEDURE GUS_Poke (Address : LONGINT; v : SHORTINT);
  102. FUNCTION  GUS_Mem : WORD;
  103. PROCEDURE GUS_SetActiveVoices (Voices : BYTE);
  104. PROCEDURE GUS_VoiceFreq (VoiceNum : BYTE; Hertz : WORD);
  105. PROCEDURE GUS_VoiceAddr (VoiceNum : BYTE; CurPtr, Start, EndAddr : LONGINT);
  106. PROCEDURE GUS_VoiceVolume (VoiceNum : BYTE; Volume : WORD);
  107. PROCEDURE GUS_VoiceMode (Voice : BYTE; Mode : BYTE);
  108. FUNCTION  GUS_ReadVoiceMode (Voice : BYTE): BYTE;
  109. PROCEDURE GUS_StopVoice (Voice : BYTE);
  110. PROCEDURE GUS_StartVoice (Voice : BYTE);
  111. PROCEDURE GUS_SpeakerOn;
  112. PROCEDURE GUS_SpeakerOff;
  113. PROCEDURE GUS_Reset;
  114. PROCEDURE GUS_VoiceBalance (Voice, Balance : BYTE);
  115. PROCEDURE GUS_RampRate (Voice, Increment, Scale : BYTE);
  116. PROCEDURE GUS_RampVolume (Voice, StartVol, EndVol : BYTE);
  117. PROCEDURE GUS_VolumeControl (Voice, ControlByte : BYTE);
  118. FUNCTION  GUS_TestBaseAddress : BOOLEAN;
  119. PROCEDURE GUS_MoveSample (DosAddr, GUSAddr : LONGINT; Len : WORD);
  120. PROCEDURE GUS_SetClockRate (Rate : WORD);
  121. PROCEDURE GUS_SetTimer;
  122. PROCEDURE GUS_ResetTimer;
  123. PROCEDURE GUS_SetIRQ;
  124. PROCEDURE GUS_RestoreIRQ;
  125. PROCEDURE GUS_MODInit;
  126. PROCEDURE GUS_MODDeInit;
  127. PROCEDURE GUS_StartMOD;
  128. PROCEDURE GUS_StopMOD;
  129.  
  130. PROCEDURE GUS_DetectCard;
  131. PROCEDURE GUS_LoadSample (FName : STRING; VAR GPtr : GUS_Ptr);
  132. PROCEDURE GUS_LoadRAW (FName : STRING; VAR GPtr : GUS_Ptr);
  133.  
  134. { GUSMOD specific stuff }
  135.  
  136. CONST
  137.   MaxTracks = 8;
  138.  
  139.   DebugMOD  = FALSE;
  140.  
  141. TYPE
  142.   InstrType = RECORD
  143.                 GPtr     : GUS_Ptr;
  144.                 Len      : WORD;
  145.                 FineTune : SHORTINT;
  146.                 Volume   : BYTE;
  147.                 RepOfs   : WORD;
  148.                 RepLen   : WORD;
  149.                 Name     : STRING [22];
  150.               END;
  151.  
  152.  
  153.   PatternPtr = ^PatternType;
  154.  
  155.   NoteType = RECORD
  156.                InstNum   : BYTE;
  157.                Period    : WORD;
  158.                Effect    : BYTE;
  159.                EffectArg : BYTE;
  160.                NoteName  : BYTE;
  161.              END;
  162.  
  163.   PatLineType = ARRAY [0..MaxTracks - 1] OF NoteType;
  164.  
  165.   PatternType = ARRAY [0..63] OF PatLineType;
  166.  
  167.   ModPtr  = ^ModType;
  168.  
  169.   ModType = RECORD
  170.               Samples    : ARRAY [0..30] OF InstrType;
  171.               Patterns   : ARRAY [0..127] OF PatternPtr;
  172.               PatScript  : ARRAY [0..127] OF BYTE;
  173.               NumPats    : BYTE;
  174.               EndJumpPos : BYTE;
  175.               FormatTag  : ARRAY [0..4] OF CHAR;
  176.  
  177.               NumChans   : BYTE;
  178.               TotalPats  : BYTE;
  179.               NumIns     : BYTE;
  180.  
  181.               Name       : STRING;
  182.             END;
  183.  
  184.   ChannelRec = RECORD
  185.                  ChannelOn  : BOOLEAN;
  186.                  ChannelVol : SHORTINT;
  187.                  ChannelHit : BYTE;
  188.                  Wave       : ARRAY [0..79] OF SHORTINT;
  189.                END;
  190.  
  191. PROCEDURE GUS_CreateMOD;
  192. PROCEDURE GUS_LoadMod (FName : STRING);
  193. PROCEDURE GUS_DisposeMOD;
  194.  
  195. CONST
  196.   ModError : STRING = 'No Error.';
  197.  
  198.   NoteNames : ARRAY [0..61] OF STRING [3] = ('---',
  199.                                              'C-0', 'C#0', 'D-0', 'D#0',
  200.                                              'E-0', 'F-0', 'F#0', 'G-0',
  201.                                              'G#0', 'A-0', 'A#0', 'B-0',
  202.                                              'C-1', 'C#1', 'D-1', 'D#1',
  203.                                              'E-1', 'F-1', 'F#1', 'G-1',
  204.                                              'G#1', 'A-1', 'A#1', 'B-1',
  205.                                              'C-2', 'C#2', 'D-2', 'D#2',
  206.                                              'E-2', 'F-2', 'F#2', 'G-2',
  207.                                              'G#2', 'A-2', 'A#2', 'B-2',
  208.                                              'C-3', 'C#3', 'D-3', 'D#3',
  209.                                              'E-3', 'F-3', 'F#3', 'G-3',
  210.                                              'G#3', 'A-3', 'A#3', 'B-3',
  211.                                              'C-4', 'C#4', 'D-4', 'D#4',
  212.                                              'E-4', 'F-4', 'F#4', 'G-4',
  213.                                              'G#4', 'A-4', 'A#4', 'B-4',
  214.                                              '+++');
  215.  
  216.   NotePeriods : ARRAY [1..60] OF WORD = (1712, 1616, 1525, 1440,
  217.                                          1357, 1281, 1209, 1141,
  218.                                          1077, 1017,  961,  907,
  219.                                           856,  808,  762,  720,
  220.                                           678,  640,  604,  570,
  221.                                           538,  508,  480,  453,
  222.                                           428,  404,  381,  360,
  223.                                           339,  320,  302,  285,
  224.                                           269,  254,  240,  226,
  225.                                           214,  202,  190,  180,
  226.                                           170,  160,  151,  143,
  227.                                           135,  127,  120,  113,
  228.                                           107,  101,   95,   90,
  229.                                            85,   80,   76,   71,
  230.                                            67,   64,   60,   57);
  231.  
  232.  
  233. VAR
  234.   MODData     : ModPtr;  { pointer to MOD info for ASM routines }
  235.   VoiceModes  : ARRAY [0..31] OF BYTE;
  236.   ChannelInfo : ARRAY [0..MaxTracks - 1] OF ChannelRec;
  237.  
  238. Implementation
  239.  
  240. { GUSMOD specific stuff }
  241.  
  242. CONST
  243.   ModTags : ARRAY [0..7] OF STRING [4] = ('M.K.', 'FLT4', 'M!K!', '4CHN',
  244.                                           'FLT8', '8CHN', 'OCTA',
  245.                                           '6CHN');
  246.  
  247. TYPE
  248.   BuffPtr  = ^BuffType;
  249.   BuffType = ARRAY [0..1024] OF BYTE;
  250.  
  251. VAR
  252.   SEP        : POINTER;
  253.   Buff       : BuffPtr;
  254.   Channels   : BYTE;
  255.  
  256. {$L GUSUTIL}
  257.  
  258. FUNCTION  GUS_ReadVoicePos (Voice : BYTE): LONGINT; EXTERNAL;
  259. FUNCTION  GUS_Peek (Address : LONGINT): SHORTINT; EXTERNAL;
  260. PROCEDURE GUS_Poke (Address : LONGINT; v : SHORTINT); EXTERNAL;
  261. FUNCTION  GUS_Mem : WORD; EXTERNAL;
  262. PROCEDURE GUS_SetActiveVoices (Voices : BYTE); EXTERNAL;
  263. PROCEDURE GUS_VoiceFreq (VoiceNum : BYTE; Hertz : WORD); EXTERNAL;
  264. PROCEDURE GUS_VoiceAddr (VoiceNum : BYTE; CurPtr, Start, EndAddr : LONGINT); EXTERNAL;
  265. PROCEDURE GUS_VoiceVolume (VoiceNum : BYTE; Volume : WORD); EXTERNAL;
  266. PROCEDURE GUS_VoiceMode (Voice : BYTE; Mode : BYTE); EXTERNAL;
  267. FUNCTION  GUS_ReadVoiceMode (Voice : BYTE): BYTE; EXTERNAL;
  268. PROCEDURE GUS_StopVoice (Voice : BYTE); EXTERNAL;
  269. PROCEDURE GUS_StartVoice (Voice : BYTE); EXTERNAL;
  270. PROCEDURE GUS_SpeakerOn; EXTERNAL;
  271. PROCEDURE GUS_SpeakerOff; EXTERNAL;
  272. PROCEDURE GUS_Reset; EXTERNAL;
  273. PROCEDURE GUS_VoiceBalance (Voice, Balance : BYTE); EXTERNAL;
  274. PROCEDURE GUS_RampRate (Voice, Increment, Scale : BYTE); EXTERNAL;
  275. PROCEDURE GUS_RampVolume (Voice, StartVol, EndVol : BYTE); EXTERNAL;
  276. PROCEDURE GUS_VolumeControl (Voice, ControlByte : BYTE); EXTERNAL;
  277. FUNCTION  GUS_TestBaseAddress : BOOLEAN; EXTERNAL;
  278. PROCEDURE GUS_MoveSample (DosAddr, GUSAddr : LONGINT; Len : WORD); EXTERNAL;
  279. PROCEDURE GUS_SetClockRate (Rate : WORD); EXTERNAL;
  280. PROCEDURE GUS_SetTimer; EXTERNAL;
  281. PROCEDURE GUS_ResetTimer; EXTERNAL;
  282. PROCEDURE GUS_SetIRQ; EXTERNAL;
  283. PROCEDURE GUS_RestoreIRQ; EXTERNAL;
  284. PROCEDURE MODInt8; EXTERNAL;            { DO NOT CALL!!!!!!!!! }
  285. PROCEDURE GUS_StartMOD; EXTERNAL;
  286. PROCEDURE GUS_StopMOD; EXTERNAL;
  287.  
  288. PROCEDURE FreqTable; EXTERNAL;          { DO NOT CALL!! NOT A PROCEDURE! }
  289. PROCEDURE FreqDivisors; EXTERNAL;       { DO NOT CALL!! NOT A PROCEDURE! }
  290.  
  291. { ╔═══════════════════════════════════════════════════════════════════════╗
  292.   ║                                                                       ║
  293.   ║                                                                       ║
  294.   ╚═══════════════════════════════════════════════════════════════════════╝ }
  295.  
  296. PROCEDURE NewExit; FAR;
  297.  
  298. BEGIN
  299.   ExitProc := SEP;
  300.  
  301.   IF GUS_Base <> 0 THEN
  302.   BEGIN
  303.     GUS_DisposeMOD;
  304.     GUS_DestroyHeap;
  305.     GUS_MODDeInit;
  306.     GUS_RestoreIRQ;
  307.     GUS_Reset;
  308.   END;
  309. END;
  310.  
  311. { ╔═══════════════════════════════════════════════════════════════════════╗
  312.   ║                                                                       ║
  313.   ║ Flips the high and low bytes of the passed word.  The word is a VAR   ║
  314.   ║ parameter so it's changed outside the scope of this procedure.        ║
  315.   ║                                                                       ║
  316.   ╚═══════════════════════════════════════════════════════════════════════╝ }
  317.  
  318. PROCEDURE WordFlip (VAR W : WORD); ASSEMBLER;
  319.  
  320. ASM
  321.   les    di,[W]
  322.   mov    ax,es:[di]
  323.   xchg   ah,al
  324.   mov    es:[di],ax
  325. END;
  326.  
  327. { ╔═══════════════════════════════════════════════════════════════════════╗
  328.   ║                                                                       ║
  329.   ║                                                                       ║
  330.   ╚═══════════════════════════════════════════════════════════════════════╝ }
  331.  
  332. PROCEDURE GUS_CreateMod;
  333.  
  334. VAR
  335.   I : INTEGER;
  336.  
  337. BEGIN
  338.   NEW (MODData);
  339.  
  340.   WITH MODData^ DO
  341.   BEGIN
  342.     Name := '';
  343.  
  344.     FOR I := 0 to 127 DO
  345.       Patterns [I] := NIL;
  346.   END;
  347.  
  348.   IF DebugMOD THEN Writeln ('Created MOD.');
  349. END;
  350.  
  351. { ╔═══════════════════════════════════════════════════════════════════════╗
  352.   ║                                                                       ║
  353.   ║                                                                       ║
  354.   ╚═══════════════════════════════════════════════════════════════════════╝ }
  355.  
  356. PROCEDURE GUS_DisposeMod;
  357.  
  358. VAR
  359.   I : INTEGER;
  360.  
  361. BEGIN
  362.   IF MODData = NIL THEN Exit;
  363.  
  364.   WITH MODData^ DO
  365.   BEGIN
  366.     FOR I := 0 to TotalPats - 1 DO
  367.     BEGIN
  368.       IF Patterns [I] <> NIL THEN
  369.       BEGIN
  370.         DISPOSE (Patterns [I]);
  371.         Patterns [I] := NIL;
  372.       END;
  373.     END;
  374.  
  375.     FOR I := 0 to 30 DO
  376.       IF Samples [I].Len * 2 > 0 THEN
  377.         GUS_FreeMem (Samples [I].GPtr);
  378.  
  379.   END;
  380.  
  381.   DISPOSE (MODData);
  382.   MODData := NIL;
  383.  
  384.   IF DebugMOD THEN Writeln ('Disposed of MOD.');
  385. END;
  386.  
  387. { ╔═══════════════════════════════════════════════════════════════════════╗
  388.   ║                                                                       ║
  389.   ║ Attempts to load the file FName as a MOD file.                        ║
  390.   ║ Halts with exitcode 252 if unsuccessful and global ErrorCode from     ║
  391.   ║ TYPES.PAS set to error number.                                        ║
  392.   ║                                                                       ║
  393.   ╚═══════════════════════════════════════════════════════════════════════╝ }
  394.  
  395. PROCEDURE GUS_LoadMod (FName : STRING);
  396.  
  397. VAR
  398.   LNotes : ARRAY [0..7] OF WORD;
  399.  
  400. { ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
  401.   ■                                                                       ■
  402.   ■                                                                       ■
  403.   ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■ }
  404.  
  405. FUNCTION LoadNullStr (VAR F : FILE; L : BYTE): STRING;
  406.  
  407. VAR
  408.   TempStr : PChar;
  409.  
  410. BEGIN
  411.   GetMem (TempStr, L);
  412.   BLOCKREAD (F, TempStr^, L);
  413.   LoadNullStr := StrPas (TempStr);
  414.   FreeMem (TempStr, L);
  415. END;
  416.  
  417. { ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
  418.   ■                                                                       ■
  419.   ■                                                                       ■
  420.   ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■ }
  421.  
  422. FUNCTION LoadSampleInfo (VAR F : FILE; VAR S : InstrType): INTEGER;
  423.  
  424. BEGIN
  425.   WITH S DO
  426.   BEGIN
  427.     Name := LoadNullStr (F, 22);
  428.     IF DebugMOD THEN Writeln ('InstrName: ', Name);
  429.  
  430.     BLOCKREAD (F, Len, 2);
  431.     WordFlip (Len);
  432.     IF DebugMOD THEN Writeln ('  InstrLen:  ', Len * 2);
  433.  
  434.     BLOCKREAD (F, FineTune, 1);
  435.     { convert the signed nibble to a short integer }
  436.  
  437.     IF DebugMOD THEN Writeln ('  OrigFTune: ', FineTune);
  438.     ASM
  439.       mov     al,S.FineTune
  440.       rcl     al,5
  441.       jnc     @Positive
  442.  
  443.       or      al,10000000b              { turn on shortint's sign bit }
  444.  
  445.     @Positive:
  446.       and     al,10000111b              { turn off nibble's sign bit }
  447.       mov     S.FineTune,al
  448.     END;
  449.  
  450.     IF DebugMOD THEN Writeln ('  FineTune:  ', FineTune);
  451.  
  452.     BLOCKREAD (F, Volume, 1);
  453.     IF DebugMOD THEN WriteLn ('  Volume:    ', Volume);
  454.  
  455.     BLOCKREAD (F, RepOfs, 2);
  456.     WordFlip (RepOfs);
  457.     IF DebugMOD THEN WriteLn ('  RepeatOfs: ', RepOfs * 2);
  458.  
  459.     BLOCKREAD (F, RepLen, 2);
  460.     WordFlip (RepLen);
  461.     IF DebugMOD THEN WriteLn ('  RepeatLen: ', RepLen * 2);
  462.   END;
  463. END;
  464.  
  465. { ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
  466.   ■                                                                       ■
  467.   ■                                                                       ■
  468.   ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■ }
  469.  
  470. PROCEDURE LoadNote (VAR F : FILE; VAR Note : NoteType; VAR LastNote : WORD);
  471.  
  472. VAR
  473.   NBytes : ARRAY [0..3] OF BYTE;
  474.   Count  : INTEGER;
  475.   Best   : INTEGER;
  476.   BestDif: INTEGER;
  477.  
  478. BEGIN
  479.   BLOCKREAD (F, NBytes, 4);
  480.  
  481.   WITH Note DO
  482.   BEGIN
  483.     InstNum := (NBytes [0] AND $F0) + ((NBytes [2] AND $F0) SHR 4);
  484.     Period := (WORD (NBytes [0] AND $0F) SHL 8) + NBytes [1];
  485.     IF (Period > 0) THEN LastNote := Period;
  486.     Effect := NBytes [2] AND $0F;
  487.     EffectArg := NBytes [3];
  488.  
  489.     { find the note that matches this period, or the period closest to
  490.       it... don't adjust the period if there is not match! }
  491.  
  492.     Best := MaxInt;
  493.     BestDif := MaxInt;
  494.  
  495.     IF (InstNum > 0) THEN
  496.     BEGIN
  497.       Count := 0;
  498.       REPEAT
  499.         INC (Count);
  500.  
  501.         IF ABS (NotePeriods [Count] - Period) < BestDif THEN
  502.         BEGIN
  503.           BestDif := ABS (NotePeriods [Count] - Period);
  504.           Best := Count;
  505.         END;
  506.       UNTIL (Count > 60) OR (NotePeriods [Count] = LastNote);
  507.  
  508.       IF Count <= 60 THEN
  509.         NoteName := Count
  510.       ELSE
  511.       BEGIN
  512.         IF Best < MaxInt THEN
  513.           NoteName := Best
  514.         ELSE
  515.           NoteName := 61;
  516.       END;
  517.     END
  518.     ELSE NoteName := 0;
  519.   END;
  520. END;
  521.  
  522. { ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
  523.   ■                                                                       ■
  524.   ■                                                                       ■
  525.   ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■ }
  526.  
  527. PROCEDURE LoadPatternLine (VAR F : FILE; VAR PLine : PatLineType; NumChans : BYTE);
  528.  
  529. VAR
  530.   I : INTEGER;
  531.  
  532. BEGIN
  533.   FOR I := 0 to NumChans - 1 DO
  534.     LoadNote (F, PLine [I], LNotes [I]);
  535. END;
  536.  
  537. { ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
  538.   ■                                                                       ■
  539.   ■                                                                       ■
  540.   ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■ }
  541.  
  542. FUNCTION LoadPattern (VAR F : FILE; VAR Pat : PatternPtr; NumChans : BYTE): INTEGER;
  543.  
  544. VAR
  545.   I : INTEGER;
  546.  
  547. BEGIN
  548.   IF Pat <> NIL THEN
  549.   BEGIN
  550.     MODError := 'Pattern already in use.';
  551.     LoadPattern := 252;
  552.     Exit;
  553.   END;
  554.  
  555.   NEW (Pat);
  556.  
  557.   FOR I := 0 to 63 DO
  558.     LoadPatternLine (F, Pat^ [I], NumChans);
  559.  
  560.   LoadPattern := 0;
  561. END;
  562.  
  563. { ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
  564.   ■                                                                       ■
  565.   ■                                                                       ■
  566.   ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■ }
  567.  
  568. VAR
  569.   Result     : WORD;
  570.   FSize      : LONGINT;
  571.   F          : FILE;
  572.   Count      : INTEGER;
  573.   AllSamples : LONGINT;
  574.   BytesPerPat: LONGINT;
  575.   Buff       : POINTER;
  576.   TempWord   : LONGINT;
  577.  
  578. BEGIN
  579.   {$I-}
  580.   ASSIGN (F, FName);
  581.   RESET (F, 1);
  582.   {$I+}
  583.  
  584.   Result := IOResult;
  585.   IF Result <> 0 THEN
  586.     ErrorHandler (252, Result);
  587.  
  588.   FSize := FileSize (F);
  589.   IF FSize < 1084 THEN
  590.     ErrorHandler (252, 30);
  591.  
  592.   GUS_CreateMOD;
  593.  
  594.   WITH MODData^ DO
  595.   BEGIN
  596.     { read the MODs tag field }
  597.     FillChar (FormatTag, 5, 0);
  598.  
  599.     SEEK (F, 1080);
  600.     BLOCKREAD (F, FormatTag, 4);
  601.     IF DebugMOD THEN Writeln ('Tag field: ', StrPas (FormatTag));
  602.  
  603.     { determine what kind of MOD this is }
  604.     Count := 0;
  605.     WHILE (Count < 8) AND (StrPas (FormatTag) <> ModTags [Count]) DO
  606.       INC (Count);
  607.  
  608.     IF Count < 4 THEN
  609.       NumChans := 4
  610.     ELSE IF Count < 7 THEN
  611.       NumChans := 8
  612.     ELSE IF Count = 7 THEN
  613.       NumChans := 6
  614.     ELSE IF Count > 7 THEN
  615.       ErrorHandler (252, 31);
  616.  
  617.     IF DebugMOD THEN Writeln ('Channels: ', NumChans);
  618.  
  619.     Channels := NumChans;
  620.  
  621.     SEEK (F, 0);
  622.     Name := LoadNullStr (F, 20);
  623.     IF DebugMOD THEN Writeln ('MOD name: ', Name);
  624.  
  625.     AllSamples := 0;
  626.     NumIns := 31;                       { only loads 31 instrument MODs }
  627.  
  628.     FOR Count := 0 to 30 DO
  629.     BEGIN
  630.       IF DebugMOD THEN Writeln ('Sample #' + ST (Count));
  631.  
  632.       LoadSampleInfo (F, Samples [Count]);
  633.       INC (AllSamples, Samples [Count].Len * 2);
  634.  
  635.       IF DebugMOD THEN ReadKey;
  636.     END;
  637.     IF DebugMOD THEN WriteLn ('Length of all samples = ', AllSamples);
  638.  
  639.     BytesPerPat := (4 * NumChans * 64);
  640.     TotalPats := BYTE ((FSize - LONGINT (1084 + AllSamples)) DIV BytesPerPat);
  641.     IF DebugMOD THEN WriteLn ('Total Patterns: ', TotalPats);
  642.  
  643.     BLOCKREAD (F, NumPats, 1);
  644.     IF DebugMOD THEN WriteLn ('NumPats: ', NumPats);
  645.     BLOCKREAD (F, EndJumpPos, 1);
  646.     IF DebugMOD THEN WriteLn ('End Jump Position: ', EndJumpPos);
  647.     BLOCKREAD (F, PatScript, 128);
  648.     BLOCKREAD (F, FormatTag, 4);
  649.  
  650.     FOR Count := 0 to TotalPats - 1 DO
  651.     BEGIN
  652.       Result := LoadPattern (F, Patterns [Count], NumChans);
  653.       IF Result <> 0 THEN
  654.         ErrorHandler (252, Result);
  655.     END;
  656.  
  657.     Count := 0;
  658.  
  659.     { load in the sample data }
  660.  
  661.     WHILE (Count < 31) AND NOT (EOF (F)) DO
  662.     BEGIN
  663.       IF Samples [Count].Len * 2 > 0 THEN
  664.       BEGIN
  665.         BLOCKREAD (F, TempWord, 2);
  666.  
  667.         IF Samples [Count].Len * 2 > 3 THEN
  668.         BEGIN
  669.           INC (NumIns);
  670.           GetMem (Buff, Samples [Count].Len * 2 - 2);
  671.  
  672.           GUS_GetMem (Samples [Count].GPtr, Samples [Count].Len * 2 - 2);
  673.  
  674.           BLOCKREAD (F, Buff^, Samples [Count].Len * 2 - 2);
  675.  
  676.           GUS_MoveSample (LONGINT (Buff), Samples [Count].GPtr.GPtr, Samples [Count].Len * 2 - 2);
  677.  
  678.           IF DebugMOD THEN Writeln ('Loaded sample #', Count, ', size ',
  679.                                  (Samples [Count].Len * 2 - 2), ' bytes.');
  680.           IF DebugMOD THEN Writeln ('  Start = ', Samples [Count].Gptr.GPtr,
  681.                                   ', End = ', Samples [Count].GPtr.GPtr + Samples [Count].GPtr.BLockSize - 1);
  682.           FreeMem (Buff, Samples [Count].Len * 2 - 2);
  683.         END;
  684.       END
  685.       ELSE
  686.       BEGIN
  687.         Samples [Count].GPtr.GPtr := 0;
  688.         Samples [Count].GPtr.BlockSize := 0;
  689.         Samples [Count].GPtr.OfsPtr := 0;
  690.         Samples [Count].GPtr.Bank := 0;
  691.       END;
  692.  
  693.       INC (Count);
  694.     END;
  695.  
  696.     IF DebugMOD THEN
  697.     BEGIN
  698.       Writeln ('GUS_MemAvail = ', GUS_MemAvail);
  699.       Writeln ('GUS_MaxAvail = ', GUS_MaxAvail);
  700.       ReadKey;
  701.     END;
  702.   END;
  703.  
  704.   CLOSE (F);
  705.  
  706.   CurLine := 0;
  707.   CurPattern := 0;
  708.   ScriptPos := 0;
  709.   MODSpeed := 6;
  710. END;
  711.  
  712. { ╔═══════════════════════════════════════════════════════════════════════╗
  713.   ║                                                                       ║
  714.   ║                                                                       ║
  715.   ╚═══════════════════════════════════════════════════════════════════════╝ }
  716.  
  717. FUNCTION Hex (w : WORD): STRING;
  718.  
  719. CONST
  720.  hexChars: array [0..$F] of Char = '0123456789ABCDEF';
  721.  
  722. VAR
  723.   S : STRING;
  724.  
  725. BEGIN
  726.  
  727.  S := hexChars [Hi(w) shr 4] + hexChars [Hi(w) and $F] +
  728.       hexChars [Lo(w) shr 4] + hexChars [Lo(w) and $F];
  729.  
  730.  { remove leading zeros }
  731.  
  732.  WHILE (S [1] = '0') AND (Length (S) > 1) DO System.DELETE (S, 1, 1);
  733.  
  734.  Hex := S;
  735. END;
  736.  
  737. { ╔═══════════════════════════════════════════════════════════════════════╗
  738.   ║                                                                       ║
  739.   ║                                                                       ║
  740.   ╚═══════════════════════════════════════════════════════════════════════╝ }
  741.  
  742. PROCEDURE GUS_InitBase (b : WORD);
  743.  
  744. BEGIN
  745.   GUS_Base := b;
  746.   GUS_Status := GUS_Base + $06;
  747.   GUS_TimerCon := GUS_Base + $08;
  748.   GUS_TimerData := GUS_Base + $09;
  749.   GUS_IRQDMACon := GUS_Base + $0B;
  750.   GUS_MidiCon := GUS_Base + $100;
  751.   GUS_MidiData := GUS_Base + $101;
  752.   GUS_Voice := GUS_Base + $102;
  753.   GUS_Command := GUS_Base + $103;
  754.   GUS_DataLo := GUS_Base + $104;
  755.   GUS_DataHi := GUS_Base + $105;
  756.   GUS_DRAMIO := GUS_Base + $107;
  757. END;
  758.  
  759. { ╔═══════════════════════════════════════════════════════════════════════╗
  760.   ║                                                                       ║
  761.   ║                                                                       ║
  762.   ╚═══════════════════════════════════════════════════════════════════════╝ }
  763.  
  764. PROCEDURE GUS_DetectCard;
  765.  
  766. VAR
  767.   GUSEnv  : STRING;
  768.   EnvStr  : ARRAY [1..5] OF STRING [20];
  769.   EnvCnt  : INTEGER;
  770.   Code    : INTEGER;
  771.  
  772. BEGIN
  773.   GUSEnv := GetEnv ('ULTRASND');
  774.  
  775.   IF GUSEnv <> '' THEN
  776.   BEGIN
  777.     EnvCnt := 1;
  778.  
  779.     FOR EnvCnt := 1 TO 5 DO
  780.     BEGIN
  781.       EnvStr [EnvCnt] := '';
  782.  
  783.       WHILE (GUSEnv [1] <> ',') AND (Length (GUSEnv) > 0) DO
  784.       BEGIN
  785.         EnvStr [EnvCnt] := EnvStr [EnvCnt] + GUSEnv [1];
  786.         System.DELETE (GUSEnv, 1, 1);
  787.       END;
  788.  
  789.       System.DELETE (GUSEnv, 1, 1);
  790.     END;
  791.  
  792.     VAL ('$' + EnvStr [1], GUS_Base, Code);
  793.     IF Code = 0 THEN
  794.     BEGIN
  795.       GUS_InitBase (GUS_Base);
  796.       VAL (EnvStr [4], GUS_IRQ, Code);
  797.     END;
  798.  
  799.     IF Code <> 0 THEN
  800.     BEGIN
  801.       Print ('Error in ULTRASND environment settings.', $0F);
  802.       Print ('Check the settings in your AUTOEXEC.BAT file.', $0F);
  803.  
  804.       GUS_InitBase (0);
  805.       Exit;
  806.     END;
  807.  
  808.     IF GUS_TestBaseAddress = FALSE THEN
  809.       GUS_InitBase (0)
  810.     ELSE
  811.     BEGIN
  812.       Print ('UltraSound with ' + ST (GUS_Mem) + 'K detected at address '
  813.              + Hex (GUS_Base) + 'h, IRQ ' + ST (GUS_IRQ) + '.', $0F);
  814.  
  815.       GUS_Reset;
  816.       GUS_InitHeap (GUS_Mem);
  817.       GUS_SetActiveVoices (BYTE (ActiveVoices));
  818.       GUS_SetIRQ;
  819.       IF DebugKeys THEN Print ('GUS_SetIRQ: UltraSound enabled for IRQ ' + ST (GUS_IRQ) + '.', $0F);
  820.       IF DebugKeys THEN Print ('GUS_MemAvail = ' + ST (GUS_MemAvail), $0F);
  821.       IF DebugKeys THEN Print ('GUS_MaxAvail = ' + ST (GUS_MaxAvail), $0F);
  822.     END;
  823.   END
  824.   ELSE
  825.   BEGIN
  826.     Print ('No ULTRASND environment variable settings were found.', $0F);
  827.     Print ('The ULTRASND environment variable must be set in order for this', $0F);
  828.     Print ('program to determine the UltraSound''s IRQ setting.', $0F);
  829.  
  830.     GUS_InitBase (0);
  831.     Exit;
  832.   END;
  833. END;
  834.  
  835. { ╔═══════════════════════════════════════════════════════════════════════╗
  836.   ║                                                                       ║
  837.   ║                                                                       ║
  838.   ╚═══════════════════════════════════════════════════════════════════════╝ }
  839.  
  840. PROCEDURE GUS_LoadSample (FName : STRING; VAR GPtr : GUS_Ptr);
  841.  
  842. VAR
  843.   F      : FILE;
  844.   Result : WORD;
  845.   FSize  : LONGINT;
  846.   Buff   : POINTER;
  847.  
  848. BEGIN
  849.   {$I-}
  850.   ASSIGN (F, FName);
  851.   RESET (F, 1);
  852.  
  853.   FSize := FileSize (F);
  854.  
  855.   CLOSE (F);
  856.  
  857.   IF FSize <= 65020 THEN RESET (F, FSize);
  858.   {$I+}
  859.  
  860.   Result := IOResult;
  861.  
  862.   IF (Result = 0) AND (FSize <= 65020) THEN
  863.   BEGIN
  864.     GetMem (Buff, FSize);
  865.  
  866.     {$I-}
  867.     BLOCKREAD (F, Buff^, 1);
  868.     CLOSE (F);
  869.     {$I+}
  870.  
  871.     Result := IOResult;
  872.  
  873.     IF Result = 0 THEN
  874.     BEGIN
  875.       GUS_GetMem (GPtr, FSize);
  876. {      GUS_DMATransfer (Buff, GPtr);}
  877.       GUS_MoveSample (LONGINT (Buff), GPtr.GPtr, FSize);
  878.     END;
  879.  
  880.     FreeMem (Buff, FSize);
  881.   END;
  882.  
  883.   IF Result > 0 THEN
  884.     ErrorHandler (252, Result)
  885.   ELSE IF FSize > 65020 THEN
  886.     ErrorHandler (252, 28);
  887. END;
  888.  
  889. { ╔═══════════════════════════════════════════════════════════════════════╗
  890.   ║                                                                       ║
  891.   ║                                                                       ║
  892.   ╚═══════════════════════════════════════════════════════════════════════╝ }
  893.  
  894. PROCEDURE GUS_LoadRAW (FName : STRING; VAR GPtr : GUS_Ptr);
  895.  
  896. TYPE
  897.   BuffType = ARRAY [0..65019] OF SHORTINT;
  898.  
  899. VAR
  900.   F      : FILE;
  901.   Result : WORD;
  902.   FSize  : LONGINT;
  903.   Buff   : ^BuffType;
  904.   Count  : WORD;
  905.  
  906. BEGIN
  907.   {$I-}
  908.   ASSIGN (F, FName);
  909.   RESET (F, 1);
  910.  
  911.   FSize := FileSize (F);
  912.  
  913.   CLOSE (F);
  914.  
  915.   IF FSize <= 65020 THEN RESET (F, FSize);
  916.   {$I+}
  917.  
  918.   Result := IOResult;
  919.  
  920.   IF (Result = 0) AND (FSize <= 65018) THEN
  921.   BEGIN
  922.     GetMem (Buff, FSize);
  923.  
  924.     {$I-}
  925.     BLOCKREAD (F, Buff^, 1);
  926.     CLOSE (F);
  927.     {$I+}
  928.  
  929.     Buff^ [FSize] := 0;
  930.  
  931.     Result := IOResult;
  932.  
  933.     IF Result = 0 THEN
  934.     BEGIN
  935.       GUS_GetMem (GPtr, FSize);
  936.       FOR Count := 0 to FSize - 1 DO
  937.         Buff^ [Count] := SHORTINT (Buff^ [Count] XOR $80);
  938.       GUS_MoveSample (LONGINT (Buff), GPtr.GPtr, FSize);
  939.     END;
  940.  
  941.     FreeMem (Buff, FSize);
  942.   END;
  943.  
  944.   IF Result > 0 THEN
  945.     ErrorHandler (252, Result)
  946.   ELSE IF FSize > 65020 THEN
  947.     ErrorHandler (252, 28);
  948. END;
  949.  
  950. { ╔═══════════════════════════════════════════════════════════════════════╗
  951.   ║                                                                       ║
  952.   ║ This routine builds the MOD frequency table. If you change the # of   ║
  953.   ║ active voices after calling this routine, you must call it again to   ║
  954.   ║ recalculate the table or things will be screwy.                       ║
  955.   ║                                                                       ║
  956.   ╚═══════════════════════════════════════════════════════════════════════╝ }
  957.  
  958. PROCEDURE GUS_MODInit;
  959.  
  960. TYPE
  961.   TablePtr = ^TableType;
  962.   TableType = ARRAY [0..1712] OF WORD;
  963.  
  964.   DivPtr       = ^DivTableType;
  965.   DivTableType = ARRAY [13..31] OF BYTE;
  966.  
  967. VAR
  968.   Temp     : POINTER;
  969.   I, J     : INTEGER;
  970.   EndIndex : INTEGER;
  971.   NoteFreq : WORD;
  972.   Table    : TablePtr;
  973.   DivTable : DivPtr;
  974.  
  975. BEGIN
  976.   MODSpeed := 6;
  977.   MODPlaying := FALSE;
  978.  
  979.   { get the address of the frequency table which is actually in the GUSUTIL
  980.     code segment.  Turbo Pascal thinks FreqTable is a pointer to a PROCEDURE,
  981.     but it is actually just a pointer to the frequency table data }
  982.   Table := @FreqTable;
  983.   DivTable := @FreqDivisors;
  984.  
  985.   { zero the frequency table }
  986.   FillChar (Table^, SizeOf (TableType), 0);
  987.  
  988.   FOR I := (SizeOf (NotePeriods) DIV 2) DownTo 1 DO
  989.   BEGIN
  990.     IF I = 1 THEN
  991.       EndIndex := 1712
  992.     ELSE
  993.       EndIndex := NotePeriods [I - 1];
  994.  
  995.     { find the correct frequency for this period }
  996.     NoteFreq := TRUNC (7093789.2 / INT (NotePeriods [I] * 2));
  997.     NoteFreq := NoteFreq DIV DivTable^ [ActiveVoices];
  998.  
  999.     { fill in the table with the correct frequency, up to the next frequency }
  1000.     FOR J := NotePeriods [I] to EndIndex DO
  1001.       Table^ [J] := NoteFreq;
  1002.   END;
  1003.  
  1004.   GetIntVec ($08, Temp);
  1005.   IF Temp <> @MODInt8 THEN
  1006.   BEGIN
  1007.     PreMODInt8 := Temp;
  1008.     SetIntVec ($08, @MODInt8);
  1009.   END;
  1010.  
  1011.   SetTimer0Rate (55);                   { 55 * 18.2 = 1001 interrupts / sec }
  1012. END;
  1013.  
  1014. { ╔═══════════════════════════════════════════════════════════════════════╗
  1015.   ║                                                                       ║
  1016.   ║                                                                       ║
  1017.   ╚═══════════════════════════════════════════════════════════════════════╝ }
  1018.  
  1019. PROCEDURE GUS_MODDeInit;
  1020.  
  1021. VAR
  1022.   Count : INTEGER;
  1023.  
  1024. BEGIN
  1025.   MODPlaying := FALSE;
  1026.   CurLine := 0;
  1027.   CurPattern := 0;
  1028.   MODSpeed := 6;
  1029.  
  1030.   FOR Count := 0 to 3 DO
  1031.     GUS_StopVoice (Count);
  1032.  
  1033.   SetIntVec ($08, PreMODInt8);
  1034. END;
  1035.  
  1036. { ╔═══════════════════════════════════════════════════════════════════════╗
  1037.   ║                                                                       ║
  1038.   ║                                                                       ║
  1039.   ╚═══════════════════════════════════════════════════════════════════════╝ }
  1040.  
  1041. BEGIN
  1042.   MODData := NIL;
  1043.   GUS_DetectCard;
  1044.  
  1045.   IF GUS_Base <> 0 THEN GUS_MODInit;
  1046.  
  1047.   SEP := ExitProc;
  1048.   ExitProc := @NewExit;
  1049. END.
  1050.