Celestin Apprentice 2/Apprentice-Release2.iso/Source Code/Pascal/Utilities/EatAU/EatAU.p

Text File | 1993-12-02 | 13.7 KB | 435 lines | [TEXT/PJMM]

unit EatAU;

(* # Copyright Department of Computer Science *)
(* # University of Western Australia *)
(* # Created : Quinn *)
(* # Station : Eriodon *)
(* # Date : Thursday, 2 December 1993 *)

interface

    uses
        Components, QuickTimeComponents;

    function Main (var params: ComponentParameters; storage: Handle): ComponentResult;

implementation

    uses
        FixMath, Movies;

    procedure QAssertQ (b: boolean);
    (* primitive version of QLibs routine *)
    begin
        if not b then begin
            DebugStr('Assertion failed');
        end; (* if *)
    end; (* QAssertQ *)

    function FSReadQ (refnum: integer; count: longint; buf: Ptr): OSErr;
    (* same as FSRead but count is a value parameter *)
    (* block copied from QLibs *)
    begin
        FSReadQ := FSRead(refnum, count, buf);
    end; (* FSReadQ *)

    const
        (* Hmmm, I'm stealing error codes again.  Shucks! *)
        noAuFileErr = -666;
        strangeEncodingErr = -667;
        strangeChannelsErr = -668;
        notEnoughDataErr = -669;

    const
        kAUVersion = 0;                        (* the version number returned by this component *)
        au_magic = '.snd';                        (* the magic long at the front of .au files *)
        U_LAW = 1;                                (* the only encoding I handle, I'm basically lazy *)
    type
        (* This is the header for the .au file.  It's structure was basically stolen from Sun's header file. *)
        auHeader = record
                magic: OSType;                    (* should be au_magic *)
                header_size: longint;            (* size of header (including comment) *)
                data_size: longint;            (* size of data after comment (might be -1 to mean rest of file) *)
                encoding: longint;                (* should be U_LAW *)
                sample_rate: longint;        (* normally 8000, we deal with any (reasonable) value *)
                channels: longint;                (* should be 1 *)
                    (* followed by comment *)
            end;

        (* The munge array is used to map ULAW sound samples to Mac sound samples. *)
        (* I get it from the AU2L resource when the component is opened. *)
        (* I stole the contents of that resource from Vic Heintz's sun_audio2mac_linear program.*)
        (* There's most probably a better way of doing the conversion but this is all I needed. *)
        mungeArray = packed array[byte] of byte;
        mungePtr = ^mungeArray;
        mungeHandle = ^mungePtr;

        (* The component's globals.  I store a copy of the munge resource in my globals (yeah I know,*)
        (* that means there's one copy for each instance -- tough!).  I also store the progress procedure *)
        (* and its refcon.*)
        globalsRecord = record
                munge: mungeArray;
                progress_proc: ProcPtr;
                progress_refcon: longint;
            end;
        globalsPtr = ^globalsRecord;
        globalsHandle = ^globalsPtr;

    function ReadChunk (globals: globalsHandle; refnum: integer; buffer: Handle; count: longint): OSErr;
    (* Reads count bytes from refnum and puts it in buffer. Then munges it from ULAW (Sun) to linear (Mac) *)
    (* using the munge array in the globals. *)
        type
            dataArray = packed array[0..100000] of byte;
            dataPtr = ^dataArray;
        var
            err: OSErr;
            dp: dataPtr;
            ndx: longint;
            munge: mungePtr;
    begin
        err := FSReadQ(refnum, count, buffer^);
        if err = noErr then begin
            dp := dataPtr(buffer^);
            munge := @globals^^.munge;
            for ndx := 0 to count - 1 do begin
                dp^[ndx] := munge^[dp^[ndx]];
            end; (* for *)
        end; (* if *)
        ReadChunk := err;
    end; (* ReadChunk *)

    function AUCanDo (globals: globalsHandle; selector: integer): ComponentResult;
    (* Handle the Component Manager CanDo request.*)
    begin
        case selector of
            kComponentVersionSelect..kComponentOpenSelect, {}
            kMovieImportFileSelect, {}
            kMovieImportSetProgressProcSelect:
                AUCanDo := 1;
            otherwise
                AUCanDo := 0;
        end; (* case *)
    end; (* AUCanDo *)

    function AUOpen (globals: globalsHandle; self: ComponentInstance): ComponentResult;
    (* Handle the Component Manager Open request. *)
        var
            err: OSErr;
            refnum: integer;
            mungeh: mungeHandle;
    begin
        globals := nil;
        (* create our globals *)
        globals := globalsHandle(NewHandle(sizeof(globalsRecord)));
        err := MemError;

        (* init them with stuff from our resource file *)
        if err = noErr then begin
            globals^^.progress_proc := nil;
            globals^^.progress_refcon := 0;
            refnum := OpenComponentResFile(Component(self));
            if refnum <= 0 then begin
                err := resNotFound;
            end; (* if *)
        end; (* if *)
        if err = noErr then begin
            mungeh := mungeHandle(GetResource('AU2L', 128));
            err := ResError;
            if (mungeh = nil) and (err = noErr) then begin
                err := resNotFound;
            end; (* if *)
            if err = noErr then begin
                globals^^.munge := mungeh^^;
                ReleaseResource(Handle(mungeh));
            end; (* if *)
            err := CloseComponentResFile(refnum);
        end; (* if *)

        (* tell the Component Manager about them *)
        if err = noErr then begin
            SetComponentInstanceStorage(self, Handle(globals));
        end; (* if *)

        (* clean up *)
        if (err <> noErr) and (globals <> nil) then begin
            DisposeHandle(Handle(globals));
        end; (* if *)
        AUOpen := err;
    end; (* AUOpen *)

    function AUClose (globals: globalsHandle; self: ComponentInstance): ComponentResult;
    (* Handle the Component Manager Close request. *)
    begin
        if globals <> nil then begin
            DisposeHandle(Handle(globals));
        end; (* if *)
        AUClose := noErr;
    end; (* AUClose *)

    (* This inline function is used to call a Movie Toolbox style progress function. *)
    function CallProgressProc (theMovie: Movie; message, whatOperation: integer; percentDone: Fixed; refcon: longint; ad: univ Ptr): OSErr;
    inline
        $205F, (* move.l    (a7)+,a0        ; pop proc address    *)
        $4E90; (* jsr        (a0)                ; call proc                *)

    function AUSetProgressProc (globals: globalsHandle; proc: ProcPtr; refcon: longint): ComponentResult;
    (* Handle the SetProgressProc request by recording the information in our globals. *)
    begin
        QAssertQ(globals <> nil);
        globals^^.progress_proc := proc;
        globals^^.progress_refcon := refcon;
        AUSetProgressProc := noErr;
    end; (* AUSetProgressProc *)

    function AUImportFile (globals: globalsHandle; theFile: FSSpec; theMovie: Movie; {}
                                    targetTrack: Track; var usedTrack: Track; {}
                                    atTime: TimeValue; var addedDuration: TimeValue; {}
                                    inFlags: longint; var outFlags: longint): ComponentResult;
    (* Import theFile into theMovie.*)

        var
            header: auHeader;                                        (* a copy of the .au file header *)

            theMedia: Media;                                        (* the media we're adding the data to *)
            sample_desc: SoundDescriptionHandle;        (* describes the sound samples we're adding *)
                                                                            (* it's global to avoid having to new and dispose it every time in AddChunk *)

        function StartSoundTrack: OSErr;
        (* Prepare theMovie to receive the sound data. *)
            var
                err: OSErr;
                time_scale: longint;
        begin
            ClearMoviesStickyError;
            sample_desc := nil;

            (* create a new track (if required by inFlags) *)
            if band(inFlags, movieImportMustUseTrack) = 0 then begin
                targetTrack := NewMovieTrack(theMovie, 0, 0, kFullVolume);
            end; (* if *)

            (* create the media and prepare it for editing *)
            theMedia := NewTrackMedia(targetTrack, SoundMediaType, header.sample_rate, nil, OSType(nil));
            err := BeginMediaEdits(theMedia);
            if err = noErr then begin
                err := GetMoviesStickyError;
                ClearMoviesStickyError;
            end; (* if *)

            (* create the sound description handle *)
            if err = noErr then begin
                sample_desc := SoundDescriptionHandle(NewHandle(sizeof(SoundDescription)));
                err := MemError;
            end; (* if *)

            (* call the progress proc to let it know we're beginning the conversion *)
            if (err = noErr) and (globals^^.progress_proc <> nil) then begin
                err := CallProgressProc(theMovie, movieProgressOpen, progressOpImportMovie, 0, globals^^.progress_refcon, globals^^.progress_proc);
            end; (* if *)
            StartSoundTrack := err;
        end; (* StartSoundTrack *)

        function AddChunk (globals: globalsHandle; buffer: Handle; count: longint; bytes_done, bytes_total: longint): OSErr;
        (* Add count bytes from buffer into theMovie.  Use bytes_done and bytes_total to calculate progress. *)
            var
                err: OSErr;
                junklong: longint;
                percent: Fixed;
        begin
            err := noErr;

            (* call the progress proc to let it know we're converting the movie *)
            if globals^^.progress_proc <> nil then begin
                percent := FixDiv(bytes_done, bytes_total);
                err := CallProgressProc(theMovie, movieProgressUpdatePercent, progressOpImportMovie, percent, globals^^.progress_refcon, globals^^.progress_proc);
            end; (* if *)

            if err = noErr then begin
                (* init the sound description handle *)
                HLock(Handle(sample_desc));
                with sample_desc^^ do begin (* unsafe, checked (locked) *)
                    descSize := GetHandleSize(Handle(sample_desc));
                    dataFormat := longint('raw ');
                    resvd1 := 0;
                    resvd2 := 0;
                    dataRefIndex := 1;
                    version := 0;
                    revlevel := 0;
                    vendor := 0;
                    numChannels := 1;
                    sampleSize := 8;
                    compressionID := 0;
                    packetSize := 0;
                    sampleRate := Long2Fix(header.sample_rate);
                end; (* with *)
                HUnlock(Handle(sample_desc));

                (* add the sound to theMedia *)
                err := AddMediaSample(theMedia, buffer, 0, count, 1, SampleDescriptionHandle(sample_desc), count, 0, junklong);
            end; (* if *)
            AddChunk := err;
        end; (* AddChunk *)

        function EndSoundTrack: OSErr;
        (* Tidy up the movie and setup the return results (usedTrack, addedDuration). *)
            var
                err: OSErr;
                junk: OSErr;
                mediaDuration: TimeValue;
                tmp_time: TimeRecord;
        begin
             (* tidy up the movie *)
            if sample_desc <> nil then begin
                DisposeHandle(Handle(sample_desc));
            end; (* if *)
            junk := EndMediaEdits(theMedia);
            mediaDuration := GetMediaDuration(theMedia);            (* find out the length of the media *)
            junk := InsertMediaIntoTrack(targetTrack, atTime, 0, mediaDuration, Long2Fix(1));

            (* calculate the added duration in movie time *)
            tmp_time.value.hi := 0;
            tmp_time.value.lo := mediaDuration;
            tmp_time.scale := GetMediaTimeScale(theMedia);
            tmp_time.base := nil;
            ConvertTimeScale(tmp_time, GetMovieTimeScale(theMovie));

            (* setup the output results *)
            addedDuration := tmp_time.value.lo;                            (* there goes the high long *)
            usedTrack := targetTrack;

            err := noErr;
            (* call the progress proc to let it know we're finished *)
            if globals^^.progress_proc <> nil then begin
                err := CallProgressProc(theMovie, movieProgressClose, progressOpImportMovie, Long2Fix(100), globals^^.progress_refcon, globals^^.progress_proc);
            end; (* if *)

            (* tidy up *)
            if err = noErr then begin
                err := GetMoviesStickyError;
            end; (* if *)
            ClearMoviesStickyError;
            EndSoundTrack := err;
        end; (* EndSoundTrack *)

        var
            refnum: integer;
            err, err2: OSErr;
            true_size: longint;
            buffer: Handle;
            buffer_size: longint;
            remaining, this_time: longint;
    begin
        QAssertQ(globals <> nil);
        refnum := 0;
        buffer := nil;
        buffer := NewHandle(8192);                            (* try to get a 8K buffer *)
        err := MemError;
        if err <> noErr then begin
            buffer := NewHandle(1024);                        (* if we fail, try for a 1K buffer *)
            err := MemError;
        end; (* if *)
        if err = noErr then begin
            buffer_size := GetHandleSize(buffer);
        end; (* if *)

        (* open up and check the au file *)
        if err = noErr then begin
            err := FSpOpenDF(theFile, fsRdPerm, refnum);
        end; (* if *)
        if err = noErr then begin
            err := GetEOF(refnum, true_size);
        end; (* if *)
        if err = noErr then begin
            err := FSReadQ(refnum, sizeof(header), @header);
        end; (* if *)
        if (err = noErr) & (header.magic <> au_magic) then begin
            err := noAuFileErr;
        end; (* if *)
        if (err = noErr) & (header.encoding <> U_LAW) then begin
            err := strangeEncodingErr;
        end; (* if *)
        if (err = noErr) & (header.channels <> 1) then begin
            err := strangeChannelsErr;
        end; (* if *)
        if (err = noErr) & (header.data_size = -1) then begin
            header.data_size := true_size - header.header_size;
        end; (* if *)
        if (err = noErr) & (header.data_size + header.header_size > true_size) then begin
            err := notEnoughDataErr;
        end; (* if *)
        if err = noErr then begin
            err := SetFPos(refnum, fsFromStart, header.header_size);            (* skip over comment *)
        end; (* if *)

        (* do the work *)
        if err = noErr then begin
            err := StartSoundTrack;
            if err = noErr then begin
                remaining := header.data_size;
                while (err = noErr) & (remaining > 0) do begin
                    if remaining > buffer_size then begin
                        this_time := buffer_size;
                    end
                    else begin
                        this_time := remaining;
                    end; (* if *)
                    err := ReadChunk(globals, refnum, buffer, this_time);
                    if err = noErr then begin
                        err := AddChunk(globals, buffer, this_time, header.data_size - remaining, header.data_size);
                    end; (* if *)
                    if err = noErr then begin
                        err := err2;
                        remaining := remaining - this_time;
                    end; (* if *)
                end; (* while *)
                err2 := EndSoundTrack;
                if err = noErr then begin
                    err := err2;
                end; (* if *)
            end; (* if *)
        end; (* if *)

        (* clean up *)
        if refnum <> 0 then begin
            err2 := FSClose(refnum);
            if err = noErr then begin
                err := err2;
            end; (* if *)
        end; (* if *)
        if buffer <> nil then begin
            DisposeHandle(buffer);
        end; (* if *)
        AUImportFile := err;
    end; (* AUImportFile*)

    function Main (var params: ComponentParameters; storage: Handle): ComponentResult;
    (* Component entry point.  It's pretty neat IMHO. *)
        var
            proc: ProcPtr;
    begin
        proc := nil;
        case params.what of
            (* Component Manager stuff *)
            kComponentVersionSelect:
                Main := kAUVersion;
            kComponentCanDoSelect:
                proc := @AUCanDo;
            kComponentOpenSelect:
                proc := @AUOpen;
            (* Component Manager stuff *)
            kComponentCloseSelect:
                proc := @AUClose;
            (* this component type stuff *)
            kMovieImportFileSelect:
                proc := @AUImportFile;
            kMovieImportSetProgressProcSelect:
                proc := @AUSetProgressProc;
            otherwise
                Main := badComponentSelector;
        end; (* case *)
        if proc <> nil then begin
            Main := CallComponentFunctionWithStorage(storage, params, proc);
        end; (* if *)
    end; (* Main *)

end. (* EatAU *)