home *** CD-ROM | disk | FTP | other *** search
/ Sound, Music & MIDI Collection 2 / SMMVOL2.bin / WAVUTIL / SBDSP103.ZIP / PLAYVOCD.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-09-10  |  7.0 KB  |  171 lines
  1. {       SBDSP is Copyright 1994 by Ethan Brodsky.  All rights reserved.      }
  2. {$M 16384, 0, 419430   Give some memory to the DOS shell.  If you are not}
  3. {going to shell to DOS, you can remove this line and let your program use}
  4. {all available memory for the heap.}
  5. program PlayVOCDirect;
  6.     uses
  7.         CRT,
  8.         DOS,
  9.         Mem,
  10.         SBDSP,
  11.         VOC;
  12.     const
  13.         IRQ        = 5;
  14.         BaseIO     = $220;
  15.         DMAChannel = 1;
  16.         DefaultVOC = 'C:\MUSIC\ESCAPE2.VOC';
  17.          {Put the name of the VOC file to play here}
  18.          {or pass it as a parameter to the program.}
  19.     var
  20.         VOCFileName : string;
  21.         SoundSize   : LongInt;
  22.         Sound       : PSound;
  23.         Chr         : char;
  24.         OldMarkerProc : pointer;
  25.     function GetHexWordStr(w: word): string;
  26.         const
  27.             HexChars: array [0..$F] of Char = '0123456789ABCDEF';
  28.         begin
  29.             GetHexWordStr := HexChars[Hi(w) shr 4] + HexChars[Hi(w) and $F] +
  30.                              HexChars[Lo(w) shr 4] + HexChars[Lo(w) and $F];
  31.         end;
  32.     procedure DisplayMarker; far;
  33.         var
  34.             Hour, Minute, Second, Sec100: word;
  35.         begin
  36.             GetTime(Hour, Minute, Second, Sec100);
  37.             writeln('Reached marker ', LastMarker,
  38.                     ' at ', Hour, ':', Minute, ':', Second, '.', Sec100);
  39.             if (OldMarkerProc <> nil) then Proc(OldMarkerProc);
  40.               {If another handler is installed, call it}
  41.         end;
  42.     procedure WriteInstructions;
  43.         begin
  44.             writeln('Begining output of sound file');
  45.             writeln('Press <B> to break loop');
  46.             writeln('Press <P> to pause output');
  47.             writeln('Press <C> to continue output');
  48.             writeln('Press <D> to shell to DOS');
  49.             writeln('Press <X> to stop output and exit');
  50.         end;
  51.     begin
  52.         writeln; writeln;
  53.  
  54.         if EnvironmentSet
  55.             then
  56.                 begin
  57.                     if InitSBFromEnv
  58.                         then
  59.                             begin
  60.                                 writeln('Sound card initialized correctly using the BLASTER environment variable!');
  61.                                 writeln('DSP version ', GetDSPVersion);
  62.                             end
  63.                         else
  64.                             begin
  65.                                 writeln('Error initializing sound card!');
  66.                                 Halt(255);
  67.                             end;
  68.                 end
  69.             else
  70.                 begin
  71.                     writeln('BLASTER environment variable not set, using default settings');
  72.                     writeln('IRQ = ', IRQ, '    Base IO = $', GetHexWordStr(BaseIO), '    DMA Channel = ', DMAChannel );
  73.                     if InitSB(IRQ, BaseIO, DMAChannel)
  74.                         then
  75.                             begin
  76.                                 writeln('Sound card initialized correctly!');
  77.                                 writeln('DSP version ', GetDSPVersion);
  78.                             end
  79.                         else
  80.                             begin
  81.                                 writeln('Error initializing sound card!');
  82.                                 Halt(255);
  83.                             end;
  84.                 end;
  85.  
  86.         if ParamCount = 0
  87.             then VOCFileName := DefaultVOC
  88.             else VOCFileName := ParamStr(1);
  89.         SoundSize := LoadVOCfile(VOCFileName, Sound);  writeln('Sound file loaded');
  90.         if SoundSize = 0
  91.             then
  92.                 begin
  93.                     writeln('Error loading VOC file.  Probably because:');
  94.                     writeln('    1.  There is no VOC file by name ', VOCFileName, '.');
  95.                     writeln('    2.  There is not enough memory to load it.');
  96.                     writeln('        Largest available block:  ', MaxAvail, ' bytes');
  97.                     Halt;
  98.                 end;
  99.  
  100.         GetMarkerProc(OldMarkerProc);
  101.         SetMarkerProc(@DisplayMarker);
  102.  
  103.         TurnSpeakerOn;
  104.         WriteInstructions;
  105.         PlaySound(Sound);
  106.         repeat
  107.             if KeyPressed
  108.                 then
  109.                     begin
  110.                         Chr := UpCase(ReadKey);
  111.                         case Chr
  112.                             of
  113.                                 'B':
  114.                                     begin
  115.                                         BreakLoop;
  116.                                         writeln('Broke out of loop');
  117.                                     end;
  118.  
  119.                                 'P':
  120.                                     begin
  121.                                         PauseSound;
  122.                                         writeln('Sound output paused');
  123.                                     end;
  124.                                 'C':
  125.                                     begin
  126.                                         ContinueSound;
  127.                                         writeln('Sound output continued');
  128.                                     end;
  129.                                 'D':
  130.                                     begin
  131.                                         SwapVectors;
  132.                                         Exec(GetEnv('COMSPEC'), '');
  133.                                         if DOSError <> 0
  134.                                             then
  135.                                                 begin
  136.                                                     writeln('Error running COMMAND.COM!');
  137.                                                     Halt(255);
  138.                                                 end;
  139.                                         SwapVectors;
  140.                                         WriteInstructions;
  141.                                     end;
  142.                                 'X':
  143.                                     begin
  144.                                         PauseSound;
  145.                                         writeln('Sound output stopped!');
  146.                                         Exit;
  147.                                     end;
  148.                             end;
  149.                     end;
  150.             if UnknownBlock
  151.                 then
  152.                     begin
  153.                         writeln('An unknown VOC block was reached.  It is probably');
  154.                         writeln('block 8, which I didn''t implement because it is');
  155.                         writeln('useless. (At least for this library it is)');
  156.                         UnknownBlock := false;
  157.                     end;
  158.             if UnplayedBlock
  159.                then
  160.                    begin
  161.                        writeln('A 16-bit or stereo block was reached.  This library');
  162.                        writeln('doesn''t support either of these.');
  163.                        UnplayedBlock := false;
  164.                    end;
  165.         until (SoundPlaying = false);
  166.         TurnSpeakerOff;
  167.  
  168.         SetMarkerProc(OldMarkerProc); {Not really necessary}
  169.         FreeBuffer(pointer(Sound), SoundSize);
  170.         ShutDownSB;
  171.     end.