home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / System / Bond FBA / CheapSound.p < prev    next >
Encoding:
Text File  |  1996-05-04  |  1.6 KB  |  79 lines  |  [TEXT/PJMM]
  1. unit CheapSound;
  2. interface
  3.     uses
  4.         Sound;
  5.     procedure TerminateSound;
  6.     procedure PlaySound (mySndID: Integer);
  7.     procedure PlayNamedSound (name: Str255);
  8.     function SoundPlaying: Boolean;
  9.  
  10. implementation
  11.  
  12. {------------ New routines -------------}
  13.  
  14.     var
  15.         mySndChan, mySndChan2: SndChannelPtr;
  16.     const
  17.         kAsync = true;
  18.  
  19.     procedure TerminateSound;
  20.         var
  21.             myErr: OSErr;
  22.     begin
  23.         if mySndChan <> nil then
  24.             myErr := SndDisposeChannel(mySndChan, TRUE);
  25.         if mySndChan2 <> nil then
  26.             myErr := SndDisposeChannel(mySndChan2, TRUE);
  27.         mySndChan := nil;
  28.         mySndChan2 := nil;
  29.     end;
  30.  
  31.     function QChanBusy (chan: SndChannelPtr): Boolean;
  32.         var
  33.             theLength: Integer;
  34.             theStatus: SCStatus;
  35.     begin
  36.         if chan = nil then
  37.             QChanBusy := false
  38.         else if noErr <> SndChannelStatus(chan, SizeOf(SCStatus), @theStatus) then
  39.             QChanBusy := chan^.QHead <> -1 {Didn't work, go back to old way}
  40.         else
  41.             QChanBusy := theStatus.scChannelBusy;
  42.     end;
  43.  
  44.     function SoundPlaying: Boolean;
  45.     begin
  46.         SoundPlaying := QChanBusy(mySndChan);{ or QChanBusy(mySndChan2)}
  47.     end;
  48.  
  49.     procedure PlaySound (mySndID: Integer);
  50.         var
  51.             myErr: OSErr;
  52.             mySndHandle: Handle;
  53.     begin
  54.         TerminateSound;
  55.         mySndChan := nil;
  56.         myErr := SndNewChannel(mySndChan, 0, 0, nil);
  57.  
  58.         mySndHandle := GetResource('snd ', mySndID);
  59.         HLock(mySndHandle);
  60.  
  61.         myErr := SndPlay(mySndChan, mySndHandle, kAsync);
  62.     end;
  63.  
  64.     procedure PlayNamedSound (name: Str255);
  65.         var
  66.             myErr: OSErr;
  67.             mySndHandle: Handle;
  68.     begin
  69.         TerminateSound;
  70.         mySndChan := nil;
  71.         myErr := SndNewChannel(mySndChan, 0, 0, nil);
  72.  
  73.         mySndHandle := GetNamedResource('snd ', name);
  74.         HLock(mySndHandle);
  75.  
  76.         myErr := SndPlay(mySndChan, mySndHandle, kAsync);
  77.     end;
  78.  
  79. end.