From: durian@advtech.uswest.com (Mike Durian)
Newsgroups: comp.lang.tcl
Subject: tclm0.1 - tcl with MIDI extensions (2/7)
Date: 12 Jan 93 20:27:50 GMT
Organization: U S WEST Advanced Technologies

# 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
Newsgroups: comp.lang.tcl