NetNews Usenet Archive 1993 #1/NN_1993_1.iso/spool/comp/lang/tcl/2354

Internet Message Format | 1993-01-12 | 26.7 KB

Path: sparky!uunet!olivea!spool.mu.edu!agate!boulder!csn!cherokee!durian
From: [e-mail] (Mike Durian)
Newsgroups: comp.lang.tcl
Subject: tclm0.1 - tcl with MIDI extensions (2/7)
Message-ID: <[e-mail]>
Date: 12 Jan 93 20:27:50 GMT
Sender: [e-mail] (Radio Free Boulder)
Organization: U S WEST Advanced Technologies
Lines: 886
Nntp-Posting-Host: mongo.advtech.uswest.com

# This is a shell archive.  Save it in a file, remove anything before
# this line, and then unpack it by entering "sh file".  Note, it may
# create directories; files and directories will be owned by you and
# have default permissions.
#
# This archive contains:
#
#    tclm0.1/Makefile
#    tclm0.1/bsdi.patch
#    tclm0.1/main.c
#    tclm0.1/tclm.h
#    tclm0.1/tclmMPU.c
#    tclm0.1/tclmMPU.h
#
echo x - tclm0.1/Makefile
sed 's/^X//' >tclm0.1/Makefile << 'END-of-tclm0.1/Makefile'
X# set TCLSRCDIR to the location of the tcl source
XTCLSRCDIR = /u/durian/src/tk3.0/tcl
X
X# add -DMPU to defines if you wish to compile in the ability to
X# play standard MIDI files.  This will only work on BSD/386
X# (BSDI) machines equipped with a MPU401 compatible MIDI card.
X# DEFS =
XDEFS = -DMPU
X
X# set RANLIB to ranlib if your system has it - otherwise set it to
X# true
X# RANLIB = true
XRANLIB = ranlib
X
X# set BINDIR to the directory in which you want the executables
X# to reside
XBINDIR = /usr/local/bin
X
X# tclm library stuff
XAR = libtclm.a
XSRCS = tclmCmd.c tclmMPU.c
XOBJS = tclmCmd.o tclmMPU.o
X
X# stuff for a tclm executable
XTCLMSRC = main.c
XTCLMOBJ = main.o
XTCLMEXEC = tclm
X
X# some sample scripts
XTCLMSCRIPTS = mplay minfo
X
X# where the MIDI library routines are located
XMIDILIBDIR = ./mlib
XMIDIAR = $(MIDILIBDIR)/libmutil.a
X
X# flags and libraries
XLIBS = -ltcl -ltclm -lmutil
XLDFLAGS = -L$(TCLSRCDIR) -L$(MIDILIBDIR) -L. $(LIBS)
XCFLAGS = $(DEFS) -O -I$(TCLSRCDIR) -I$(MIDILIBDIR)
XCC = cc
X
X
X$(TCLMEXEC):    $(MIDIAR) $(AR) $(TCLMOBJ)
X    $(CC) -o $(TCLMEXEC) $(TCLMOBJ) $(LDFLAGS)
X
X$(AR):    $(OBJS)
X    rm -f $(AR)
X    ar cr $(AR) $(OBJS)
X    $(RANLIB) $(AR)
X
X$(MIDIAR): FORCE
X    cd $(MIDILIBDIR); $(MAKE) DEFS=$(DEFS) RANLIB=$(RANLIB)
X
Xinstall:    $(TCLMEXEC) $(TCLMSCRIPTS)
X    chmod 755 $(TCLMSCRIPTS)
X    cp $(TCLMEXEC) $(TCLMSCRIPTS) $(BINDIR)
X
Xclean:
X    rm -f $(TCLMEXEC) $(AR) $(OBJS) $(TCLMOBJ)
X    cd $(MIDILIBDIR); $(MAKE) clean
X
XFORCE:
END-of-tclm0.1/Makefile
echo x - tclm0.1/bsdi.patch
sed 's/^X//' >tclm0.1/bsdi.patch << 'END-of-tclm0.1/bsdi.patch'
X*** tcl/tclEnv.c    Fri Nov 20 09:41:26 1992
X--- ../tk3.0.new/tcl/tclEnv.c    Tue Jan  5 19:10:58 1993
X***************
X*** 57,65 ****
X                  int flags));
X  static int        FindVariable _ANSI_ARGS_((CONST char *name,
X                  int *lengthPtr));
X! void            setenv _ANSI_ARGS_((CONST char *name,
X                  CONST char *value));
X! void            unsetenv _ANSI_ARGS_((CONST char *name));
X
X  /*
X   *----------------------------------------------------------------------
X--- 57,65 ----
X                  int flags));
X  static int        FindVariable _ANSI_ARGS_((CONST char *name,
X                  int *lengthPtr));
X! void            Setenv _ANSI_ARGS_((CONST char *name,
X                  CONST char *value));
X! void            Unsetenv _ANSI_ARGS_((CONST char *name));
X
X  /*
X   *----------------------------------------------------------------------
X***************
X*** 183,189 ****
X  /*
X   *----------------------------------------------------------------------
X   *
X!  * setenv --
X   *
X   *    Set an environment variable, replacing an existing value
X   *    or creating a new variable if there doesn't exist a variable
X--- 183,189 ----
X  /*
X   *----------------------------------------------------------------------
X   *
X!  * Setenv --
X   *
X   *    Set an environment variable, replacing an existing value
X   *    or creating a new variable if there doesn't exist a variable
X***************
X*** 200,206 ****
X   */
X
X  void
X! setenv(name, value)
X      CONST char *name;        /* Name of variable whose value is to be
X                   * set. */
X      CONST char *value;        /* New value for variable. */
X--- 200,206 ----
X   */
X
X  void
X! Setenv(name, value)
X      CONST char *name;        /* Name of variable whose value is to be
X                   * set. */
X      CONST char *value;        /* New value for variable. */
X***************
X*** 275,281 ****
X  /*
X   *----------------------------------------------------------------------
X   *
X!  * unsetenv --
X   *
X   *    Remove an environment variable, updating the "env" arrays
X   *    in all interpreters managed by us.
X--- 275,281 ----
X  /*
X   *----------------------------------------------------------------------
X   *
X!  * Unsetenv --
X   *
X   *    Remove an environment variable, updating the "env" arrays
X   *    in all interpreters managed by us.
X***************
X*** 290,296 ****
X   */
X
X  void
X! unsetenv(name)
X      CONST char *name;            /* Name of variable to remove. */
X  {
X      int index, dummy;
X--- 290,296 ----
X   */
X
X  void
X! Unsetenv(name)
X      CONST char *name;            /* Name of variable to remove. */
X  {
X      int index, dummy;
X***************
X*** 392,406 ****
X      }
X
X      /*
X!      * If a value is being set, call setenv to do all of the work.
X       */
X
X      if (flags & TCL_TRACE_WRITES) {
X!     setenv(name2, Tcl_GetVar2(interp, "env", name2, TCL_GLOBAL_ONLY));
X      }
X
X      if (flags & TCL_TRACE_UNSETS) {
X!     unsetenv(name2);
X      }
X      return NULL;
X  }
X--- 392,406 ----
X      }
X
X      /*
X!      * If a value is being set, call Setenv to do all of the work.
X       */
X
X      if (flags & TCL_TRACE_WRITES) {
X!     Setenv(name2, Tcl_GetVar2(interp, "env", name2, TCL_GLOBAL_ONLY));
X      }
X
X      if (flags & TCL_TRACE_UNSETS) {
X!     Unsetenv(name2);
X      }
X      return NULL;
X  }
X*** tcl/tclUnix.h    Fri Aug 21 16:59:18 1992
X--- ../tk3.0.new/tcl/tclUnix.h    Tue Jan  5 19:07:10 1993
X***************
X*** 294,300 ****
X--- 294,303 ----
X  extern int    execvp       _ANSI_ARGS_((CONST char *name, char **argv));
X  extern void    _exit        _ANSI_ARGS_((int status));
X  extern pid_t    fork       _ANSI_ARGS_((void));
X+ /*
X  extern long    fseek       _ANSI_ARGS_((FILE *stream, long offset, int base));
X+ */
X+ extern int    fseek       _ANSI_ARGS_((FILE *stream, long offset, int base));
X  extern uid_t    geteuid       _ANSI_ARGS_((void));
X  extern pid_t    getpid       _ANSI_ARGS_((void));
X  extern char *    getcwd        _ANSI_ARGS_((char *buffer, int size));
END-of-tclm0.1/bsdi.patch
echo x - tclm0.1/main.c
sed 's/^X//' >tclm0.1/main.c << 'END-of-tclm0.1/main.c'
X/* main.c,v 1.3 1993/01/12 19:23:02 durian Exp */
X/*
X * Copyright (c) 1993 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 */
X#include "tclInt.h"
X#include "mutil.h"
X#include "tclm.h"
X#include "tclmMPU.h"
X
X/*
X * Declarations for library procedures:
X */
X
Xextern int isatty();
X
XTcl_Interp *interp;
XTcl_CmdBuf buffer;
Xint tty;
X
Xvoid usage _ANSI_ARGS_(());
Xextern char *optarg;
X
X    /* ARGSUSED */
Xint
Xmain(argc, argv)
X    int argc;
X    char **argv;
X{
X    static int gotPartial = 0;
X    int result;
X    FILE *file;
X    char *args;
X    char *cmd;
X    int have_f;
X    char buf[20];
X    char line[200];
X    char opt;
X
X    have_f = 0;
X    file = stdin;
X
X    /*
X     * we want to stop parsing args when we get a -f, so the
X     * script can get the args it wants
X     */
X    while (!have_f && (opt = getopt(argc, argv, "f:")) != -1) {
X        switch (opt) {
X        case 'f':
X            if ((file = fopen(optarg, "r")) == NULL) {
X                fprintf(stderr, "Couldn't open %s\n", optarg);
X                exit(1);
X            }
X            have_f = 1;
X            break;
X        case '?':
X            usage();
X            exit(1);
X        }
X    }
X
X    interp = Tcl_CreateInterp();
X    args = Tcl_Merge(argc-1, argv+1);
X    Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);
X    ckfree(args);
X    sprintf(buf, "%d", argc - 1);
X    Tcl_SetVar(interp, "argc", buf, TCL_GLOBAL_ONLY);
X    Tclm_InitMidi(interp);
X#ifdef MPU
X    Tclm_InitMPU401(interp);
X#endif
X    buffer = Tcl_CreateCmdBuf();
X    tty = isatty(0);
X
X    for (;;) {
X        if (file == stdin && tty)
X            printf("tclm: ");
X
X        if (fgets(line, 200, file) == NULL)
X            break;
X        cmd = Tcl_AssembleCmd(buffer, line);
X        if (cmd == NULL) {
X            gotPartial = 1;
X            continue;
X        }
X        gotPartial = 0;
X        result = Tcl_RecordAndEval(interp, cmd, 0);
X        if (*interp->result != 0) {
X            if (result != TCL_OK) {
X                printf("%s\n", Tcl_GetVar(interp, "errorInfo",
X                    0));
X                if (file !=stdin || !tty)
X                    break;
X            } else if (file == stdin && tty) {
X                printf("%s\n", interp->result);
X            }
X        }
X    }
X
X    Tcl_DeleteInterp(interp);
X    Tcl_DeleteCmdBuf(buffer);
X    exit(0);
X}
X
Xvoid
Xusage()
X{
X
X    (void) fprintf(stderr, "Usage: tclm [ -f filename ]\n");
X}
END-of-tclm0.1/main.c
echo x - tclm0.1/tclm.h
sed 's/^X//' >tclm0.1/tclm.h << 'END-of-tclm0.1/tclm.h'
X/* tclm.h,v 1.3 1993/01/12 19:23:04 durian Exp */
X/*
X * Copyright (c) 1993 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 */
X#ifndef TCLM_H
X#define TCLM_H
Xtypedef struct {
X    HCHUNK    hchunk;
X    TCHUNK    *tchunks;
X} MIDI_FILE;
X
X#define MAX_EVENT_SIZE 256
X
Xextern int Tclm_MidiConfig _ANSI_ARGS_((ClientData, Tcl_Interp *, int,
X    char **));
Xextern int Tclm_ConvertBytes _ANSI_ARGS_((Tcl_Interp *, char *,
X    unsigned char *, int *));
Xextern int Tclm_Division _ANSI_ARGS_((Tcl_Interp *, int, char **));
Xextern int Tclm_MidiFixToVar _ANSI_ARGS_((ClientData, Tcl_Interp *, int,
X    char **));
Xextern int Tclm_Format _ANSI_ARGS_((Tcl_Interp *, int, char **));
Xextern int Tclm_MidiFree _ANSI_ARGS_((ClientData, Tcl_Interp *, int, char **));
Xextern int Tclm_MidiGet _ANSI_ARGS_((ClientData, Tcl_Interp *, int, char **));
Xextern int Tclm_MidiPut _ANSI_ARGS_((ClientData, Tcl_Interp *, int, char **));
Xextern int Tclm_GetMFile _ANSI_ARGS_((Tcl_Interp *, char *, MIDI_FILE **));
Xextern void Tclm_InitMidi _ANSI_ARGS_((Tcl_Interp *));
Xextern int Tclm_MidiMake _ANSI_ARGS_((ClientData, Tcl_Interp *, int, char **));
Xextern int Tclm_NumTracks _ANSI_ARGS_((Tcl_Interp *, int, char **));
Xextern int Tclm_MidiRead _ANSI_ARGS_((ClientData, Tcl_Interp *, int, char **));
Xextern int Tclm_MidiRewind _ANSI_ARGS_((ClientData, Tcl_Interp *, int,
X    char **));
Xextern int Tclm_SetMFile _ANSI_ARGS_((Tcl_Interp *, char *, MIDI_FILE *));
Xextern int Tclm_MidiTiming _ANSI_ARGS_((ClientData, Tcl_Interp *, int,
X    char **));
Xextern int Tclm_MidiVarToFix _ANSI_ARGS_((ClientData, Tcl_Interp *, int,
X    char **));
Xextern int Tclm_MidiWrite _ANSI_ARGS_((ClientData, Tcl_Interp *, int,
X    char **));
Xextern int Tclm_MidiMPU _ANSI_ARGS_((ClientData, Tcl_Interp *, int, char **));
X#endif
END-of-tclm0.1/tclm.h
echo x - tclm0.1/tclmMPU.c
sed 's/^X//' >tclm0.1/tclmMPU.c << 'END-of-tclm0.1/tclmMPU.c'
X/* tclmMPU.c,v 1.3 1993/01/12 19:23:10 durian Exp */
X/*
X * Copyright (c) 1993 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 */
X#ifdef MPU
X#include <signal.h>
X#include <sys/ioctl.h>
X#include <i386/isa/midiioctl.h>
X#include "tclInt.h"
X#include "tclUnix.h"
X#include "mutil.h"
X#include "mpu401.h"
X#include "mplayutil.h"
X#include "tclm.h"
X#include "tclmMPU.h"
X
Xstatic int now_playing = 0;
Xstatic int control_dev;
X
Xvoid
XTclm_InitMPU401(interp)
X    Tcl_Interp *interp;
X{
X
X    Tcl_CreateCommand(interp, "midiplay", Tclm_MidiPlay, NULL, NULL);
X    Tcl_CreateCommand(interp, "midistop", Tclm_MidiStop, NULL, NULL);
X    signal(SIGCHLD, watchdog);
X}
X
X
Xint
XTclm_MidiPlay(dummy, interp, argc, argv)
X    ClientData dummy;
X    Tcl_Interp *interp;
X    int argc;
X    char **argv;
X{
X    TRKS track_list;
X    long division_ioctl;
X    MIDI_FILE *mfile;
X    char *mfile_name;
X    int track_devs[NUM_TRKS + 1]; /* plus 1 for conductor if needed */
X    int background;
X    int conductor_on;
X/*
X    int control_dev;
X*/
X    int i;
X    int j;
X    int num_open_tracks;
X    int pid;
X    int repeat;
X    int result;
X    int tempo_scalar;
X    unsigned char active_tracks;
X    unsigned char rel_tempo;
X    unsigned char tempo;
X
X    if (argc < 2) {
X        Tcl_AppendResult(interp, "wrong # args: should be \"",
X            argv[0], " ?options? fileId\"", (char *)NULL);
X        return (TCL_ERROR);
X    }
X
X    rel_tempo = 0x40;
X    repeat = 0;
X    background = 0;
X    mfile_name = NULL;
X    /* default tempo is 120 */
X    tempo = 120;
X    /* so we can check to see if it gets set explicitly */
X    track_list.num_tracks = -1;
X
X    for (i = 1; i < argc; i++) {
X        switch(argv[i][0]) {
X        case 'b':
X            if (strncmp(argv[i], "bg", sizeof(argv[i])) == 0 ||
X                strncmp(argv[i], "background", sizeof(argv[i]))
X                == 0)
X                background = 1;
X            else if (mfile_name == NULL)
X                mfile_name = argv[i];
X            else {
X                Tcl_AppendResult(interp, "bad option: ",
X                    argv[i], " should be \"", argv[0],
X                    " ?options? ", "fileId\"", (char *)NULL);
X                return (TCL_ERROR);
X            }
X            break;
X        case 'r':
X            if (strncmp(argv[i], "reltempo", strlen(argv[i]))
X                == 0)
X                rel_tempo = double2tempo(atof(argv[++i]));
X            else if (strncmp(argv[i], "repeat", strlen(argv[i]))
X                == 0)
X                repeat = 1;
X            else if (mfile_name == NULL)
X                mfile_name = argv[i];
X            else {
X                Tcl_AppendResult(interp, "bad option: ",
X                    argv[i], " should be \"", argv[0],
X                    " ?options? ", "fileId\"", (char *)NULL);
X                return (TCL_ERROR);
X            }
X
X            break;
X        case 't':
X            if (strncmp(argv[i], "tracks", strlen(argv[i]))
X                == 0) {
X                if ((result = Tclm_ParseTracks(interp,
X                    argv[i + 1], &track_list)) != TCL_OK)
X                    return (result);
X                i++;
X            } else if (mfile_name == NULL) {
X                mfile_name = argv[i];
X            } else {
X                Tcl_AppendResult(interp, "bad option: ",
X                    argv[i], " should be \"", argv[0],
X                    " ?options? ", "fileId\"", (char *)NULL);
X                return (TCL_ERROR);
X            }
X            break;
X        default:
X            if (mfile_name == NULL)
X                mfile_name = argv[i];
X            else {
X                Tcl_AppendResult(interp, "bad option: ",
X                    argv[i], " should be \"", argv[0],
X                    " ?options? ", "fileId\"", (char *)NULL);
X                return (TCL_ERROR);
X            }
X        }
X    }
X
X    if ((result = Tclm_GetMFile(interp, mfile_name, &mfile)) != TCL_OK)
X        return (result);
X
X    /* If track list isn't set use all tracks */
X    if (track_list.num_tracks == -1) {
X        track_list.num_tracks = mfile->hchunk.num_trks;
X        for (j = 0; j < track_list.num_tracks; j++)
X            track_list.tracks[j] = j;
X    }
X
X    /* determine tempo scalar */
X    if (!adjust_division(mfile->hchunk.division, &division_ioctl,
X        &tempo_scalar)) {
X        Tcl_AppendResult(interp, "Bad division value.  Must be ",
X            "one of 48, 72, 96, 120, 144, 168, 192 or integer ",
X            "multiple thereof", (char *)NULL);
X        return (TCL_ERROR);
X    }
X
X    /* open MIDI play devices */
X    num_open_tracks = track_list.num_tracks;
X    if ((conductor_on = open_midi_devices(&mfile->hchunk, &track_list,
X        &num_open_tracks, track_devs, &active_tracks)) == -1) {
X        Tcl_AppendResult(interp, "Couldn't open MIDI devices\n",
X            MidiError, (char *)NULL);
X        return (TCL_ERROR);
X    }
X
X    /* open MIDI control device */
X    if ((control_dev = open("/dev/midicntl", O_RDONLY, 0)) == -1) {
X        Tcl_AppendResult(interp, "Couldn't open /dev/midicntl: ",
X            sys_errlist[errno], (char *)NULL);
X        return (TCL_ERROR);
X    }
X
X    /* set tempo */
X    if (ioctl(control_dev, MSETBASETMP, &tempo) == -1) {
X        Tcl_AppendResult(interp, "Couldn't set tempo: ",
X            sys_errlist[errno], (char *)NULL);
X        return (TCL_ERROR);
X    }
X
X    /* set relative tempo */
X    if (ioctl(control_dev, MSETRELTMP, &rel_tempo) == -1) {
X        Tcl_AppendResult(interp, "Couldn't set relative tempo: ",
X            sys_errlist[errno], (char *)NULL);
X        return (TCL_ERROR);
X    }
X
X    /* set division */
X    if (ioctl(control_dev, division_ioctl, NULL) == -1) {
X        Tcl_AppendResult(interp, "Couldn't set division: ",
X            sys_errlist[errno], (char *)NULL);
X        return (TCL_ERROR);
X    }
X
X    /* select active tracks */
X    if (ioctl(control_dev, MSELTRKS, &active_tracks) == -1) {
X        Tcl_AppendResult(interp, "Couldn't select active tracks: ",
X            sys_errlist[errno], (char *)NULL);
X        return (TCL_ERROR);
X    }
X
X    /* set conductor status */
X    if (conductor_on) {
X        if (ioctl(control_dev, MCONDON, NULL) == -1) {
X            Tcl_AppendResult(interp, "Couldn't select ",
X                "conductor track: ", sys_errlist[errno],
X                (char *)NULL);
X            return (TCL_ERROR);
X        }
X    } else {
X        if (ioctl(control_dev, MCONDOFF, NULL) == -1) {
X            Tcl_AppendResult(interp, "Couldn't unselect ",
X                "conductor track: ", sys_errlist[errno],
X                (char *)NULL);
X            return (TCL_ERROR);
X        }
X    }
X
X    /* clear play counter */
X    if (ioctl(control_dev, MCLRPC, NULL) == -1) {
X        Tcl_AppendResult(interp, "Couldn't clear play counter: ",
X            sys_errlist[errno], (char *)NULL);
X        return (TCL_ERROR);
X    }
X
X    /* start playing */
X    if (ioctl(control_dev, MSTART, NULL) == -1) {
X        Tcl_AppendResult(interp, "Couldn't start playing: ",
X            sys_errlist[errno], (char *)NULL);
X        return (TCL_ERROR);
X    }
X
X
X    if (!background) {
X        now_playing = 1;
X        if (!play_tracks(mfile->tchunks, track_devs, num_open_tracks,
X            tempo_scalar, repeat)) {
X            Tcl_AppendResult(interp, "Couldn't play tracks\n",
X                MidiError, (char *)NULL);
X            return (TCL_ERROR);
X        }
X        now_playing = 0;
X        if (ioctl(control_dev, MSTOP, NULL) == -1) {
X            Tcl_AppendResult(interp, "Couldn't stop playing: ",
X                sys_errlist[errno], (char *)NULL);
X            return (TCL_ERROR);
X        }
X
X        close(control_dev);
X        for (i = 0; i < num_open_tracks; i++)
X            close(track_devs[i]);
X        Tcl_AppendResult(interp, "0", (char *)NULL);
X    } else {
X        switch(pid = fork()) {
X        case -1:
X            Tcl_AppendResult(interp, "Couldn't fork",
X                (char *)NULL);
X            return (TCL_ERROR);
X        case 0:
X            /* child */
X            now_playing = 1;
X            if (!play_tracks(mfile->tchunks, track_devs,
X                num_open_tracks, tempo_scalar, repeat)) {
X                Tcl_AppendResult(interp,
X                    "Couldn't play tracks\n", MidiError,
X                    (char *)NULL);
X                return (TCL_ERROR);
X            }
X            now_playing = 0;
X            if (ioctl(control_dev, MSTOP, NULL) == -1) {
X                Tcl_AppendResult(interp,
X                    "Couldn't stop playing: ", MidiError,
X                    (char *)NULL);
X                return (TCL_ERROR);
X            }
X
X            close(control_dev);
X            for (i = 0; i < num_open_tracks; i++)
X                close(track_devs[i]);
X            exit(0);
X        default:
X            close(control_dev);
X            for (i = 0; i < num_open_tracks; i++)
X                close(track_devs[i]);
X            sprintf(interp->result, "%d", pid);
X            break;
X        }
X    }
X
X    return (TCL_OK);
X}
X
Xvoid
Xwatchdog()
X{
X    int wstatus;
X
X    while(wait3(&wstatus, WNOHANG, NULL) >= 0);
X}
X
Xint
Xcompare_ints(val1, val2)
X    int *val1;
X    int *val2;
X{
X
X    if (*val1 < *val2)
X        return (-1);
X    else if (*val1 > *val2)
X        return (1);
X    else
X        return (0);
X}
X
Xint
XTclm_ParseTracks(interp, list, track_list)
X    Tcl_Interp *interp;
X    char *list;
X    TRKS *track_list;
X{
X    char **track_strs;
X    char *chk_ptr;
X    int i;
X    int result;
X
X    if ((result = Tcl_SplitList(interp, list, &track_list->num_tracks,
X        &track_strs)) != TCL_OK) {
X        Tcl_AppendResult(interp, "Bad track list", (char *)NULL);
X        return (result);
X    }
X    for (i = 0; i < track_list->num_tracks; i++) {
X        track_list->tracks[i] = (int)strtol(track_strs[i],
X            &chk_ptr, 0);
X        if (chk_ptr == track_strs[i]) {
X            Tcl_AppendResult(interp, "Bad track value ",
X                track_strs[i], (char *)NULL);
X            return (TCL_ERROR);
X        }
X    }
X    qsort(track_list->tracks, track_list->num_tracks,
X        sizeof(track_list->tracks[0]), (int (*)())compare_ints);
X    free((char *)track_strs);
X    return (TCL_OK);
X}
X
Xint
XTclm_MidiStop(dummy, interp, argc, argv)
X    ClientData dummy;
X    Tcl_Interp *interp;
X    int argc;
X    char **argv;
X{
X    char *chk_ptr;
X    int pid;
X
X    /*
X     * argv[0] - midistop
X     * argv[1] - pid
X     */
X    if (argc != 2) {
X        Tcl_AppendResult(interp, "wrong # args: should be\"",
X            argv[0], " pid\"", (char *)NULL);
X        return (TCL_ERROR);
X    }
X
X    pid = (int)strtol(argv[1], &chk_ptr, 0);
X    if (chk_ptr == argv[1] || pid <= 0) {
X        Tcl_AppendResult(interp, "bad pid value: ", argv[1],
X            (char *)NULL);
X        return (TCL_ERROR);
X    }
X    if (kill(pid, SIGINT) != -1)
X        Tcl_AppendResult(interp, "1", (char *)NULL);
X    else {
X        if (errno == ESRCH)
X            Tcl_AppendResult(interp, "0", (char *)NULL);
X        else {
X            Tcl_AppendResult(interp, "Error killing process: ",
X                sys_errlist[errno], (char *)NULL);
X            return (TCL_ERROR);
X        }
X    }
X    return (TCL_OK);
X}
X#endif
END-of-tclm0.1/tclmMPU.c
echo x - tclm0.1/tclmMPU.h
sed 's/^X//' >tclm0.1/tclmMPU.h << 'END-of-tclm0.1/tclmMPU.h'
X/* tclmMPU.h,v 1.3 1993/01/12 19:23:13 durian Exp */
X/*
X * Copyright (c) 1993 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 */
X#ifndef TCLMMPU_H
X#define TCLMMPU_H
X
Xextern void Tclm_InitMPU401 _ANSI_ARGS_((Tcl_Interp *));
Xextern int Tclm_MidiPlay _ANSI_ARGS_((ClientData, Tcl_Interp *, int, char **));
Xextern int Tclm_MidiStop _ANSI_ARGS_((ClientData, Tcl_Interp *, int, char **));
Xextern void watchdog _ANSI_ARGS_(());
Xextern int compare_ints _ANSI_ARGS_((int *, int *));
Xextern int Tclm_ParseTracks _ANSI_ARGS_((Tcl_Interp *, char *, TRKS *));
X#endif
END-of-tclm0.1/tclmMPU.h
exit