[comp.sys.mac.programmer] Asynch sound playing

dweisman@umiami.ir.miami.edu (Ordinary Man) (02/04/91)

	I'm posting this program for asynchronous sound playing on behalf of
John B. Matthews. It was sent to me in reply to my question on this topic. I
hope someone out there can find it useful.

	==Dan

--cut here--

program TestSound;
{Asynchronous 'snd ' play demo, @1990 Gem City Software}
{non-commercial distribution encouraged}
 uses
  Sound;
 const
  sndID = 2000; {id of an 'snd ' resource}
 var
  wRect: Rect;
  sndDone: Boolean; {becomes true when our snd finishes}

 procedure Animation;
  var h, v: Integer;
 begin
  randSeed := TickCount;
  with wRect do
  begin
   h := right - left;
   v := bottom - top
  end;
  while not sndDone do
  begin
   MoveTo(abs(Random) mod h, abs(Random) mod v);
   LineTo(abs(Random) mod h, abs(Random) mod v);
  end
 end;

 procedure SndEnd (sndPtr: SndChannelPtr; theCmd: SndCommand);
  var a5: LongInt;
 begin
  a5 := SetA5(theCmd.param2);
  sndDone := true;
  a5 := SetA5(a5)
 end;

 procedure PlaySound (sndID: Integer);
  var
  sndPtr: SndChannelPtr;
  sndHdl: Handle;
  sndErr: OSErr;
  sndCmd: SndCommand;
 begin
  with sndCmd do {prepare a call back command}
  begin
   cmd := callBackCmd;
   param1 := 0;
   param2 := SetCurrentA5 {needed at interrupt time}
  end;
  sndPtr := SndChannelPtr(NewPtrClear(SizeOf(SndChannel)));
  if sndPtr <> nil then
  begin
   sndPtr^.qLength := stdQLength; {just to be sure}
   sndHdl := GetResource('snd ', sndID);
   if sndHdl <> nil then
    begin
    if SndNewChannel(sndPtr, 0, initMono, @SndEnd) = noErr then
     begin
      sndErr := SndPlay(sndPtr, sndHdl, true);
     {add a call back cmd to this channel's queue}
      sndErr := SndDoCommand(sndPtr, sndCmd, false);
     {continue execution while snd plays}
      Animation;
      sndErr := SndDisposeChannel(sndPtr, false)
     end;
    ReleaseResource(sndHdl)
    end;
   DisposPtr(Ptr(sndPtr))
  end
 end;

 procedure FinishUp;
  var
  theEvent: EventRecord;
  r: Rect;
  s: Str255;
  dh, dv: Integer;
 begin
  s := ' Press any key or the mouse button to end...';
  SetRect(r, 0, 0, 0, 0);
  r.right := StringWidth(s) + 10;
  r.bottom := 20;
  with wRect do
  begin
   dh := (right - r.right) div 2;
   dv := (bottom - r.bottom) div 2
  end;
  OffsetRect(r, dh, dv);
  TextBox(pointer(ord(@s) + 1), length(s), r, TEJustCenter);
  repeat
  until GetNextEvent(mDownMask + keyDownMask, theEvent)
 end;

begin
 InitCursor;
 wRect := screenBits.bounds;
 InsetRect(wRect, 100, 100);
 SetDrawingRect(wRect);
 ShowDrawing; {LSP lazy window open}
 OffsetRect(wRect, -wRect.left, -wRect.top);
 sndDone := false;
 PlaySound(sndID);
 FinishUp
end.

--
John B. Matthews
am103