Celestin Apprentice 7/Apprentice-Release7.iso/Source Code/Pascal/Snippets/PNL Libraries/MyPlayAsyncSound.p

Text File | 1997-05-29 | 3.9 KB | 177 lines | [TEXT/CWIE]

unit MyPlayAsyncSound;

interface

    uses
        Types, Memory;

    const
        max_sound_channels = 10;

    procedure StartupPlayAsyncSound;
    procedure ConfigurePlayAsyncSound( channels: integer );

    procedure PlayAsyncSound (theSound: Handle);
    procedure PlayAsyncSoundID (id: integer);
    function SoundIsPlaying: boolean;

implementation

    uses
        Resources, Sound,
        MyMemory, MyStartup, MyAssertions;

{$ifc do_debug}
    var
        startup_check: integer;
{$endc}

{$PUSH}
{$ALIGN MAC68K}
    const
        MyQLength = 10;
    type
        MySndChannel = packed record
            nextChan:SndChannelPtr;
            firstMod:Ptr;
            callBack:SndCallBackUPP;
            userInfo:longint;
            wait:longint;
            cmdInProgress:SndCommand;
            flags:integer;
            qLength:integer;
            qHead:integer;
            qTail:integer;
            queue:array[0..MyQLength-1] of SndCommand;
            in_use: boolean;
        end;
    MySndChannelPtr = ^MySndChannel;
    MySndChannelArray = array[1..max_sound_channels] of MySndChannel;
    MySndChannelArrayPtr = ^MySndChannelArray;
{$ALIGN RESET}
{$POP}

    var
        gChannels: integer;
        channels: MySndChannelArrayPtr;
        gChanCallBackProc:SndCallBackUPP;

    function SoundIsPlaying: boolean;
        var
            i: integer;
    begin
        SoundIsPlaying := false;
        for i := 1 to gChannels do begin
            if channels^[i].in_use then begin
                SoundIsPlaying := true;
                leave;
            end;
        end;
    end;

{ Called at interupt level! }
    procedure ChanCallBack( chan: SndChannelPtr; var cmd: SndCommand );
    begin
{$unused(cmd)}
        Assert( MySndChannelPtr(chan)^.in_use );
        MySndChannelPtr(chan)^.in_use := false;
    end;

    procedure PlayAsyncSound( theSound: Handle );
        var
            err: OSErr;
            myWish: SndCommand;
            i, free: integer;
    begin
        AssertDidStartup( startup_check );
        Assert( (theSound <> nil) & (theSound^ <> nil) );
        if (theSound <> nil) & (theSound^ <> nil) then begin
            free := -1;
            for i := 1 to gChannels do begin
                if not channels^[i].in_use then begin
                    free := i;
                    leave;
                end;
            end;
            if free > 0 then begin
                channels^[free].in_use := true;
                err := SndPlay( @channels^[free], SndListHandle(theSound), true );
                { set up a sound mgr command block }
                if err = noErr then begin
                    myWish.cmd := callBackCmd;
                    myWish.param1 := 0;
                    myWish.param2 := 0;
                    err := SndDoCommand( @channels^[free], myWish, false );
                    { If any of these commands return with an error, we aren't going to get anywhere anyway }
                end;
                if err <> noErr then begin
                    channels^[free].in_use := false;
                end;
            end;
        end;
    end;

    procedure PlayAsyncSoundID (id: integer);
        var
            sound: Handle;
    begin
        sound := GetResource('snd ', id);
        Assert( sound <> nil );
        if sound <> nil then begin
            PlayAsyncSound(sound);
        end;
    end;

    function InitPlayAsyncSound(var msg: integer): OSStatus;
        var
            err: OSErr;
            i: integer;
            cp: SndChannelPtr;
    begin
{$unused(msg)}
        DidStartup( startup_check );
        Assert( (0 < gChannels) & (gChannels <= max_sound_channels) );
        gChanCallBackProc := NewSndCallBackProc( @ChanCallBack );
        err := MNewPtr( channels, SizeOf(MySndChannel) * gChannels );
        if err = noErr then begin
            for i := 1 to gChannels do begin
                if err = noErr then begin
                    channels^[i].qLength := MyQLength;
                    channels^[i].in_use := false;
                    cp := SndChannelPtr(@channels^[i]);
                    err := SndNewChannel( cp, 0, 0, gChanCallBackProc );
                end;
            end;
        end;
        InitPlayAsyncSound := err;
    end;

    procedure FinishPlayAsyncSound;
        var
            i: integer;
            junk: OSErr;
    begin
        for i := 1 to gChannels do begin
            junk := SndDisposeChannel( @channels^[i], true );
        end;
        MDisposePtr( channels );
    end;

    procedure ConfigurePlayAsyncSound( channels: integer );
    begin
        gChannels := channels;
        Assert( (0 < gChannels) & (gChannels <= max_sound_channels) );
        StartupPlayAsyncSound;
    end;

    procedure StartupPlayAsyncSound;
    begin
        SetStartup(InitPlayAsyncSound, nil, 0, FinishPlayAsyncSound);
    end;

end.
        playing: boolean;
        finished: boolean;
        current_sound: Handle;
        chan: SndChannelPtr;