home *** CD-ROM | disk | FTP | other *** search
/ Sound, Music & MIDI Collection 2 / SMMVOL2.bin / PROG / BWSB120A.ZIP / DEMO / GDMPLAY.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-04-02  |  6.9 KB  |  233 lines
  1.  {──────────────────────────────────────────────────────────────────────────}
  2.  {                     Bells, Whistles, and Sound Boards                    }
  3.  {       Copyright (c) 1993-95, Edward Schlunder. All Rights Reserved.      }
  4.  {══════════════════════════════════════════════════════════════════════════}
  5.  { GDMPLAY.PAS - Example GDM module player                                  }
  6.  {               Written by Alex Chalfin (1994-95)                          }
  7.  {                                                                          }
  8.  {──────────────────────────────────────────────────────────────────────────}
  9. {$M 16384,0,65360}
  10. { Define Stack, Heap minimum, and Heap Maximum. REQUIRED! }
  11. Program gdmplay;
  12.  
  13. Uses Crt, DOS, MSE_TP;
  14.  
  15. Var
  16.   SoundCardName : String;
  17.   DMA, IRQ : Byte;
  18.   BaseIO : Word;
  19.   SampleRate : Word;
  20.   DMABuffer : Word;
  21.   Handle : File;
  22.   Header : GDMHeader;
  23.   EMSFlag : Word;
  24.   MusicChannels : Word;
  25.   ChannelCount : Word;
  26.   ExitProgram : Boolean;
  27.  
  28. Procedure EndProg(ErrorString : String);
  29. { Prints the error string and Halts the program }
  30.  
  31. Begin
  32.   Writeln;
  33.   Writeln(ErrorString);
  34.   If IOResult <> 0 then Close(Handle);
  35.   Halt(0);
  36. End;
  37.  
  38. Function GetSoundCardName : String;
  39.  
  40. Begin
  41.   Writeln;
  42.   Writeln(' Select Sound Card: ');
  43.   Writeln('   1. Gravis Ultrasound');
  44.   Writeln('   2. Sound Blaster 1.0');
  45.   Writeln('   3. Sound Blaster 2.0');
  46.   Writeln('   4. Sound Blaster Pro');
  47.   Writeln('   5. Sound Blaster 16');
  48.   Writeln('   6. Pro Audio Spectrum');
  49.   Case ReadKey of
  50.     '1' : GetSoundCardName := 'GUS.MSE';
  51.     '2' : GetSoundCardName := 'SB1X.MSE';
  52.     '3' : GetSoundCardName := 'SB2X.MSE';
  53.     '4' : GetSoundCardName := 'SBPRO.MSE';
  54.     '5' : GetSoundCardName := 'SB16.MSE';
  55.     '6' : GetSoundCardName := 'PAS.MSE';
  56.   End;
  57. End;
  58.  
  59. Function GetIRQNumber : Byte;
  60.  
  61. Begin
  62.   Writeln;
  63.   Writeln(' Select IRQ: ');
  64.   Writeln('   1. IRQ 2');
  65.   Writeln('   2. IRQ 3');
  66.   Writeln('   3. IRQ 5');
  67.   Writeln('   4. IRQ 7');
  68.   Writeln('   5. IRQ 11');
  69.   Writeln('   6. IRQ 12');
  70.   Writeln('   Any other key for auto-detect.');
  71.   Case ReadKey of
  72.     '1' : GetIRQNumber := 2;
  73.     '2' : GetIRQNumber := 3;
  74.     '3' : GetIRQNumber := 5;
  75.     '4' : GetIRQNumber := 7;
  76.     '5' : GetIRQNumber := 11;
  77.     '6' : GetIRQNumber := 12;
  78.     Else GetIRQNumber := $FF;
  79.   End;
  80. End;
  81.  
  82. Function GetDMAChannel : Byte;
  83.  
  84. Begin
  85.   Writeln;
  86.   Writeln(' Select DMA Channel: ');
  87.   Writeln('   1. DMA Channel 1');
  88.   Writeln('   2. DMA Channel 2');
  89.   Writeln('   3. DMA Channel 3');
  90.   Writeln('   4. DMA Channel 5');
  91.   Writeln('   Any other key for auto-detect.');
  92.   Case ReadKey of
  93.     '1' : GetDMAChannel := 1;
  94.     '2' : GetDMAChannel := 2;
  95.     '3' : GetDMAChannel := 3;
  96.     '4' : GetDMAChannel := 5;
  97.     Else GetDMAChannel := $FF;
  98.   End;
  99. End;
  100.  
  101. Function GetBaseIO : Word;
  102.  
  103. Begin
  104.   Writeln;
  105.   Writeln(' Select Base I/O Address: ');
  106.   Writeln('   1. 210h');
  107.   Writeln('   2. 220h');
  108.   Writeln('   3. 230h');
  109.   Writeln('   4. 240h');
  110.   Writeln('   5. 250h');
  111.   Writeln('   6. 260h');
  112.   Writeln('   Any other key for auto-detect.');
  113.   Case ReadKey of
  114.     '1' : GetBaseIO := $210;
  115.     '2' : GetBaseIO := $220;
  116.     '3' : GetBaseIO := $230;
  117.     '4' : GetBaseIO := $240;
  118.     '5' : GetBaseIO := $250;
  119.     '6' : GetBaseIO := $260;
  120.     Else GetBaseIO := $FFFF;
  121.   End;
  122. End;
  123.  
  124. Function GetModuleName : String;
  125.  
  126. Var
  127.   Temp : String;
  128.  
  129. Begin
  130.   Writeln;
  131.   Writeln('Sound Device: ', DeviceName);
  132.   Write('Modulename: ');
  133.   Readln(Temp);
  134.   Writeln;
  135.   GetModuleName := Temp;
  136. End;
  137.  
  138. Function ToHex(Num : Word) : String;
  139. { Converts a decimal number to Hexidecimal }
  140.  
  141. Const
  142.   HexChars : String = '0123456789ABCDEF';
  143.  
  144. Var
  145.   Temp : String;
  146.  
  147. Begin
  148.   Temp := '';
  149.   Temp := Temp + HexChars[((Num Shr 8) And 15) + 1];
  150.   Temp := Temp + HexChars[((Num Shr 4) And 15) + 1];
  151.   Temp := Temp + HexChars[((Num Shr 0) And 15) + 1];
  152.   ToHex := Temp + 'h';
  153. End;
  154.  
  155.  
  156. Begin
  157.   SoundCardName := GetSoundCardName; { Get the Sound card to be used      }
  158.   BaseIO := GetBaseIO;               { Get the Base port address          }
  159.   IRQ := GetIRQNumber;               { Get IRQ number                     }
  160.   DMA := GetDMAChannel;              { Get DMA Channel                    }
  161.   SampleRate := 45;                  { Initially set at 45Khz             }
  162.   DMABuffer := 4096;                 { DMA Buffer of 4096 bytes           }
  163.   Case LoadMSE(SoundCardName, 0, SampleRate, DMABuffer, BaseIO, IRQ, DMA) of
  164.     1 : EndProg('Base I/O address autodetection failure');
  165.     2 : EndProg('IRQ level autodetection failure');
  166.     3 : EndProg('DMA channel autodetection failure');
  167.     4 : EndProg('DMA channel not supported');
  168.     6 : EndProg('Sound device does not respond');
  169.     7 : EndProg('Memory control blocks destroyed');
  170.     8 : EndProg('Insufficient memory for mixing buffers');
  171.     9 : EndProg('Insufficient memory for MSE file');
  172.     10: EndProg('MSE has invalid identification string');
  173.     11: EndProg('MSE disk read failure');
  174.     12: EndProg('MVSOUND.SYS not loaded');
  175.   End;
  176.   ExitProc := @FreeMSE;              { Call FreeMSE on abnormal program end }
  177.   If EMSExist                      { Check for EMS }
  178.     Then EMSFlag := 1              { Yes, EMS exists, so use it }
  179.     Else EMSFlag := 0;             { EMS does not exist }
  180.  
  181. {$I-}                              { Turn off I/O checking }
  182.   Assign(Handle, GetModuleName);   { Open the file for loading }
  183.   Reset(Handle);
  184. {$I+}                              { Turn I/O checking back on }
  185.   If IOResult <> 0 Then
  186.      EndProg('Module does not exist');    { File not found, exit program }
  187.  
  188.   Case LoadGDM(Handle, 0, EMSFlag, Header) of
  189.     1 : EndProg('Module is corrupt');
  190.     2 : EndProg('Could not autodetect module type (N/A)');
  191.     3 : EndProg('Bad file format ID string');
  192.     4 : EndProg('Insufficient memory to load module');
  193.     5 : EndProg('Can not unpack samples');
  194.     6 : EndProg('AdLib instruments not supported');
  195.   End;
  196.   Close(Handle);
  197.  
  198.   MusicChannels := 0;            { Calculate the number of channels in song }
  199.   For ChannelCount := 1 to 32 do
  200.     Begin
  201.       If Header.PanMap[ChannelCount] <> $FF
  202.         Then MusicChannels := MusicChannels + 1;
  203.     End;
  204.   SampleRate := StartOutput(MusicChannels, 0);
  205.   StartMusic;
  206.   Writeln('Port: ', ToHex(BaseIO),'  IRQ: ',IRQ,'  DMA: ',DMA);
  207.   Writeln('Oversampling: ', SampleRate);
  208.   Writeln;
  209.   Writeln('D for DOS Shell or any other key to quit');
  210.   ExitProgram := False;
  211.   Repeat
  212.     GotoXY(1, WhereY);
  213.     Write('Order: ', MusicOrder($FF), ' Pattern: ', MusicPattern($FF), ' Row: ', MusicRow);
  214.     ClrEOL;
  215.     If KeyPressed Then Begin
  216.       Case ReadKey of
  217.       'd', 'D' : Begin
  218.                    Writeln;
  219.                    Writeln;
  220.                    Write('Type ''EXIT'' to return to GDMPLAY');
  221.                    Exec('c:\command.com','');
  222.                  End;
  223.       Else ExitProgram := True;
  224.       End;
  225.     End;
  226.   Until ExitProgram;
  227.  
  228.   StopMusic;
  229.   StopOutput;
  230.   UnloadModule;
  231.   FreeMse;
  232. End.
  233.