home *** CD-ROM | disk | FTP | other *** search
/ Sound, Music & MIDI Collection 2 / SMMVOL2.bin / PROG / BWSB120A.ZIP / DEMO / GDMSCOPE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-04-02  |  7.4 KB  |  258 lines
  1.  {──────────────────────────────────────────────────────────────────────────}
  2.  {                     Bells, Whistles, and Sound Boards                    }
  3.  {       Copyright (c) 1993-95, Edward Schlunder. All Rights Reserved.      }
  4.  {══════════════════════════════════════════════════════════════════════════}
  5.  { GDMSCOPE.PAS - Example GDM module player & oscilliscope                  }
  6.  {                Written by Alex Chalfin (1994-95)                         }
  7.  {                                                                          }
  8.  {──────────────────────────────────────────────────────────────────────────}
  9.  
  10. {$M 16384,0,0}
  11. { Define Stack, Heap minimum, and Heap Maximum. REQUIRED! }
  12. Program GDMScope;
  13.  
  14. Uses Crt, MSE_TP;
  15.  
  16. Var
  17.   SoundCardName : String;
  18.   DMA, IRQ : Byte;
  19.   BaseIO : Word;
  20.   SampleRate : Word;
  21.   DMABuffer : Word;
  22.   Handle : File;
  23.   Header : GDMHeader;
  24.   EMSFlag : Word;
  25.   MusicChannels : Word;
  26.   ChannelCount : Word;
  27.  
  28. Procedure SetMode(Mode : Word); Assembler;
  29. { Sets the specified gfx mode }
  30.  
  31. Asm
  32.   Mov  ax,Mode
  33.   Int  10h;
  34. End;
  35.  
  36. Procedure EndProg(ErrorString : String);
  37. { Prints the error string and Halts the program }
  38.  
  39. Begin
  40.   Writeln;
  41.   Writeln(ErrorString);
  42.   If IOResult <> 0 then Close(Handle);
  43.   Halt(0);
  44. End;
  45.  
  46. Function GetSoundCardName : String;
  47.  
  48. Begin
  49.   Writeln;
  50.   Writeln(' Select Sound Card: ');
  51.   Writeln('   1. Gravis UltraSound');
  52.   Writeln('   2. Sound Blaster 1.0');
  53.   Writeln('   3. Sound Blaster 2.0');
  54.   Writeln('   4. Sound Blaster Pro');
  55.   Writeln('   5. Sound Blaster 16');
  56.   Writeln('   6. Pro Audio Spectrum');
  57.   Case ReadKey of
  58.     '1' : GetSoundCardName := 'GUS.MSE';
  59.     '2' : GetSoundCardName := 'SB1X.MSE';
  60.     '3' : GetSoundCardName := 'SB2X.MSE';
  61.     '4' : GetSoundCardName := 'SBPRO.MSE';
  62.     '5' : GetSoundCardName := 'SB16.MSE';
  63.     '6' : GetSoundCardName := 'PAS.MSE';
  64.   End;
  65. End;
  66.  
  67. Function GetIRQNumber : Byte;
  68.  
  69. Begin
  70.   Writeln;
  71.   Writeln(' Select IRQ: ');
  72.   Writeln('   1. IRQ 2');
  73.   Writeln('   2. IRQ 3');
  74.   Writeln('   3. IRQ 5');
  75.   Writeln('   4. IRQ 7');
  76.   Writeln('   5. IRQ 11');
  77.   Writeln('   6. IRQ 12');
  78.   Writeln('   Any other key for auto-detect.');
  79.   Case ReadKey of
  80.     '1' : GetIRQNumber := 2;
  81.     '2' : GetIRQNumber := 3;
  82.     '3' : GetIRQNumber := 5;
  83.     '4' : GetIRQNumber := 7;
  84.     '5' : GetIRQNumber := 11;
  85.     '6' : GetIRQNumber := 12;
  86.     Else GetIRQNumber := $FF;
  87.   End;
  88. End;
  89.  
  90. Function GetDMAChannel : Byte;
  91.  
  92. Begin
  93.   Writeln;
  94.   Writeln(' Select DMA Channel: ');
  95.   Writeln('   1. DMA Channel 1');
  96.   Writeln('   2. DMA Channel 2');
  97.   Writeln('   3. DMA Channel 3');
  98.   Writeln('   4. DMA Channel 5');
  99.   Writeln('   Any other key for auto-detect.');
  100.   Case ReadKey of
  101.     '1' : GetDMAChannel := 1;
  102.     '2' : GetDMAChannel := 2;
  103.     '3' : GetDMAChannel := 3;
  104.     '4' : GetDMAChannel := 5;
  105.     Else GetDMAChannel := $FF;
  106.   End;
  107. End;
  108.  
  109. Function GetBaseIO : Word;
  110.  
  111. Begin
  112.   Writeln;
  113.   Writeln(' Select Base IO port: ');
  114.   Writeln('   1. 210h');
  115.   Writeln('   2. 220h');
  116.   Writeln('   3. 230h');
  117.   Writeln('   4. 240h');
  118.   Writeln('   5. 250h');
  119.   Writeln('   6. 260h');
  120.   Writeln('   Any other key for auto-detect.');
  121.   Case ReadKey of
  122.     '1' : GetBaseIO := $210;
  123.     '2' : GetBaseIO := $220;
  124.     '3' : GetBaseIO := $230;
  125.     '4' : GetBaseIO := $240;
  126.     '5' : GetBaseIO := $250;
  127.     '6' : GetBaseIO := $260;
  128.     Else GetBaseIO := $FFFF;
  129.   End;
  130. End;
  131.  
  132. Function GetModuleName : String;
  133.  
  134. Var
  135.   Temp : String;
  136.  
  137. Begin
  138.   Writeln;
  139.   Write('Modulename: ');
  140.   Readln(Temp);
  141.   Writeln;
  142.   GetModuleName := Temp;
  143. End;
  144.  
  145. Procedure VertBar(X, Height, Color : Word); Near; Assembler;
  146. { Draws a vertical bar at Position X, of Height centered around Y=100 }
  147. { Used for drawing the waveform }
  148.  
  149. Asm
  150.   Mov ax,$A000   { Draw directly on VGA screen }
  151.   Mov es,ax
  152.   Mov cx,Height
  153.   Shr cx,1
  154.   Jz @Exit
  155.   Mov bx,cx
  156.   Mov ax,100
  157.   Sub ax,bx
  158.   Mov bx,320
  159.   Mul bx
  160.   Add ax,X
  161.   Mov di,ax
  162.   Mov ax,Color
  163.  @Looper:
  164.   Mov es:[di],al
  165.   Mov es:[di+320],al
  166.   Add di,640
  167.   Dec cx
  168.   Jnz @Looper
  169.  @Exit:
  170. End;
  171.  
  172. Procedure DoScope;
  173. { Draws a view Scope on the screen. }
  174.  
  175. Var
  176.   Last : Array[0..319] of Byte;
  177.   X : Integer;
  178.   Left, Right : Word;
  179.   LeftInt, RightInt : Integer;
  180.  
  181. Begin
  182.   FillChar(Last, Sizeof(Last), 100);
  183.   DirectVideo := False;
  184.   Write('      Left                   Right');
  185.   VertBar(160, 200, 2);
  186.   X := 0;
  187.   Repeat
  188.     GetMainScope(Left, Right);
  189.     LeftInt := Abs(Integer(Left Shr 8) - 128) + 2;   { Scale Left scope }
  190.     RightInt := Abs(Integer(Right Shr 8) - 128) + 2; { Scale Right scope }
  191.     Last[x] := LeftInt;
  192.     Last[x+161] := RightInt;
  193.     VertBar(x, LeftInt, 15);           { Draw Left value }
  194.     VertBar(x+161, RightInt, 15);      { Draw right value }
  195.     X := X + 1;
  196.     If X > 159 Then X := 0;
  197.     VertBar(x, Last[x], 0);         { Clear left value }
  198.     VertBar(x+161, Last[x+161], 0); { Clear right value }
  199.   Until KeyPressed;
  200. End;
  201.  
  202.  
  203. Begin
  204.   SoundCardName := GetSoundCardName; { Get the Sound card to be used      }
  205.   BaseIO := GetBaseIO;               { Get the Base port address          }
  206.   IRQ := GetIRQNumber;               { Get IRQ number                     }
  207.   DMA := GetDMAChannel;              { Get DMA Channel                    }
  208.   SampleRate := 45;                  { Initially set at 45Khz             }
  209.   DMABuffer := 4096;                 { DMA Buffer of 4096 bytes           }
  210.   Case LoadMSE(SoundCardName, 0, SampleRate, DMABuffer, BaseIO, IRQ, DMA) of
  211.     1 : EndProg('Base I/O address autodetection failure');
  212.     2 : EndProg('IRQ level autodetection failure');
  213.     3 : EndProg('DMA channel autodetection failure');
  214.     4 : EndProg('DMA channel not supported');
  215.     6 : EndProg('Sound device does not respond');
  216.     7 : EndProg('Memory control blocks destroyed');
  217.     8 : EndProg('Insufficient memory for mixing buffers');
  218.     9 : EndProg('Insufficient memory for MSE file');
  219.     10: EndProg('MSE has invalid identification string');
  220.     11: EndProg('MSE disk read failure');
  221.     12: EndProg('MVSOUND.SYS not loaded');
  222.   End;
  223.   ExitProc := @FreeMSE;              { Call FreeMSE on abnormal program end }
  224.   If EMSExist                      { Check for EMS }
  225.     Then EMSFlag := 1              { Yes, EMS exists, so use it }
  226.     Else EMSFlag := 0;             { EMS does not exist }
  227. {$I-}                              { Turn off I/O checking }
  228.   Assign(Handle, GetModuleName);   { Open the file for loading }
  229.   Reset(Handle);
  230. {$I+}                              { Turn I/O checking back on }
  231.   If IOResult <> 0 Then
  232.      EndProg('Module does not exist');   { File not found, exit program }
  233.      
  234.   Case LoadGDM(Handle, 0, EMSFlag, Header) of
  235.     1 : EndProg('Module is corrupt');
  236.     2 : EndProg('Could not autodetect module type (N/A)');
  237.     3 : EndProg('Bad file format ID string');
  238.     4 : EndProg('Insufficient memory to load module');
  239.     5 : EndProg('Can not unpack samples');
  240.     6 : EndProg('AdLib instruments not supported');
  241.   End;
  242.   Close(Handle);
  243.  
  244.   MusicChannels := 0;            { Calculate the number of channels in song }
  245.   For ChannelCount := 1 to 32 do
  246.     Begin
  247.       If Header.PanMap[ChannelCount] <> $FF
  248.         Then MusicChannels := MusicChannels + 1;
  249.     End;
  250.   SampleRate := StartOutput(MusicChannels, 0);
  251.   SetMode($13); { Initialize graphics mode 13h }
  252.   StartMusic;
  253.   DoScope;      { Do the oscilliscope }
  254.   StopOutput;
  255.   SetMode($03); { Return to text mode }
  256.   UnloadModule;
  257.   FreeMse;
  258. End.