Usenet 1994 October/usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso/misc/volume43/tclmidi/part04

Internet Message Format | 1994-07-21 | 63KB

From: [e-mail] (Mike Durian)
Newsgroups: comp.sources.misc
Subject: v43i112:  tclmidi - A language for manipulating MIDI files, v2.0, Part04/14
Date: 21 Jul 1994 19:26:26 -0500
Organization: Sterling Software
Sender: [e-mail]
Approved: [e-mail]
Message-ID: <30n3ni$[e-mail]>
X-Md4-Signature: bb696fc3a4659398b68bd179ded8ce22

Submitted-by: [e-mail] (Mike Durian)
Posting-number: Volume 43, Issue 112
Archive-name: tclmidi/part04
Environment: POSIX, (BSDI, NetBSD, LINUX, SVR4 for optional driver), C++, TCL
Supersedes: tclm: Volume 37, Issue 43-47

#! /bin/sh
# This is a shell archive.  Remove anything before this line, then feed it
# into a shell via "sh file" or similar.  To overwrite existing files,
# type "sh file -c".
# Contents:  tclmidi-2.0/contrib/mmerge tclmidi-2.0/tclmCmd.C
#   tclmidi-2.0/tclmEvent.C tclmidi-2.0/tclmPlay.C
# Wrapped by kent@sparky on Thu Jul 21 19:05:14 1994
PATH=/bin:/usr/bin:/usr/ucb:/usr/local/bin:/usr/lbin:$PATH ; export PATH
echo If this archive is complete, you will see the following message:
echo '          "shar: End of archive 4 (of 14)."'
if test -f 'tclmidi-2.0/contrib/mmerge' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'tclmidi-2.0/contrib/mmerge'\"
else
  echo shar: Extracting \"'tclmidi-2.0/contrib/mmerge'\" \(700 characters\)
  sed "s/^X//" >'tclmidi-2.0/contrib/mmerge' <<'END_OF_FILE'
X#!/usr/local/bin/tclmidi
X
Xif {$argc} {
X    puts {Usage: mmerge < type1.mid > type0.mid}
X    exit 1
X}
X
Xset imf [midiread stdin]
Xset config [midiconfig $imf]
X
Xif {[lindex [lindex $config 0] 1] != 1} {
X    puts stderr {Input must be type 1}
X    exit -1
X}
X
Xset division [lindex $config 1]
Xset omf [midimake]
Xmidiconfig $omf "format 0" $division "tracks 1"
Xset tracks [lindex [lindex $config 2] 1]
X
Xfor {set i 0} {$i < $tracks} {incr i} {
X    midirewind $imf
X    set lastevent [midiget $imf $i prev]
X    if {[lindex $lastevent 1] == "MetaEndOfTrack"} {
X        mididelete $imf $i $lastevent
X    }
X    midimerge "$omf 0" "$imf $i"
X}
X
Xmidiput $omf 0 "[miditrack $omf 0 end] MetaEndOfTrack"
Xmidiwrite stdout $omf
Xmidifree $imf
Xmidifree $omf
END_OF_FILE
  if test 700 -ne `wc -c <'tclmidi-2.0/contrib/mmerge'`; then
    echo shar: \"'tclmidi-2.0/contrib/mmerge'\" unpacked with wrong size!
  fi
  chmod +x 'tclmidi-2.0/contrib/mmerge'
  # end of 'tclmidi-2.0/contrib/mmerge'
fi
if test -f 'tclmidi-2.0/tclmCmd.C' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'tclmidi-2.0/tclmCmd.C'\"
else
  echo shar: Extracting \"'tclmidi-2.0/tclmCmd.C'\" \(22271 characters\)
  sed "s/^X//" >'tclmidi-2.0/tclmCmd.C' <<'END_OF_FILE'
X/*-
X * Copyright (c) 1993, 1994 Michael B. Durian.  All rights reserved.
X *
X * Redistribution and use in source and binary forms, with or without
X * modification, are permitted provided that the following conditions
X * are met:
X * 1. Redistributions of source code must retain the above copyright
X *    notice, this list of conditions and the following disclaimer.
X * 2. Redistributions in binary form must reproduce the above copyright
X *    notice, this list of conditions and the following disclaimer in the
X *    documentation and/or other materials provided with the distribution.
X * 3. All advertising materials mentioning features or use of this software
X *    must display the following acknowledgement:
X *    This product includes software developed by Michael B. Durian.
X * 4. The name of the the Author may be used to endorse or promote
X *    products derived from this software without specific prior written
X *    permission.
X *
X * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED
X * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
X * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
X * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
X * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
X * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
X * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
X * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
X * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
X * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
X * SUCH DAMAGE.
X */
Xextern "C" {
X#include <tcl.h>
X}
X#include <stdlib.h>
X#include <string.h>
X#include <iostream.h>
X#include "tclmidi.h"
X#include "TclmInterp.h"
X#include "Song.h"
X#include "tclmEvent.h"
X#include "patchlevel.h"
X
Xstatic int Tclm_MidiMake(ClientData client_data, Tcl_Interp *interp, int argc,
X    char *argv[]);
Xstatic int Tclm_MidiFree(ClientData client_data, Tcl_Interp *interp, int argc,
X    char *argv[]);
Xstatic int Tclm_MidiRead(ClientData client_data, Tcl_Interp *interp, int argc,
X    char *argv[]);
Xstatic int Tclm_MidiWrite(ClientData client_data, Tcl_Interp *interp, int argc,
X    char *argv[]);
Xstatic int Tclm_MidiConfig(ClientData client_data, Tcl_Interp *interp, int argc,
X    char *argv[]);
Xstatic int Tclm_MidiRewind(ClientData client_data, Tcl_Interp *interp, int argc,
X    char *argv[]);
Xstatic int Tclm_MidiGet(ClientData client_data, Tcl_Interp *interp, int argc,
X    char *argv[]);
Xstatic int Tclm_MidiPut(ClientData client_data, Tcl_Interp *interp, int argc,
X    char *argv[]);
Xstatic int Tclm_MidiDelete(ClientData client_data, Tcl_Interp *interp, int argc,
X    char *argv[]);
Xstatic int Tclm_MidiMerge(ClientData client_data, Tcl_Interp *interp, int argc,
X    char *argv[]);
Xstatic int Tclm_MidiSplit(ClientData client_data, Tcl_Interp *interp, int argc,
X    char *argv[]);
Xstatic int Tclm_MidiCopy(ClientData client_data, Tcl_Interp *interp, int argc,
X    char *argv[]);
Xstatic int Tclm_MidiVersion(ClientData client_data, Tcl_Interp *interp,
X    int argc, char *argv[]);
Xstatic int Tclm_MidiTrack(ClientData client_data, Tcl_Interp *interp,
X    int argc, char *argv[]);
Xstatic int Tclm_GetTrack(TclmInterp *tclm_interp, Tcl_Interp *interp,
X    const char *str, Song **song, int *track);
X
Xint
XTclm_Init(Tcl_Interp *interp)
X{
X    TclmInterp *ti;
X
X    ti = new TclmInterp;
X    if (ti == 0) {
X        Tcl_SetResult(interp, "Out of memory in Tclm_Init",
X            TCL_STATIC);
X        return (TCL_ERROR);
X    }
X    Tcl_CreateCommand(interp, "midimake", Tclm_MidiMake, ti, 0);
X    Tcl_CreateCommand(interp, "midifree", Tclm_MidiFree, ti, 0);
X    Tcl_CreateCommand(interp, "midiread", Tclm_MidiRead, ti, 0);
X    Tcl_CreateCommand(interp, "midiwrite", Tclm_MidiWrite, ti, 0);
X    Tcl_CreateCommand(interp, "midiconfig", Tclm_MidiConfig, ti, 0);
X    Tcl_CreateCommand(interp, "midirewind", Tclm_MidiRewind, ti, 0);
X    Tcl_CreateCommand(interp, "midiget", Tclm_MidiGet, ti, 0);
X    Tcl_CreateCommand(interp, "midiput", Tclm_MidiPut, ti, 0);
X    Tcl_CreateCommand(interp, "mididelete", Tclm_MidiDelete, ti, 0);
X    Tcl_CreateCommand(interp, "midimerge", Tclm_MidiMerge, ti, 0);
X    Tcl_CreateCommand(interp, "midisplit", Tclm_MidiSplit, ti, 0);
X    Tcl_CreateCommand(interp, "midimove", Tclm_MidiCopy, ti, 0);
X    Tcl_CreateCommand(interp, "midicopy", Tclm_MidiCopy, ti, 0);
X    Tcl_CreateCommand(interp, "midiversion", Tclm_MidiVersion, ti, 0);
X    Tcl_CreateCommand(interp, "miditrack", Tclm_MidiTrack, ti, 0);
X
X    return (Tclm_PlayInit(interp, ti));
X}
X
Xint
XTclm_MidiMake(ClientData client_data, Tcl_Interp *interp, int argc,
X    char *argv[])
X{
X    TclmInterp *tclm_interp;
X    Song *s;
X    char *key;
X
X    if (argc != 1) {
X        Tcl_AppendResult(interp, "wrong # args: should be \"",
X            argv[0], "\"", 0);
X        return (TCL_ERROR);
X    }
X    tclm_interp = (TclmInterp *)client_data;
X
X    s = new Song;
X    key = tclm_interp->AddSong(s);
X    Tcl_SetResult(interp, key, TCL_VOLATILE);
X    delete key;
X    return (TCL_OK);
X}
X
Xint
XTclm_MidiFree(ClientData client_data, Tcl_Interp *interp, int argc,
X    char *argv[])
X{
X    TclmInterp *tclm_interp;
X
X    if (argc != 2) {
X        Tcl_AppendResult(interp, "wrong # args: should be \"",
X            argv[0], " MidiID\"", 0);
X        return (TCL_ERROR);
X    }
X    tclm_interp = (TclmInterp *)client_data;
X
X    if (!tclm_interp->DeleteSong(argv[1])) {
X        Tcl_AppendResult(interp, "Bad key ", argv[1], 0);
X        return (TCL_ERROR);
X    }
X    return (TCL_OK);
X}
X
Xint
XTclm_MidiRead(ClientData client_data, Tcl_Interp *interp, int argc,
X    char *argv[])
X{
X    FILE *file;
X    TclmInterp *tclm_interp;
X    Song *song;
X    char *key;
X
X    if (argc != 2) {
X        Tcl_AppendResult(interp, "wrong # args: should be \"",
X            argv[0], " FileID\"", 0);
X        return (TCL_ERROR);
X    }
X    tclm_interp = (TclmInterp *)client_data;
X
X    song = new Song;
X
X    if (Tcl_GetOpenFile(interp, argv[1], 0, 1, &file) != TCL_OK)
X        return (TCL_ERROR);
X    if (!song->SMFRead(fileno(file))) {
X        Tcl_AppendResult(interp, "coudln't read MIDI file ", argv[1],
X            ": ", song->GetError(), 0);
X        delete song;
X        return (TCL_ERROR);
X    }
X    key = tclm_interp->AddSong(song);
X    Tcl_SetResult(interp, key, TCL_VOLATILE);
X    delete key;
X    return (TCL_OK);
X}
X
Xint
XTclm_MidiWrite(ClientData client_data, Tcl_Interp *interp, int argc,
X    char *argv[])
X{
X    TclmInterp *tclm_interp;
X    Song *song;
X    FILE *file;
X
X    if (argc != 3) {
X        Tcl_AppendResult(interp, "wrong # args: should be \"",
X            argv[0], " FileID MidiID\"", 0);
X        return (TCL_ERROR);
X    }
X    tclm_interp = (TclmInterp *)client_data;
X
X    if ((song = tclm_interp->GetSong(argv[2])) == 0) {
X        Tcl_AppendResult(interp, "bad key ", argv[2], 0);
X        return (TCL_ERROR);
X    }
X
X    if (Tcl_GetOpenFile(interp, argv[1], 1, 1, &file) != TCL_OK)
X        return (TCL_ERROR);
X    if (!song->SMFWrite(fileno(file))) {
X        Tcl_AppendResult(interp, "couldn't write ", argv[2],
X            ": ", song->GetError(), 0);
X        delete song;
X        return (TCL_ERROR);
X    }
X    return (TCL_OK);
X}
X
Xint
XTclm_MidiConfig(ClientData client_data, Tcl_Interp *interp, int argc,
X    char *argv[])
X{
X    ostrstream *buf;
X    TclmInterp *tclm_interp;
X    Song *song;
X    char *str, **sub_argv;
X    int i, sub_argc, value;
X
X    if (argc < 2) {
X        Tcl_AppendResult(interp, "wrong # args: should be \"",
X            argv[0], " MidiID ?{format|division|tracks ?value?} ...?\"",
X            0);
X        return (TCL_ERROR);
X    }
X    tclm_interp = (TclmInterp *)client_data;
X
X    if ((song = tclm_interp->GetSong(argv[1])) == 0) {
X        Tcl_AppendResult(interp, "bad key ", argv[1], 0);
X        return (TCL_ERROR);
X    }
X
X    if (argc == 2) {
X        // make list of all values
X        buf = new ostrstream;
X        *buf << "format " << song->GetFormat() << ends;
X        str = buf->str();
X        Tcl_AppendElement(interp, str);
X        delete str;
X        delete buf;
X        buf = new ostrstream;
X        *buf << "division " << song->GetDivision() << ends;
X        str = buf->str();
X        Tcl_AppendElement(interp, str);
X        delete str;
X        delete buf;
X        buf = new ostrstream;
X        *buf << "tracks " << song->GetNumTracks() << ends;
X        str = buf->str();
X        Tcl_AppendElement(interp, str);
X        delete str;
X        delete buf;
X        return (TCL_OK);
X    }
X    for (i = 2; i < argc; i++) {
X        // loop through each arg and either set or return values
X        if (Tcl_SplitList(interp, argv[i], &sub_argc, &sub_argv)
X            != TCL_OK)
X            return (TCL_ERROR);
X        switch (sub_argc) {
X        case 1:
X            // return the value
X            buf = new ostrstream;
X            if (strcmp(sub_argv[0], "format") == 0) {
X                *buf << "format " << song->GetFormat() << ends;
X            } else if (strcmp(sub_argv[0], "division") == 0) {
X                *buf << "division " << song->GetDivision()
X                    << ends;
X            } else if (strcmp(sub_argv[0], "tracks") == 0) {
X                *buf << "tracks " << song->GetNumTracks()
X                    << ends;
X            } else {
X                Tcl_AppendResult(interp, "bad parameter ",
X                    sub_argv[0], 0);
X                delete buf;
X                return (TCL_ERROR);
X            }
X            str = buf->str();
X            Tcl_AppendElement(interp, str);
X            delete str;
X            delete buf;
X            break;
X        case 2:
X            // set the value
X            if (Tcl_GetInt(interp, sub_argv[1], &value) != TCL_OK)
X                return (TCL_ERROR);
X            if (strcmp(sub_argv[0], "format") == 0) {
X                song->SetFormat(value);
X            } else if (strcmp(sub_argv[0], "division") == 0) {
X                song->SetDivision(value);
X            } else if (strcmp(sub_argv[0], "tracks") == 0) {
X                song->SetNumTracks(value);
X            } else {
X                Tcl_AppendResult(interp, "bad parameter ",
X                    sub_argv[0], 0);
X                return (TCL_ERROR);
X            }
X            break;
X        default:
X            Tcl_SetResult(interp, "wrong # args: should be "
X                "{format|division|tracks ?value?}", TCL_STATIC);
X            return (TCL_ERROR);
X            break;
X        }
X        free(sub_argv);
X    }
X    return (TCL_OK);
X}
X
Xint
XTclm_MidiRewind(ClientData client_data, Tcl_Interp *interp, int argc,
X    char *argv[])
X{
X    TclmInterp *tclm_interp;
X    Song *song;
X    int track;
X
X    if (argc != 3 && argc != 2) {
X        Tcl_AppendResult(interp, "wrong # args: should be \"",
X            argv[0], " MidiID ?track?\"", 0);
X        return (TCL_ERROR);
X    }
X    tclm_interp = (TclmInterp *)client_data;
X
X    if ((song = tclm_interp->GetSong(argv[1])) == 0) {
X        Tcl_AppendResult(interp, "bad key ", argv[1], 0);
X        return (TCL_ERROR);
X    }
X
X    if (argc == 2)
X        song->RewindEvents();
X    else {
X        if (Tcl_GetInt(interp, argv[2], &track) != TCL_OK)
X            return (TCL_ERROR);
X        song->RewindEvents(track);
X    }
X    return (TCL_OK);
X}
X
Xint
XTclm_MidiGet(ClientData client_data, Tcl_Interp *interp, int argc,
X    char *argv[])
X{
X    ostrstream *buf;
X    long time;
X    int printable, track;
X    TclmInterp *tclm_interp;
X    Song *song;
X    Event *e, *events;
X    char *str;
X
X    if (argc != 4) {
X        Tcl_AppendResult(interp, "wrong # args: should be \"",
X            argv[0], " MidiID track time|next|prev\"", 0);
X        return (TCL_ERROR);
X    }
X    tclm_interp = (TclmInterp *)client_data;
X
X    if ((song = tclm_interp->GetSong(argv[1])) == 0) {
X        Tcl_AppendResult(interp, "bad key ", argv[1], 0);
X        return (TCL_ERROR);
X    }
X
X    if (Tcl_GetInt(interp, argv[2], &track) != TCL_OK)
X        return (TCL_ERROR);
X
X    if (strcmp(argv[3], "next") == 0) {
X        printable = 0;
X        while (!printable) {
X            if ((e = song->NextEvent(track)) == 0) {
X                Tcl_SetResult(interp, "EOT", TCL_STATIC);
X                printable = 1;
X            } else {
X                buf = new ostrstream;
X                Tclm_PrintEvent(*buf, e);
X                str = buf->str();
X                if (str != 0 && str[0] != '\0') {
X                    Tcl_SetResult(interp, str,
X                        TCL_VOLATILE);
X                    printable = 1;
X                }
X                delete str;
X                delete buf;
X            }
X        }
X    } else if (strcmp(argv[3], "prev") == 0) {
X        printable = 0;
X        while (!printable) {
X            if ((e = song->PrevEvent(track)) == 0) {
X                Tcl_SetResult(interp, "EOT", TCL_STATIC);
X                printable = 1;
X            } else {
X                buf = new ostrstream;
X                Tclm_PrintEvent(*buf, e);
X                str = buf->str();
X                if (str != 0 && str[0] != '\0') {
X                    Tcl_SetResult(interp, str,
X                        TCL_VOLATILE);
X                    printable = 1;
X                }
X                delete str;
X                delete buf;
X            }
X        }
X    } else {
X        if (Tcl_GetLong(interp, argv[3], &time) != TCL_OK)
X            return (TCL_ERROR);
X        if ((events = song->GetEvents((short)track, time)) == 0)
X            Tcl_SetResult(interp, "NoEvent", TCL_STATIC);
X        else {
X            for (e = events; e != 0; e = e->GetNextEvent()) {
X                buf = new ostrstream;
X                Tclm_PrintEvent(*buf, e);
X                str = buf->str();
X                if (str != 0 && str[0] != '\0')
X                    Tcl_AppendElement(interp, str);
X                delete str;
X                delete buf;
X            }
X        }
X    }
X    return (TCL_OK);
X}
X
Xint
XTclm_MidiPut(ClientData client_data, Tcl_Interp *interp, int argc,
X    char *argv[])
X{
X    TclmInterp *tclm_interp;
X    Song *song;
X    NoteEvent *np, *new_e2;
X    Event *event, *new_e1;
X    int track;
X
X    if (argc != 4) {
X        Tcl_AppendResult(interp, "wrong # args: should be \"",
X            argv[0], " MidiID track event\"", 0);
X        return (TCL_ERROR);
X    }
X    tclm_interp = (TclmInterp *)client_data;
X
X    if ((song = tclm_interp->GetSong(argv[1])) == 0) {
X        Tcl_AppendResult(interp, "bad key ", argv[1], 0);
X        return (TCL_ERROR);
X    }
X
X    if (Tcl_GetInt(interp, argv[2], &track) != TCL_OK)
X        return (TCL_ERROR);
X
X    if (track >= song->GetNumTracks() || track < 0) {
X        ostrstream buf;
X        char *bstr;
X
X        buf << "bad track value " << track << " (only " <<
X            (int)song->GetNumTracks() << " tracks in song)" << ends;
X        bstr = buf.str();
X        Tcl_SetResult(interp, bstr, TCL_VOLATILE);
X        delete bstr;
X        return (TCL_ERROR);
X    }
X
X    if ((event = Tclm_ParseEvent(interp, argv[3])) == 0) {
X        if (strlen(interp->result) == 0)
X            Tcl_SetResult(interp, "No more memory", TCL_STATIC);
X        return (TCL_ERROR);
X    }
X    new_e1 = song->PutEvent(track, *event);
X    if (new_e1 == 0) {
X        Tcl_SetResult(interp, "Couldn't put event", TCL_STATIC);
X        return (TCL_ERROR);
X    }
X    // check to see if it has a note off too
X    if (event->GetType() == NOTEON &&
X        (np = ((NoteEvent *)event)->GetNotePair()) != 0) {
X        new_e2 = (NoteEvent *)song->PutEvent(track, *np);
X        if (new_e2 == 0) {
X            Tcl_SetResult(interp, "Couldn't put event",
X                TCL_STATIC);
X            return (TCL_ERROR);
X        }
X        ((NoteEvent *)new_e1)->SetNotePair(new_e2);
X        new_e2->SetNotePair((NoteEvent *)new_e1);
X        delete np;
X    }
X    delete event;
X
X    return (TCL_OK);
X}
X
Xint
XTclm_MidiDelete(ClientData client_data, Tcl_Interp *interp, int argc,
X    char *argv[])
X{
X    TclmInterp *tclm_interp;
X    Song *song;
X    Event *event, *note_off;
X    int track;
X
X    if (argc != 4 && argc != 6) {
X        Tcl_AppendResult(interp, "wrong # args: should be \"",
X            argv[0], " MidiID track {event | range starttime "
X            "endtime}\"", 0);
X        return (TCL_ERROR);
X    }
X    tclm_interp = (TclmInterp *)client_data;
X
X    if ((song = tclm_interp->GetSong(argv[1])) == 0) {
X        Tcl_AppendResult(interp, "bad key ", argv[1], 0);
X        return (TCL_ERROR);
X    }
X
X    if (Tcl_GetInt(interp, argv[2], &track) != TCL_OK)
X        return (TCL_ERROR);
X
X    if (track >= song->GetNumTracks() || track < 0) {
X        ostrstream buf;
X        char *bstr;
X
X        buf << "bad track value " << track << " (only " <<
X            (int)song->GetNumTracks() << " tracks in song)" << ends;
X        bstr = buf.str();
X        Tcl_SetResult(interp, bstr, TCL_VOLATILE);
X        delete bstr;
X        return (TCL_ERROR);
X    }
X
X    if (strcmp(argv[3], "range") == 0) {
X        unsigned long start, end;
X
X        if (Tcl_GetLong(interp, argv[4], (long *)&start) != TCL_OK)
X            return (TCL_ERROR);
X        if (Tcl_GetLong(interp, argv[5], (long *)&end) != TCL_OK)
X            return (TCL_ERROR);
X        if (!song->DeleteRange(track, start, end)) {
X            Tcl_SetResult(interp, "couldn't delete range",
X                TCL_STATIC);
X            return (TCL_ERROR);
X        }
X        Tcl_SetResult(interp, "1", TCL_STATIC);
X        return (TCL_OK);
X    }
X
X    if ((event = Tclm_ParseEvent(interp, argv[3])) == 0) {
X        if (strlen(interp->result) == 0)
X            Tcl_SetResult(interp, "No more memory", TCL_STATIC);
X        return (TCL_ERROR);
X    }
X    if (!song->DeleteEvent(track, *event)) {
X        Tcl_SetResult(interp, "0", TCL_STATIC);
X        if (event->GetType() == NOTEON &&
X           ((NoteEvent *)event)->GetNotePair() != 0)
X            delete ((NoteEvent *)event)->GetNotePair();
X        delete event;
X        return (TCL_OK);
X    }
X    // delete matching note off if applicable
X    if (event->GetType() == NOTEON &&
X        (note_off = ((NoteEvent *)event)->GetNotePair()) != 0) {
X        if (!song->DeleteEvent(track, *note_off)) {
X            Tcl_SetResult(interp, "Couldn't delete note off "
X                "half of pair", TCL_STATIC);
X            delete event;
X            delete note_off;
X            return (TCL_ERROR);
X        }
X        delete note_off;
X    }
X    delete event;
X    Tcl_SetResult(interp, "1", TCL_STATIC);
X    return (TCL_OK);
X}
X
Xint
XTclm_MidiMerge(ClientData client_data, Tcl_Interp *interp, int argc,
X    char *argv[])
X{
X    TclmInterp *tclm_interp;
X    Song *dest_song, *src_song;
X    int dest_track, i, src_track;
X
X    if (argc < 3) {
X        Tcl_AppendResult(interp, "wrong # args: should be \"",
X            argv[0], " {destMidiID destTrack} {srcMidiID srcTrack} "
X            "?{srcMidiID srcTrack} ...?\"", 0);
X        return (TCL_ERROR);
X    }
X    tclm_interp = (TclmInterp *)client_data;
X
X    if (Tclm_GetTrack(tclm_interp, interp, argv[1], &dest_song,
X        &dest_track) != TCL_OK)
X        return (TCL_ERROR);
X
X    for (i = 2; i < argc; i++) {
X        if (Tclm_GetTrack(tclm_interp, interp, argv[i], &src_song,
X            &src_track) != TCL_OK)
X            return (TCL_ERROR);
X        if (!dest_song->Merge(dest_track, *src_song, src_track)) {
X            Tcl_AppendResult(interp, "couldn't merge ",
X                argv[i], " to ", argv[1], 0);
X            return (TCL_ERROR);
X        }
X    }
X    return (TCL_OK);
X}
X
Xint
XTclm_MidiSplit(ClientData client_data, Tcl_Interp *interp, int argc,
X    char *argv[])
X{
X    TclmInterp *tclm_interp;
X    Song *src_song, *meta_song, *normal_song;
X    int src_track, meta_track, normal_track;
X
X    if (argc != 4) {
X        Tcl_AppendResult(interp, "wrong # args: should be \"",
X            argv[0], " {srcMidiID srcTrack} {metaMidiID metaTrack} "
X            "{otherMidiID otherTrack}\"", 0);
X        return (TCL_ERROR);
X    }
X    tclm_interp = (TclmInterp *)client_data;
X
X    if (Tclm_GetTrack(tclm_interp, interp, argv[1], &src_song, &src_track)
X        != TCL_OK)
X        return (TCL_ERROR);
X    if (Tclm_GetTrack(tclm_interp, interp, argv[2], &meta_song, &meta_track)
X        != TCL_OK)
X        return (TCL_ERROR);
X    if (Tclm_GetTrack(tclm_interp, interp, argv[3], &normal_song,
X        &normal_track) != TCL_OK)
X        return (TCL_ERROR);
X
X    if (!src_song->Split(src_track, *meta_song, meta_track, *normal_song,
X        normal_track)) {
X        Tcl_AppendResult(interp, "Couldn't split track ", argv[1], 0);
X        return (TCL_ERROR);
X    }
X    return (TCL_OK);
X}
X
X
Xint
XTclm_MidiCopy(ClientData client_data, Tcl_Interp *interp, int argc,
X    char *argv[])
X{
X    TclmInterp *tclm_interp;
X    EventTree *tmp_track;
X    Song *src_song, *dest_song;
X    double scalar;
X    unsigned long dstart, sstart, send;
X    int src_track, dest_track;
X
X    if (argc != 6) {
X        Tcl_AppendResult(interp, "wrong # args: should be \"",
X            argv[0], " {destMidiID destTrack} destStartTime "
X            "{srcMidiID srcTrack} srcStartTime srcEndTime\"", 0);
X        return (TCL_ERROR);
X    }
X    tclm_interp = (TclmInterp *)client_data;
X
X    if (Tclm_GetTrack(tclm_interp, interp, argv[1], &dest_song, &dest_track)
X        != TCL_OK)
X        return (TCL_ERROR);
X    if (Tcl_GetLong(interp, argv[2], (long *)&dstart) != TCL_OK)
X        return (TCL_ERROR);
X    if (Tclm_GetTrack(tclm_interp, interp, argv[3], &src_song, &src_track)
X        != TCL_OK)
X        return (TCL_ERROR);
X    if (Tcl_GetLong(interp, argv[4], (long *)&sstart) != TCL_OK)
X        return (TCL_ERROR);
X    if (Tcl_GetLong(interp, argv[5], (long *)&send) != TCL_OK)
X        return (TCL_ERROR);
X
X    scalar = (double)dest_song->GetDivision() / src_song->GetDivision();
X
X    tmp_track = src_song->GetRange(src_track, sstart, send);
X    if (tmp_track == 0) {
X        Tcl_AppendResult(interp, "Couldn't get range from: ", argv[3],
X            " to ", argv[4], 0);
X        return (TCL_ERROR);
X    }
X    if (strcmp(argv[0], "midimove") == 0) {
X        if (!src_song->DeleteRange(src_track, sstart, send)) {
X            Tcl_AppendResult(interp, "Couldn't remove events "
X                "from source track", 0);
X            return (TCL_ERROR);
X        }
X    }
X    if (!dest_song->Add(dest_track, *tmp_track, dstart, scalar)) {
X        Tcl_AppendResult(interp, "Couldn't add range", 0);
X        return (TCL_ERROR);
X    }
X    delete tmp_track;
X    return (TCL_OK);
X}
X
Xint
XTclm_MidiVersion(ClientData client_data, Tcl_Interp *interp, int argc,
X    char *argv[])
X{
X
X    if (argc != 1) {
X        Tcl_AppendResult(interp, "wrong # args: should be \"",
X            argv[0], "\"", 0);
X        return (TCL_ERROR);
X    }
X    Tcl_SetResult(interp, (char *)TCLMIDI_VERSION, TCL_STATIC);
X    return (TCL_OK);
X}
X
Xint
XTclm_MidiTrack(ClientData client_data, Tcl_Interp *interp, int argc,
X    char *argv[])
X{
X    TclmInterp *tclm_interp;
X    Song *song;
X    int track;
X
X    if (argc != 4) {
X        Tcl_AppendResult(interp, "wrong # args: should be \"",
X            argv[0], " MidiID track {start|end}\"", 0);
X        return (TCL_ERROR);
X    }
X    tclm_interp = (TclmInterp *)client_data;
X
X    if ((song = tclm_interp->GetSong(argv[1])) == 0) {
X        Tcl_AppendResult(interp, "bad key ", argv[1], 0);
X        return (TCL_ERROR);
X    }
X
X    if (Tcl_GetInt(interp, argv[2], &track) != TCL_OK)
X        return (TCL_ERROR);
X
X    if (track >= song->GetNumTracks() || track < 0) {
X        ostrstream buf;
X        char *bstr;
X
X        buf << "bad track value " << track << " (only " <<
X            (int)song->GetNumTracks() << " tracks in song)" << ends;
X        bstr = buf.str();
X        Tcl_SetResult(interp, bstr, TCL_VOLATILE);
X        delete bstr;
X        return (TCL_ERROR);
X    }
X
X    if (strcmp(argv[3], "start") == 0) {
X        ostrstream buf;
X        char *bstr;
X
X        buf << song->GetTrack(track).GetStartTime() << ends;
X        bstr = buf.str();
X        Tcl_SetResult(interp, bstr, TCL_VOLATILE);
X        delete bstr;
X        return (TCL_OK);
X    } else if (strcmp(argv[3], "end") == 0) {
X        ostrstream buf;
X        char *bstr;
X
X        buf << song->GetTrack(track).GetEndTime() << ends;
X        bstr = buf.str();
X        Tcl_SetResult(interp, bstr, TCL_VOLATILE);
X        delete bstr;
X        return (TCL_OK);
X    } else {
X        Tcl_AppendResult(interp, "bad ", argv[0], " command \"",
X            argv[3], "\"", 0);
X        return (TCL_ERROR);
X    }
X}
X
Xint
XTclm_GetTrack(TclmInterp *tclm_interp, Tcl_Interp *interp, const char *str,
X    Song **song, int *track)
X{
X    char **sub_argv;
X    int sub_argc;
X
X    if (Tcl_SplitList(interp, (char *)str, &sub_argc, &sub_argv) != TCL_OK)
X        return (TCL_ERROR);
X    if (sub_argc != 2) {
X        Tcl_SetResult(interp, "bad track designation: "
X            "should be \"{MidiID Track}\"", TCL_STATIC);
X        free(sub_argv);
X        return (TCL_ERROR);
X    }
X    if ((*song = tclm_interp->GetSong(sub_argv[0])) == 0) {
X        Tcl_AppendResult(interp, "bad MidiID ", str, 0);
X        free(sub_argv);
X        return (TCL_ERROR);
X    }
X    if (Tcl_GetInt(interp, sub_argv[1], track) != TCL_OK) {
X        Tcl_AppendResult(interp, "bad track ", str, 0);
X        free(sub_argv);
X        return (TCL_ERROR);
X    }
X    if (*track < 0 || *track >= (*song)->GetNumTracks()) {
X        ostrstream buf;
X        char *s;
X
X        buf << "Bad track value " << str << " (only "
X            << (*song)->GetNumTracks() << " tracks in song)" << ends;
X        s = buf.str();
X        Tcl_SetResult(interp, s, TCL_VOLATILE);
X        delete s;
X        free(sub_argv);
X        return (TCL_ERROR);
X    }
X    free(sub_argv);
X    return (TCL_OK);
X}
END_OF_FILE
  if test 22271 -ne `wc -c <'tclmidi-2.0/tclmCmd.C'`; then
    echo shar: \"'tclmidi-2.0/tclmCmd.C'\" unpacked with wrong size!
  fi
  # end of 'tclmidi-2.0/tclmCmd.C'
fi
if test -f 'tclmidi-2.0/tclmEvent.C' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'tclmidi-2.0/tclmEvent.C'\"
else
  echo shar: Extracting \"'tclmidi-2.0/tclmEvent.C'\" \(25530 characters\)
  sed "s/^X//" >'tclmidi-2.0/tclmEvent.C' <<'END_OF_FILE'
X/*-
X * Copyright (c) 1993, 1994 Michael B. Durian.  All rights reserved.
X *
X * Redistribution and use in source and binary forms, with or without
X * modification, are permitted provided that the following conditions
X * are met:
X * 1. Redistributions of source code must retain the above copyright
X *    notice, this list of conditions and the following disclaimer.
X * 2. Redistributions in binary form must reproduce the above copyright
X *    notice, this list of conditions and the following disclaimer in the
X *    documentation and/or other materials provided with the distribution.
X * 3. All advertising materials mentioning features or use of this software
X *    must display the following acknowledgement:
X *    This product includes software developed by Michael B. Durian.
X * 4. The name of the the Author may be used to endorse or promote
X *    products derived from this software without specific prior written
X *    permission.
X *
X * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED
X * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
X * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
X * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
X * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
X * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
X * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
X * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
X * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
X * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
X * SUCH DAMAGE.
X */
Xextern "C" {
X#include <tcl.h>
X}
X#include <strstream.h>
X#include <ctype.h>
X#include <string.h>
X#include <stdlib.h>
X
X#include "tclmidi.h"
X#include "tclmEvent.h"
X
Xvoid
XTclm_PrintEvent(ostream &buf, Event *e)
X{
X    char *str;
X
X    switch (e->GetType()) {
X    case NOTEOFF:
X        if (((NoteEvent *)e)->GetNotePair() != 0) {
X            buf << ends;
X            return;
X        }
X        str = Tclm_PrintNoteOff((NoteOffEvent *)e);
X        break;
X    case NOTEON:
X        if (((NoteEvent *)e)->GetNotePair() == 0)
X            str = Tclm_PrintNoteOn((NoteOnEvent *)e);
X        else {
X            if (((NoteEvent *)e)->GetVelocity() == 0) {
X                buf << ends;
X                return;
X            }
X            str = Tclm_PrintNote((NoteOnEvent *)e);
X        }
X        break;
X    case KEYPRESSURE:
X        str = Tclm_PrintKeyPressure((KeyPressureEvent *)e);
X        break;
X    case PARAMETER:
X        str = Tclm_PrintParameter((ParameterEvent *)e);
X        break;
X    case PROGRAM:
X        str = Tclm_PrintProgram((ProgramEvent *)e);
X        break;
X    case CHANNELPRESSURE:
X        str = Tclm_PrintChannelPressure((ChannelPressureEvent *)e);
X        break;
X    case PITCHWHEEL:
X        str = Tclm_PrintPitchWheel((PitchWheelEvent *)e);
X        break;
X    case SYSTEMEXCLUSIVE:
X        str = Tclm_PrintSystemExclusive((SystemExclusiveEvent *)e);
X        break;
X    case METASEQUENCENUMBER:
X        str = Tclm_PrintMetaSequenceNumber(
X            (MetaSequenceNumberEvent *)e);
X        break;
X    case METATEXT:
X        str = Tclm_PrintMetaText((MetaTextEvent *)e);
X        break;
X    case METACOPYRIGHT:
X        str = Tclm_PrintMetaCopyright((MetaCopyrightEvent *)e);
X        break;
X    case METASEQUENCENAME:
X        str = Tclm_PrintMetaSequenceName((MetaSequenceNameEvent *)e);
X        break;
X    case METAINSTRUMENTNAME:
X        str = Tclm_PrintMetaInstrumentName(
X            (MetaInstrumentNameEvent *)e);
X        break;
X    case METALYRIC:
X        str = Tclm_PrintMetaLyric((MetaLyricEvent *)e);
X        break;
X    case METAMARKER:
X        str = Tclm_PrintMetaMarker((MetaMarkerEvent *)e);
X        break;
X    case METACUE:
X        str = Tclm_PrintMetaCue((MetaCueEvent *)e);
X        break;
X    case METACHANNELPREFIX:
X        str = Tclm_PrintMetaChannelPrefix((MetaChannelPrefixEvent *)e);
X        break;
X    case METAPORTNUMBER:
X        str = Tclm_PrintMetaPortNumber((MetaPortNumberEvent *)e);
X        break;
X    case METAENDOFTRACK:
X        str = Tclm_PrintMetaEndOfTrack((MetaEndOfTrackEvent *)e);
X        break;
X    case METATEMPO:
X        str = Tclm_PrintMetaTempo((MetaTempoEvent *)e);
X        break;
X    case METASMPTE:
X        str = Tclm_PrintMetaSMPTE((MetaSMPTEEvent *)e);
X        break;
X    case METATIME:
X        str = Tclm_PrintMetaTime((MetaTimeEvent *)e);
X        break;
X    case METAKEY:
X        str = Tclm_PrintMetaKey((MetaKeyEvent *)e);
X        break;
X    case METASEQUENCERSPECIFIC:
X        str = Tclm_PrintMetaSequencerSpecific(
X            (MetaSequencerSpecificEvent *)e);
X        break;
X    case METAUNKNOWN:
X        str = Tclm_PrintMetaUnknown((MetaUnknownEvent *)e);
X        break;
X    default:
X        str = 0;
X        break;
X    }
X    buf << e->GetTime() << " " << str << ends;
X    delete str;
X}
X
Xchar *
XTclm_PrintNoteOff(NoteOffEvent *e)
X{
X    ostrstream buf;
X
X    buf << "NoteOff " << (int)e->GetChannel() << " " << (int)e->GetPitch()
X        << " " << (int)e->GetVelocity() << ends;
X    return (buf.str());
X}
X
Xchar *
XTclm_PrintNoteOn(NoteOnEvent *e)
X{
X    ostrstream buf;
X
X    buf << "NoteOn " << (int)e->GetChannel() << " " << (int)e->GetPitch()
X        << " " << (int)e->GetVelocity() << ends;
X    return (buf.str());
X}
X
Xchar *
XTclm_PrintNote(NoteOnEvent *e)
X{
X    ostrstream buf;
X
X    buf << "Note " << (int)e->GetChannel() << " " << (int)e->GetPitch()
X        << " " << (int)e->GetVelocity() << " " <<
X        (e->GetNotePair()->GetTime() - e->GetTime()) << ends;
X    return (buf.str());
X}
X
Xchar *
XTclm_PrintKeyPressure(KeyPressureEvent *e)
X{
X    ostrstream buf;
X
X    buf << "KeyPressure " << (int)e->GetChannel() << " "
X        << (int)e->GetPitch() << " " << (int)e->GetPressure() << ends;
X    return (buf.str());
X}
X
Xchar *
XTclm_PrintParameter(ParameterEvent *e)
X{
X    ostrstream buf;
X
X    buf << "Parameter " << (int)e->GetChannel() << " "
X        << (int)e->GetParameter() << " " << (int)e->GetValue() << ends;
X    return (buf.str());
X}
X
Xchar *
XTclm_PrintProgram(ProgramEvent *e)
X{
X    ostrstream buf;
X
X    buf << "Program " << (int)e->GetChannel() << " "
X        << (int)e->GetValue() << ends;
X    return (buf.str());
X}
X
Xchar *
XTclm_PrintChannelPressure(ChannelPressureEvent *e)
X{
X    ostrstream buf;
X
X    buf << "ChannelPressure " << (int)e->GetChannel() << " "
X        << (int)e->GetPressure() << ends;
X    return (buf.str());
X}
X
Xchar *
XTclm_PrintPitchWheel(PitchWheelEvent *e)
X{
X    ostrstream buf;
X
X    buf << "PitchWheel " << (int)e->GetChannel() << " " <<
X        e->GetValue() << ends;
X    return (buf.str());
X}
X
Xchar *
XTclm_PrintSystemExclusive(SystemExclusiveEvent *e)
X{
X    ostrstream buf;
X
X    buf << "SystemExclusive ";
X    if (e->GetContinued() == 1)
X        buf << "continued ";
X    buf << "{";
X    Tclm_PrintData(buf, e->GetData(), e->GetLength());
X    buf << "}" << ends;
X    return (buf.str());
X}
X
Xchar *
XTclm_PrintMetaSequenceNumber(MetaSequenceNumberEvent *e)
X{
X    ostrstream buf;
X
X    buf << "MetaSequenceNumber " << e->GetNumber() << ends;
X    return (buf.str());
X}
X
Xchar *
XTclm_PrintMetaText(MetaTextEvent *e)
X{
X    ostrstream buf;
X
X    buf << "MetaText \"" << e->GetString() << "\"" << ends;
X    return (buf.str());
X}
X
Xchar *
XTclm_PrintMetaCopyright(MetaCopyrightEvent *e)
X{
X    ostrstream buf;
X
X    buf << "MetaCopyright \"" << e->GetString() << "\"" << ends;
X    return (buf.str());
X}
X
Xchar *
XTclm_PrintMetaSequenceName(MetaSequenceNameEvent *e)
X{
X    ostrstream buf;
X
X    buf << "MetaSequenceName \"" << e->GetString() << "\"" << ends;
X    return (buf.str());
X}
X
Xchar *
XTclm_PrintMetaInstrumentName(MetaInstrumentNameEvent *e)
X{
X    ostrstream buf;
X
X    buf << "MetaInstrumentName \"" << e->GetString() << "\"" << ends;
X    return (buf.str());
X}
X
Xchar *
XTclm_PrintMetaLyric(MetaLyricEvent *e)
X{
X    ostrstream buf;
X
X    buf << "MetaLyric \"" << e->GetString() << "\"" << ends;
X    return (buf.str());
X}
X
Xchar *
XTclm_PrintMetaMarker(MetaMarkerEvent *e)
X{
X    ostrstream buf;
X
X    buf << "MetaMarker \"" << e->GetString() << "\"" << ends;
X    return (buf.str());
X}
X
Xchar *
XTclm_PrintMetaCue(MetaCueEvent *e)
X{
X    ostrstream buf;
X
X    buf << "MetaCue \"" << e->GetString() << "\"" << ends;
X    return (buf.str());
X}
X
Xchar *
XTclm_PrintMetaChannelPrefix(MetaChannelPrefixEvent *e)
X{
X    ostrstream buf;
X
X    buf << "MetaChannelPrefix {";
X    Tclm_PrintData(buf, e->GetData(), e->GetLength());
X    buf << "}" << ends;
X    return (buf.str());
X}
X
Xchar *
XTclm_PrintMetaPortNumber(MetaPortNumberEvent *e)
X{
X    ostrstream buf;
X
X    buf << "MetaPortNumber " << (int)e->GetPort() << ends;
X    return (buf.str());
X}
X
Xchar *
XTclm_PrintMetaEndOfTrack(MetaEndOfTrackEvent *e)
X{
X    ostrstream buf;
X
X    buf << "MetaEndOfTrack" << ends;
X    return (buf.str());
X}
X
Xchar *
XTclm_PrintMetaTempo(MetaTempoEvent *e)
X{
X    ostrstream buf;
X
X    buf << "MetaTempo " << e->GetTempo() << ends;
X    return (buf.str());
X}
X
Xchar *
XTclm_PrintMetaSMPTE(MetaSMPTEEvent *e)
X{
X    ostrstream buf;
X
X    buf << "MetaSMPTE " << (int)e->GetHour() << " " << (int)e->GetMinute()
X        << " " << (int)e->GetSecond() << " " << (int)e->GetFrame()
X        << " " << (int)e->GetFractionalFrame() << ends;
X    return (buf.str());
X}
X
Xchar *
XTclm_PrintMetaTime(MetaTimeEvent *e)
X{
X    ostrstream buf;
X
X    buf << "MetaTime " << (int)e->GetNumerator()
X        << " " << (int)e->GetDenominator()
X        << " " << (int)e->GetClocksPerBeat()
X        << " " << (int)e->Get32ndNotesPerQuarterNote() << ends;
X    return (buf.str());
X}
X
Xchar *
XTclm_PrintMetaKey(MetaKeyEvent *e)
X{
X    ostrstream buf;
X
X    buf << "MetaKey \"" << e->GetKeyStr() << "\" " << e->GetModeStr()
X        << ends;
X    return (buf.str());
X}
X
Xchar *
XTclm_PrintMetaSequencerSpecific(MetaSequencerSpecificEvent *e)
X{
X    ostrstream buf;
X
X    buf << "MetaSequencerSpecific {";
X    Tclm_PrintData(buf, e->GetData(), e->GetLength());
X    buf << "}" << ends;
X    return (buf.str());
X}
X
Xchar *
XTclm_PrintMetaUnknown(MetaUnknownEvent *e)
X{
X    ostrstream buf;
X
X    buf << "MetaUnknown " << (int)e->GetMetaType() << " {";
X    Tclm_PrintData(buf, e->GetData(), e->GetLength());
X    buf << "}" << ends;
X    return (buf.str());
X}
X
XEvent *
XTclm_ParseEvent(Tcl_Interp *interp, char *str)
X{
X    Event *event;
X    Event *(*pfunc)(Tcl_Interp *, long, int, char **);
X    char **argv, **aptr;;
X    char *name;
X    long time;
X    int argc, i, length;
X
X    if (Tcl_SplitList(interp, str, &argc, &argv) != TCL_OK)
X        return (0);
X    aptr = argv;
X
X    if (Tcl_GetLong(interp, argv[0], &time) != TCL_OK)
X        return (0);
X
X    length = strlen(argv[1]);
X    name = new char[length + 1];
X    for (i = 0; i < length; i++)
X        name[i] = tolower(argv[1][i]);
X    name[i] = '\0';
X
X    argv++;
X    argc--;
X
X    pfunc = 0;
X    switch (name[0]) {
X    case 'c':
X        if (strncmp(name, "channelpressure", length) == 0)
X            pfunc = Tclm_ParseChannelPressure;
X        break;
X    case 'k':
X        if (strncmp(name, "keypressure", length) == 0)
X            pfunc = Tclm_ParseKeyPressure;
X        break;
X    case 'm':
X        // meta events
X        switch (name[4]) {
X        case 'c':
X            if (strncmp(name, "metachannelprefix", length) == 0)
X                pfunc = Tclm_ParseMetaChannelPrefix;
X            else if (strncmp(name, "metacopyright", length) == 0)
X                pfunc = Tclm_ParseMetaCopyright;
X            else if (strncmp(name, "metacue", length) == 0)
X                pfunc = Tclm_ParseMetaCue;
X            break;
X        case 'e':
X            if (strncmp(name, "metaendoftrack", length) == 0)
X                pfunc = Tclm_ParseMetaEndOfTrack;
X            break;
X        case 'i':
X            if (strncmp(name, "metainstrumentname", length) == 0)
X                pfunc = Tclm_ParseMetaInstrumentName;
X            break;
X        case 'k':
X            if (strncmp(name, "metakey", length) == 0)
X                pfunc = Tclm_ParseMetaKey;
X            break;
X        case 'l':
X            if (strncmp(name, "metalyric", length) == 0)
X                pfunc = Tclm_ParseMetaLyric;
X            break;
X        case 'm':
X            if (strncmp(name, "metamarker", length) == 0)
X                pfunc = Tclm_ParseMetaMarker;
X            break;
X        case 'p':
X            if (strncmp(name, "metaportnumber", length) == 0)
X                pfunc = Tclm_ParseMetaPortNumber;
X            break;
X        case 's':
X            if (strncmp(name, "metasequencename", length) == 0)
X                pfunc = Tclm_ParseMetaSequenceName;
X            else if (strncmp(name, "metasequencenumber", length)
X                == 0)
X                pfunc = Tclm_ParseMetaSequenceNumber;
X            else if (strncmp(name, "metasequencerspecific", length)
X                == 0)
X                pfunc = Tclm_ParseMetaSequencerSpecific;
X            else if (strncmp(name, "metasmpte", length) == 0)
X                pfunc = Tclm_ParseMetaSMPTE;
X            break;
X        case 't':
X            if (strncmp(name, "metatempo", length) == 0)
X                pfunc = Tclm_ParseMetaTempo;
X            else if (strncmp(name, "metatext", length) == 0)
X                pfunc = Tclm_ParseMetaText;
X            else if (strncmp(name, "metatime", length) == 0)
X                pfunc = Tclm_ParseMetaTime;
X            break;
X        case 'u':
X            if (strncmp(name, "metaunknown", length) == 0)
X                pfunc = Tclm_ParseMetaUnknown;
X            break;
X        }
X        break;
X    case 'n':
X        if (strncmp(name, "note", length) == 0)
X            pfunc = Tclm_ParseNote;
X        else if (strncmp(name, "noteoff", length) == 0)
X            pfunc = Tclm_ParseNoteOff;
X        else if (strncmp(name, "noteon", length) == 0)
X            pfunc = Tclm_ParseNoteOn;
X        break;
X    case 'p':
X        if (strncmp(name, "parameter", length) == 0)
X            pfunc = Tclm_ParseParameter;
X        else if (strncmp(name, "pitchwheel", length) == 0)
X            pfunc = Tclm_ParsePitchWheel;
X        else if (strncmp(name, "program", length) == 0)
X            pfunc = Tclm_ParseProgram;
X        break;
X    case 's':
X        if (strncmp(name, "systemexclusive", length) == 0)
X            pfunc = Tclm_ParseSystemExclusive;
X        break;
X    }
X
X    if (pfunc == 0) {
X        Tcl_AppendResult(interp, "bad event type ", argv[0], 0);
X        free(aptr);
X        delete name;
X        return (0);
X    }
X    event = pfunc(interp, time, argc, argv);
X    free(aptr);
X    delete name;
X    return (event);
X}
X
XEvent *
XTclm_ParseNoteOff(Tcl_Interp *interp, long time, int argc, char *argv[])
X{
X    unsigned char channel, pitch, velocity;
X
X    if (argc != 3 && argc != 4) {
X        Tcl_SetResult(interp, "bad event: should be \"time NoteOff "
X            "channel pitch ?velocity?\"", TCL_STATIC);
X        return (0);
X    }
X
X    if (!Tclm_ParseDataByte(interp, argv[1], &channel))
X        return (0);
X    if (!Tclm_ParseDataByte(interp, argv[2], &pitch))
X        return (0);
X    if (argc == 3)
X        velocity = 0;
X    else if (!Tclm_ParseDataByte(interp, argv[3], &velocity))
X        return (0);
X
X    return (new NoteOffEvent(time, channel, pitch, velocity));
X}
X
XEvent *
XTclm_ParseNoteOn(Tcl_Interp *interp, long time, int argc, char *argv[])
X{
X    unsigned char channel, pitch, velocity;
X
X    if (argc != 4) {
X        Tcl_SetResult(interp, "bad event: should be \"time NoteOn "
X            "channel pitch velocity\"", TCL_STATIC);
X        return (0);
X    }
X
X    if (!Tclm_ParseDataByte(interp, argv[1], &channel))
X        return (0);
X    if (!Tclm_ParseDataByte(interp, argv[2], &pitch))
X        return (0);
X    if (!Tclm_ParseDataByte(interp, argv[3], &velocity))
X        return (0);
X
X    return (new NoteOnEvent(time, channel, pitch, velocity));
X}
X
XEvent *
XTclm_ParseNote(Tcl_Interp *interp, long time, int argc, char *argv[])
X{
X    NoteOnEvent *event;
X    NoteOffEvent *off;
X    long duration;
X    unsigned char channel, pitch, velocity;
X
X    if (argc != 5) {
X        Tcl_SetResult(interp, "bad event: should be \"time Note "
X            "channel pitch velocity duration\"", TCL_STATIC);
X        return (0);
X    }
X
X    if (!Tclm_ParseDataByte(interp, argv[1], &channel))
X        return (0);
X    if (!Tclm_ParseDataByte(interp, argv[2], &pitch))
X        return (0);
X    if (!Tclm_ParseDataByte(interp, argv[3], &velocity))
X        return (0);
X    if (Tcl_GetLong(interp, argv[4], &duration) != TCL_OK)
X        return (0);
X
X    event = new NoteOnEvent();
X    event->SetTime(time);
X    event->SetChannel(channel);
X    event->SetPitch(pitch);
X    event->SetVelocity(velocity);
X
X    off = new NoteOffEvent();
X    off->SetTime(time + duration);
X    off->SetChannel(channel);
X    off->SetPitch(pitch);
X    event->SetNotePair(off);
X    off->SetNotePair(event);
X
X    return (event);
X}
X
XEvent *
XTclm_ParseKeyPressure(Tcl_Interp *interp, long time, int argc, char *argv[])
X{
X    unsigned char channel, pitch, pressure;
X
X    if (argc != 4) {
X        Tcl_SetResult(interp, "bad event: should be "
X            "\"time KeyPressure channel pitch pressure\"", TCL_STATIC);
X        return (0);
X    }
X
X    if (!Tclm_ParseDataByte(interp, argv[1], &channel))
X        return (0);
X    if (!Tclm_ParseDataByte(interp, argv[2], &pitch))
X        return (0);
X    if (!Tclm_ParseDataByte(interp, argv[3], &pressure))
X        return (0);
X
X    return (new KeyPressureEvent(time, channel, pitch, pressure));
X}
X
XEvent *
XTclm_ParseParameter(Tcl_Interp *interp, long time, int argc, char *argv[])
X{
X    unsigned char channel, parameter, value;
X
X    if (argc != 4) {
X        Tcl_SetResult(interp, "bad event: should be \"time Parameter "
X            "channel parameter value\"", TCL_STATIC);
X        return (0);
X    }
X
X    if (!Tclm_ParseDataByte(interp, argv[1], &channel))
X        return (0);
X    if (!Tclm_ParseDataByte(interp, argv[2], ¶meter))
X        return (0);
X    if (!Tclm_ParseDataByte(interp, argv[3], &value))
X        return (0);
X
X    return (new ParameterEvent(time, channel, parameter, value));
X}
X
XEvent *
XTclm_ParseProgram(Tcl_Interp *interp, long time, int argc, char *argv[])
X{
X    unsigned char channel, value;
X
X    if (argc != 3) {
X        Tcl_SetResult(interp, "bad event: should be \"time Program "
X            "channel value\"", TCL_STATIC);
X        return (0);
X    }
X
X    if (!Tclm_ParseDataByte(interp, argv[1], &channel))
X        return (0);
X    if (!Tclm_ParseDataByte(interp, argv[2], &value))
X        return (0);
X
X    return (new ProgramEvent(time, channel, value));
X}
X
XEvent *
XTclm_ParseChannelPressure(Tcl_Interp *interp, long time, int argc, char *argv[])
X{
X    unsigned char channel, pressure;
X
X    if (argc != 3) {
X        Tcl_SetResult(interp, "bad event: should be "
X            "\"time ChannelPressure channel pressure\"", TCL_STATIC);
X        return (0);
X    }
X
X    if (!Tclm_ParseDataByte(interp, argv[1], &channel))
X        return (0);
X    if (!Tclm_ParseDataByte(interp, argv[2], &pressure))
X        return (0);
X
X    return (new ChannelPressureEvent(time, channel, pressure));
X}
X
XEvent *
XTclm_ParsePitchWheel(Tcl_Interp *interp, long time, int argc, char *argv[])
X{
X    unsigned char channel;
X    int value;
X
X    if (argc != 3) {
X        Tcl_SetResult(interp, "bad event: should be \"time PitchWheel "
X            "channel value\"", TCL_STATIC);
X        return (0);
X    }
X
X    if (!Tclm_ParseDataByte(interp, argv[1], &channel))
X        return (0);
X    if (Tcl_GetInt(interp, argv[2], &value) != TCL_OK)
X        return (0);
X
X    return (new PitchWheelEvent(time, channel, value));
X}
X
XEvent *
XTclm_ParseSystemExclusive(Tcl_Interp *interp, long time, int argc, char *argv[])
X{
X    char **str;
X    SystemExclusiveEvent *event;
X    unsigned char *data;
X    int i, len, val;
X
X    if ((argc != 2 && argc != 3) || (argc == 3 && strncmp(argv[1], "cont",
X        4) != 0)) {
X        Tcl_SetResult(interp, "bad event: should be "
X            "\"time SystemExclusive ?continued? {data ?data ...?}\"",
X            TCL_STATIC);
X        return (0);
X    }
X
X    if (argc == 2) {
X        if (Tcl_SplitList(interp, argv[1], &len, &str) != TCL_OK)
X            return (0);
X    } else {
X        if (Tcl_SplitList(interp, argv[2], &len, &str) != TCL_OK)
X            return (0);
X    }
X
X    data = new unsigned char[len];
X    if (data == 0)
X        return (0);
X
X    for (i = 0; i < len; i++) {
X        if (Tcl_GetInt(interp, str[i], &val) != TCL_OK)
X            return (0);
X        data[i] = val;
X    }
X
X    free(str);
X    event = new SystemExclusiveEvent(time, data, len);
X    if (argc == 3)
X        event->SetContinued(1);
X    delete data;
X
X    return (event);
X}
X
XEvent *
XTclm_ParseMetaSequenceNumber(Tcl_Interp *interp, long time, int argc,
X    char *argv[])
X{
X    int num;
X
X    if (argc != 2) {
X        Tcl_SetResult(interp, "bad event: should be "
X            "\"time MetaSequenceNumber number\"", TCL_STATIC);
X        return (0);
X    }
X
X    if (Tcl_GetInt(interp, argv[1], &num) != TCL_OK)
X        return (0);
X
X    return (new MetaSequenceNumberEvent(time, num));
X}
X
XEvent *
XTclm_ParseMetaText(Tcl_Interp *interp, long time, int argc, char *argv[])
X{
X
X    if (argc != 2) {
X        Tcl_SetResult(interp, "bad event: should be \"time MetaText "
X            "string\"", TCL_STATIC);
X        return (0);
X    }
X
X    return (new MetaTextEvent(time, argv[1]));
X}
X
XEvent *
XTclm_ParseMetaCopyright(Tcl_Interp *interp, long time, int argc, char *argv[])
X{
X
X    if (argc != 2) {
X        Tcl_SetResult(interp, "bad event: should be "
X            "\"time MetaCopyright string\"", TCL_STATIC);
X        return (0);
X    }
X
X    return (new MetaCopyrightEvent(time, argv[1]));
X}
X
XEvent *
XTclm_ParseMetaSequenceName(Tcl_Interp *interp, long time, int argc,
X    char *argv[])
X{
X
X    if (argc != 2) {
X        Tcl_SetResult(interp, "bad event: should be "
X            "\"time MetaSequenceName string\"", TCL_STATIC);
X        return (0);
X    }
X
X    return (new MetaSequenceNameEvent(time, argv[1]));
X}
X
XEvent *
XTclm_ParseMetaInstrumentName(Tcl_Interp *interp, long time, int argc,
X    char *argv[])
X{
X
X    if (argc != 2) {
X        Tcl_SetResult(interp, "bad event: should be "
X            "\"time MetaInstrumentName string\"", TCL_STATIC);
X        return (0);
X    }
X
X    return (new MetaInstrumentNameEvent(time, argv[1]));
X}
X
XEvent *
XTclm_ParseMetaLyric(Tcl_Interp *interp, long time, int argc, char *argv[])
X{
X
X    if (argc != 2) {
X        Tcl_SetResult(interp, "bad event: should be \"time MetaLyric "
X            "string\"", TCL_STATIC);
X        return (0);
X    }
X
X    return (new MetaLyricEvent(time, argv[1]));
X}
X
XEvent *
XTclm_ParseMetaMarker(Tcl_Interp *interp, long time, int argc, char *argv[])
X{
X
X    if (argc != 2) {
X        Tcl_SetResult(interp, "bad event: should be \"time MetaMarker "
X            "string\"", TCL_STATIC);
X        return (0);
X    }
X
X    return (new MetaMarkerEvent(time, argv[1]));
X}
X
XEvent *
XTclm_ParseMetaCue(Tcl_Interp *interp, long time, int argc, char *argv[])
X{
X
X    if (argc != 2) {
X        Tcl_SetResult(interp, "bad event: should be \"time MetaCue "
X            "string\"", TCL_STATIC);
X        return (0);
X    }
X
X    return (new MetaCueEvent(time, argv[1]));
X}
X
XEvent *
XTclm_ParseMetaChannelPrefix(Tcl_Interp *interp, long time, int argc,
X    char *argv[])
X{
X    char **str;
X    MetaChannelPrefixEvent *event;
X    unsigned char *data;
X    int i, len, val;
X
X    if (argc != 2) {
X        Tcl_SetResult(interp, "bad event: should be "
X            "\"time MetaChannelPrefix {data ?data ...?}\"", TCL_STATIC);
X        return (0);
X    }
X
X    if (Tcl_SplitList(interp, argv[1], &len, &str) != TCL_OK)
X        return (0);
X
X    data = new unsigned char[len];
X    if (data == 0)
X        return (0);
X
X    for (i = 0; i < len; i++) {
X        if (Tcl_GetInt(interp, str[i], &val) != TCL_OK)
X            return (0);
X        data[i] = val;
X    }
X
X    free(str);
X    event = new MetaChannelPrefixEvent(time, data, len);
X    delete data;
X
X    return (event);
X}
X
XEvent *
XTclm_ParseMetaPortNumber(Tcl_Interp *interp, long time, int argc, char *argv[])
X{
X    int port;
X
X    if (argc != 2) {
X        Tcl_SetResult(interp, "bad event: should be "
X            "\"time MetaPortNumber port\"", TCL_STATIC);
X        return (0);
X    }
X
X    if (Tcl_GetInt(interp, argv[1], &port) != TCL_OK)
X        return (0);
X
X    return (new MetaPortNumberEvent(time, port));
X}
X
XEvent *
XTclm_ParseMetaEndOfTrack(Tcl_Interp *interp, long time, int argc, char *argv[])
X{
X
X    if (argc != 1) {
X        Tcl_SetResult(interp, "bad event: should be "
X            "\"time MetaEndOfTrack\"", TCL_STATIC);
X        return (0);
X    }
X
X    return (new MetaEndOfTrackEvent(time));
X}
X
XEvent *
XTclm_ParseMetaTempo(Tcl_Interp *interp, long time, int argc, char *argv[])
X{
X    int tempo;
X
X    if (argc != 2) {
X        Tcl_SetResult(interp, "bad event: should be \"time MetaTempo "
X            "tempo\"", TCL_STATIC);
X        return (0);
X    }
X
X    if (Tcl_GetInt(interp, argv[1], &tempo) != TCL_OK)
X        return (0);
X
X    return (new MetaTempoEvent(time, tempo));
X}
X
XEvent *
XTclm_ParseMetaSMPTE(Tcl_Interp *interp, long time, int argc, char *argv[])
X{
X    int hour, minute, second, frame, fractional_frame;
X
X    if (argc != 6) {
X        Tcl_SetResult(interp, "bad event: should be \"time MetaSMPTE "
X            "hour minute second frame fractional_frame\"", TCL_STATIC);
X        return (0);
X    }
X
X    if (Tcl_GetInt(interp, argv[1], &hour) != TCL_OK)
X        return (0);
X    if (Tcl_GetInt(interp, argv[2], &minute) != TCL_OK)
X        return (0);
X    if (Tcl_GetInt(interp, argv[3], &second) != TCL_OK)
X        return (0);
X    if (Tcl_GetInt(interp, argv[4], &frame) != TCL_OK)
X        return (0);
X    if (Tcl_GetInt(interp, argv[5], &fractional_frame) != TCL_OK)
X        return (0);
X
X    return (new MetaSMPTEEvent(time, hour, minute, second, frame,
X        fractional_frame));
X}
X
XEvent *
XTclm_ParseMetaTime(Tcl_Interp *interp, long time, int argc, char *argv[])
X{
X    int numerator, denominator, clocks, thirty_seconds;
X
X    if (argc != 5) {
X        Tcl_SetResult(interp, "bad event: should be \"time MetaTime "
X            "numerator denominator clocks/beat 32nds/quarter\"",
X            TCL_STATIC);
X        return (0);
X    }
X
X    if (Tcl_GetInt(interp, argv[1], &numerator) != TCL_OK)
X        return (0);
X    if (Tcl_GetInt(interp, argv[2], &denominator) != TCL_OK)
X        return (0);
X    if (Tcl_GetInt(interp, argv[3], &clocks) != TCL_OK)
X        return (0);
X    if (Tcl_GetInt(interp, argv[4], &thirty_seconds) != TCL_OK)
X        return (0);
X
X    return (new MetaTimeEvent(time, numerator, denominator, clocks,
X        thirty_seconds));
X}
X
XEvent *
XTclm_ParseMetaKey(Tcl_Interp *interp, long time, int argc, char *argv[])
X{
X    Key key;
X    Mode mode;
X    int match;
X
X    if (argc != 3) {
X        Tcl_SetResult(interp, "bad event: should be \"time MetaKey "
X            "key mode\"", TCL_STATIC);
X        return (0);
X    }
X
X    key = StrToKey(argv[1], &match);
X    if (!match) {
X        Tcl_AppendResult(interp, "bad key: ", argv[1], 0);
X        return (0);
X    }
X    mode = StrToMode(argv[2], &match);
X    if (!match) {
X        Tcl_AppendResult(interp, "bad mode: ", argv[2], 0);
X        return (0);
X    }
X
X    return (new MetaKeyEvent(time, key, mode));
X}
X
XEvent *
XTclm_ParseMetaSequencerSpecific(Tcl_Interp *interp, long time, int argc,
X    char *argv[])
X{
X    char **str;
X    MetaSequencerSpecificEvent *event;
X    unsigned char *data;
X    int i, len, val;
X
X    if (argc != 2) {
X        Tcl_SetResult(interp, "bad event: should be "
X            "\"time MetaSequencerSpecific {data ?data ...?}\"",
X            TCL_STATIC);
X        return (0);
X    }
X
X    if (Tcl_SplitList(interp, argv[1], &len, &str) != TCL_OK)
X        return (0);
X
X    data = new unsigned char[len];
X    if (data == 0)
X        return (0);
X
X    for (i = 0; i < len; i++) {
X        if (Tcl_GetInt(interp, str[i], &val) != TCL_OK)
X            return (0);
X        data[i] = val;
X    }
X
X    free(str);
X    event = new MetaSequencerSpecificEvent(time, data, len);
X    delete data;
X
X    return (event);
X}
X
XEvent *
XTclm_ParseMetaUnknown(Tcl_Interp *interp, long time, int argc, char *argv[])
X{
X    char **str;
X    MetaUnknownEvent *event;
X    unsigned char *data;
X    int i, len, type, val;
X
X    if (argc != 3) {
X        Tcl_SetResult(interp, "bad event: should be \"time MetaUnknown "
X            "type {data ?data ...?}\"", TCL_STATIC);
X        return (0);
X    }
X
X    if (Tcl_GetInt(interp, argv[1], &type) != TCL_OK)
X        return (0);
X
X    if (Tcl_SplitList(interp, argv[2], &len, &str) != TCL_OK)
X        return (0);
X
X    data = new unsigned char[len];
X    if (data == 0)
X        return (0);
X
X    for (i = 0; i < len; i++) {
X        if (Tcl_GetInt(interp, str[i], &val) != TCL_OK)
X            return (0);
X        data[i] = val;
X    }
X
X    free(str);
X    event = new MetaUnknownEvent(time, data, len, type);
X    delete data;
X
X    return (event);
X}
END_OF_FILE
  if test 25530 -ne `wc -c <'tclmidi-2.0/tclmEvent.C'`; then
    echo shar: \"'tclmidi-2.0/tclmEvent.C'\" unpacked with wrong size!
  fi
  # end of 'tclmidi-2.0/tclmEvent.C'
fi
if test -f 'tclmidi-2.0/tclmPlay.C' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'tclmidi-2.0/tclmPlay.C'\"
else
  echo shar: Extracting \"'tclmidi-2.0/tclmPlay.C'\" \(8922 characters\)
  sed "s/^X//" >'tclmidi-2.0/tclmPlay.C' <<'END_OF_FILE'
X/*-
X * Copyright (c) 1993, 1994 Michael B. Durian.  All rights reserved.
X *
X * Redistribution and use in source and binary forms, with or without
X * modification, are permitted provided that the following conditions
X * are met:
X * 1. Redistributions of source code must retain the above copyright
X *    notice, this list of conditions and the following disclaimer.
X * 2. Redistributions in binary form must reproduce the above copyright
X *    notice, this list of conditions and the following disclaimer in the
X *    documentation and/or other materials provided with the distribution.
X * 3. All advertising materials mentioning features or use of this software
X *    must display the following acknowledgement:
X *    This product includes software developed by Michael B. Durian.
X * 4. The name of the the Author may be used to endorse or promote
X *    products derived from this software without specific prior written
X *    permission.
X *
X * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED
X * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
X * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
X * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
X * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
X * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
X * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
X * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
X * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
X * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
X * SUCH DAMAGE.
X */
Xextern "C" {
X#include <tcl.h>
X}
X#include <stdlib.h>
X#include <iostream.h>
X#include <string.h>
X#include "tclmidi.h"
X#include "TclmInterp.h"
X#include "Song.h"
X#ifdef USE_MPU401
X#include "MPU401.h"
X#endif
X#ifdef USE_MPU401COPY
X#include "MPU401Copy.h"
X#endif
X
Xstatic int Tclm_MidiPlay(ClientData client_data, Tcl_Interp *interp, int argc,
X    char *argv[]);
Xstatic int Tclm_MidiRecord(ClientData client_data, Tcl_Interp *interp, int argc,
X    char *argv[]);
Xstatic int Tclm_MidiStop(ClientData client_data, Tcl_Interp *interp, int argc,
X    char *argv[]);
Xstatic int Tclm_MidiWait(ClientData client_data, Tcl_Interp *interp, int argc,
X    char *argv[]);
Xstatic int Tclm_MidiDevice(ClientData client_data, Tcl_Interp *interp, int argc,
X    char *argv[]);
X
Xint
XTclm_PlayInit(Tcl_Interp *interp, TclmInterp *tclm_interp)
X{
X
X#if defined(USE_MPU401)
X    tclm_interp->SetMidiDevice(new MPU401("/dev/midi0"));
X#elif defined(USE_MPU401COPY)
X    tclm_interp->SetMidiDevice(new MPU401Copy("/dev/midi0"));
X#else
X    tclm_interp->SetMidiDevice(0);
X#endif
X
X    Tcl_CreateCommand(interp, "midiplay", Tclm_MidiPlay, tclm_interp, 0);
X    Tcl_CreateCommand(interp, "midirecord", Tclm_MidiRecord,
X        tclm_interp, 0);
X    Tcl_CreateCommand(interp, "midistop", Tclm_MidiStop, tclm_interp, 0);
X    Tcl_CreateCommand(interp, "midiwait", Tclm_MidiWait, tclm_interp, 0);
X    Tcl_CreateCommand(interp, "mididevice", Tclm_MidiDevice,
X        tclm_interp, 0);
X    return (TCL_OK);
X}
X
Xint
XTclm_MidiPlay(ClientData client_data, Tcl_Interp *interp, int argc,
X    char *argv[])
X{
X    TclmInterp *tclm_interp;
X    Song *song;
X    MidiDevice *dev;
X    int repeat;
X
X    if (argc != 2 && argc != 3) {
X        Tcl_AppendResult(interp, "wrong # args: should be \"",
X            argv[0], " MidiID ?repeat?\"", 0);
X        return (TCL_ERROR);
X    }
X    tclm_interp = (TclmInterp *)client_data;
X
X    dev = tclm_interp->GetMidiDevice();
X    if (dev == 0) {
X        Tcl_SetResult(interp, "0", TCL_STATIC);
X        return (TCL_OK);
X    }
X
X    if ((song = tclm_interp->GetSong(argv[1])) == 0) {
X        Tcl_AppendResult(interp, "bad key ", argv[1], 0);
X        return (TCL_ERROR);
X    }
X
X    repeat = 0;
X    if (argc == 3 && strlen(argv[2]) != 0) {
X        if (strcmp(argv[2], "repeat") == 0)
X            repeat = 1;
X        else {
X            Tcl_AppendResult(interp, "bad repeat option: should "
X                "be \"", argv[0], " MidiID ?repeat?\"", 0);
X            return (TCL_ERROR);
X        }
X    }
X
X    if (!dev->Play(song, repeat)) {
X        Tcl_AppendResult(interp, "couldn't play song \n",
X            dev->GetError(), 0);
X        return (TCL_ERROR);
X    }
X    Tcl_SetResult(interp, "1", TCL_STATIC);
X    return (TCL_OK);
X}
X
Xint
XTclm_MidiRecord(ClientData client_data, Tcl_Interp *interp, int argc,
X    char *argv[])
X{
X    TclmInterp *tclm_interp;
X    Song *rsong, *psong;
X    MidiDevice *dev;
X    int repeat;
X
X    if (argc < 2 || argc > 4) {
X        Tcl_AppendResult(interp, "wrong # args: should be \"",
X            argv[0], " RecMidiID ?PlayMidiID ?repeat??\"", 0);
X        return (TCL_ERROR);
X    }
X    tclm_interp = (TclmInterp *)client_data;
X
X    dev = tclm_interp->GetMidiDevice();
X    if (dev == 0) {
X        Tcl_SetResult(interp, "0", TCL_STATIC);
X        return (TCL_OK);
X    }
X
X    if ((rsong = tclm_interp->GetSong(argv[1])) == 0) {
X        Tcl_AppendResult(interp, "bad key ", argv[1], 0);
X        return (TCL_ERROR);
X    }
X
X    psong = 0;
X    repeat = 0;
X    if (argc > 2) {
X        if ((psong = tclm_interp->GetSong(argv[2])) == 0) {
X            Tcl_AppendResult(interp, "bad key ", argv[2], 0);
X            return (TCL_ERROR);
X        }
X
X        if (argc == 4 && strlen(argv[3]) != 0) {
X            if (strcmp(argv[3], "repeat") == 0)
X                repeat = 1;
X            else {
X                Tcl_AppendResult(interp, "bad repeat flag: ",
X                    argv[3], 0);
X                return (TCL_ERROR);
X            }
X        }
X    }
X
X    if (!dev->Record(rsong, psong, repeat)) {
X        Tcl_AppendResult(interp, "Couldn't record song\n",
X            dev->GetError(), 0);
X        return (TCL_ERROR);
X    }
X    Tcl_SetResult(interp, "1", TCL_STATIC);
X    return (TCL_OK);
X}
X
Xint
XTclm_MidiStop(ClientData client_data, Tcl_Interp *interp, int argc,
X    char *argv[])
X{
X    TclmInterp *tclm_interp;
X    MidiDevice *dev;
X
X    if (argc != 1) {
X        Tcl_AppendResult(interp, "wrong # args: should be \"",
X            argv[0], "\"", 0);
X        return (TCL_ERROR);
X    }
X    tclm_interp = (TclmInterp *)client_data;
X
X    dev = tclm_interp->GetMidiDevice();
X    if (dev == 0) {
X        Tcl_SetResult(interp, "0", TCL_STATIC);
X        return (TCL_OK);
X    }
X
X    if (!dev->Stop()) {
X        Tcl_AppendResult(interp, "Couldn't stop playing/recording\n",
X            dev->GetError(), 0);
X        return (TCL_ERROR);
X    }
X    Tcl_SetResult(interp, "1", TCL_STATIC);
X    return (TCL_OK);
X}
X
Xint
XTclm_MidiWait(ClientData client_data, Tcl_Interp *interp, int argc,
X    char *argv[])
X{
X    TclmInterp *tclm_interp;
X    MidiDevice *dev;
X
X    if (argc != 1) {
X        Tcl_AppendResult(interp, "wrong # args: should be \"",
X            argv[0], 0);
X        return (TCL_ERROR);
X    }
X    tclm_interp = (TclmInterp *)client_data;
X    dev = tclm_interp->GetMidiDevice();
X    if (dev == 0) {
X        Tcl_SetResult(interp, "0", TCL_STATIC);
X        return (TCL_OK);
X    }
X    if (!dev->Wait()) {
X        Tcl_AppendResult(interp, "Couldn't wait for playing/recording "
X            "to stop\n", dev->GetError(), 0);
X        return (TCL_ERROR);
X    }
X    Tcl_SetResult(interp, "1", TCL_STATIC);
X    return (TCL_OK);
X}
X
Xint
XTclm_MidiDevice(ClientData client_data, Tcl_Interp *interp, int argc,
X    char *argv[])
X{
X    TclmInterp *tclm_interp;
X    MidiDevice *dev;
X    ostrstream *buf;
X    char *str, **sub_argv;
X    int i, sub_argc, value;
X
X    if (argc < 1) {
X        Tcl_AppendResult(interp, "wrong # args: should be \"",
X            argv[0], " ?{name|midithru ?value?} ...?\"", 0);
X        return (TCL_ERROR);
X    }
X    tclm_interp = (TclmInterp *)client_data;
X    dev = tclm_interp->GetMidiDevice();
X    if (dev == 0) {
X        Tcl_SetResult(interp, "0", TCL_STATIC);
X        return (TCL_OK);
X    }
X
X    if (argc == 1) {
X        // make list of all values
X        buf = new ostrstream;
X        *buf << "name \"" << dev->GetName() << "\"" << ends;
X        str = buf->str();
X        Tcl_AppendElement(interp, str);
X        delete str;
X        delete buf;
X        buf = new ostrstream;
X        *buf << "midithru " << (dev->GetMidiThru() ? "on" : "off")
X            << ends;
X        str = buf->str();
X        Tcl_AppendElement(interp, str);
X        delete str;
X        delete buf;
X        return (TCL_OK);
X    }
X    for (i = 1; i < argc; i++) {
X        // loop through each arg and either set or return values
X        if (Tcl_SplitList(interp, argv[i], &sub_argc, &sub_argv)
X            != TCL_OK)
X            return (TCL_ERROR);
X        switch (sub_argc) {
X        case 1:
X            // return the value
X            buf = new ostrstream;
X            if (strcmp(sub_argv[0], "name") == 0) {
X                *buf << "name \"" << dev->GetName() <<
X                    "\"" << ends;
X            } else if (strcmp(sub_argv[0], "midithru") == 0) {
X                *buf << "midithru " <<
X                    (dev->GetMidiThru() ? "on" : "off")
X                    << ends;
X            } else {
X                Tcl_AppendResult(interp, "bad parameter ",
X                    sub_argv[0], 0);
X                delete buf;
X                return (TCL_ERROR);
X            }
X            str = buf->str();
X            Tcl_AppendElement(interp, str);
X            delete str;
X            delete buf;
X            break;
X        case 2:
X            // set the value
X            if (strcmp(sub_argv[0], "name") == 0) {
X                dev->SetName(sub_argv[1]);
X            } else if (strcmp(sub_argv[0], "midithru") == 0) {
X                if (Tcl_GetBoolean(interp, sub_argv[1], &value)
X                    != TCL_OK)
X                    return (TCL_ERROR);
X                dev->SetMidiThru(value);
X            } else {
X                Tcl_AppendResult(interp, "bad parameter ",
X                    sub_argv[0], 0);
X                return (TCL_ERROR);
X            }
X            break;
X        default:
X            Tcl_SetResult(interp, "wrong # args: should be "
X                "{name|midithru ?value?}", TCL_STATIC);
X            return (TCL_ERROR);
X            break;
X        }
X        free(sub_argv);
X    }
X    return (TCL_OK);
X}
END_OF_FILE
  if test 8922 -ne `wc -c <'tclmidi-2.0/tclmPlay.C'`; then
    echo shar: \"'tclmidi-2.0/tclmPlay.C'\" unpacked with wrong size!
  fi
  # end of 'tclmidi-2.0/tclmPlay.C'
fi
echo shar: End of archive 4 \(of 14\).
cp /dev/null ark4isdone
MISSING=""
for I in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 ; do
    if test ! -f ark${I}isdone ; then
    MISSING="${MISSING} ${I}"
    fi
done
if test "${MISSING}" = "" ; then
    echo You have unpacked all 14 archives.
    rm -f ark[1-9]isdone ark[1-9][0-9]isdone
else
    echo You still must unpack the following archives:
    echo "        " ${MISSING}
fi
exit 0
exit 0 # Just in case...