tclmacosa.c

linux系统下的音频通信

 *
 * Side Effects:
 *  	Deletes a script from the script list of the given component.
 *	Removes all references to the script, and frees the memory
 *	associated with it.
 *
 *----------------------------------------------------------------------
 */
 
static int 
tclOSADeleteCmd(
    Tcl_Interp *interp,
    tclOSAComponent *OSAComponent,
    int argc,
    char **argv)
{
    char c,*errMsg = NULL;
    int length;
 	
    if (argc < 4) {
	Tcl_AppendResult(interp, "Wrong # of arguments, should be \"",
		argv[0], " ", argv[1], " what scriptName", (char *) NULL);
	return TCL_ERROR;
    }
 	
    c = *argv[2];
    length = strlen(argv[2]);
    if (c == 'c' && strncmp(argv[2], "context", length) == 0) {
	if (strcmp(argv[3], "global") == 0) {
	    Tcl_AppendResult(interp, "You cannot delete the global context",
		    (char *) NULL);
	    return TCL_ERROR;
	} else if (tclOSADeleteContext(OSAComponent, argv[3]) != TCL_OK) {
	    Tcl_AppendResult(interp, "Error deleting script \"", argv[2],
		    "\": ", errMsg, (char *) NULL);
	    ckfree(errMsg);
	    return TCL_ERROR;
	}
    } else if (c == 's' && strncmp(argv[2], "script", length) == 0) {
	if (tclOSADeleteScript(OSAComponent, argv[3], errMsg) != TCL_OK) {
	    Tcl_AppendResult(interp, "Error deleting script \"", argv[3],
		    "\": ", errMsg, (char *) NULL);
	    ckfree(errMsg);
	    return TCL_ERROR;
	}
    } else {
	Tcl_AppendResult(interp,"Unknown value ", argv[2],
		" should be one of ",
		"\"context\" or \"script\".",
		(char *) NULL );
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------- 
 *
 * tclOSAExecuteCmd --
 *
 *	This implements the execute subcommand of the component command.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Executes the given script data, and sets interp's result to
 *	the OSA component's return value.
 *
 *---------------------------------------------------------------------- 
 */
 
static int 
tclOSAExecuteCmd(
    Tcl_Interp *interp,
    tclOSAComponent *OSAComponent,
    int argc,
    char **argv)
{
    int tclError = TCL_OK, resID = 128;
    char c,buffer[32],
	*contextName = NULL,*scriptName = NULL, *resName = NULL;
    Boolean makeNewContext = false,makeContext = false;
    AEDesc scrptDesc = { typeNull, NULL };
    long modeFlags = kOSAModeCanInteract;
    OSAID resultID = kOSANullScript,
	contextID = kOSANullScript,
	parentID = kOSANullScript;
    Tcl_DString scrptData;
    OSAError osaErr = noErr;
    OSErr  sysErr = noErr;

    if (argc == 2) {
	Tcl_AppendResult(interp,
		"Error, no script data for \"", argv[0],
		" run\"", (char *) NULL);
	return TCL_ERROR;
    } 

    argv += 2;
    argc -= 2;

    /*
     * Set the context to the global context by default.
     * Then parse the argument list for switches
     */
    tclOSAGetContextID(OSAComponent, "global", &contextID);
	
    while (argc > 0) {
		
	if (*argv[0] == '-') {
	    c = *(argv[0] + 1);

	    /*
	     * "--" is the only switch that has no value.
	     */
			
	    if (c == '-' && *(argv[0] + 2) == '\0') {
		argv += 1;
		argc--;
		break;
	    }
			
	    /*
	     * So we can check here for a switch with no value.
	     */
			
	    if (argc == 1)  {
		Tcl_AppendResult(interp,
			"Error, no value given for switch ",
			argv[0], (char *) NULL);
		return TCL_ERROR;
	    }
			
	    if (c == 'c' && strcmp(argv[0] + 1, "context") == 0) {
		if (tclOSAGetContextID(OSAComponent,
			argv[1], &contextID) == TCL_OK) {
		} else {
		    Tcl_AppendResult(interp, "Script context \"",
			    argv[1], "\" not found", (char *) NULL);
		    return TCL_ERROR;
		}
	    } else { 
		Tcl_AppendResult(interp, "Error, invalid switch ", argv[0],
			" should be \"-context\"", (char *) NULL);
		return TCL_ERROR;
	    }
			
	    argv += 2;
	    argc -= 2;
	} else {
	    break;
	}
    }
	
    if (argc == 0) {
	Tcl_AppendResult(interp, "Error, no script data", (char *) NULL);
	return TCL_ERROR;
    }
		
    if (prepareScriptData(argc, argv, &scrptData, &scrptDesc) == TCL_ERROR) {
	Tcl_DStringResult(interp, &scrptData);
	AEDisposeDesc(&scrptDesc);
	return TCL_ERROR;
    }
    /*
     * Now try to compile and run, but check to make sure the
     * component supports the one shot deal
     */
    if (OSAComponent->componentFlags && kOSASupportsConvenience) {
	osaErr = OSACompileExecute(OSAComponent->theComponent,
		&scrptDesc, contextID, modeFlags, &resultID);
    } else {
	/*
	 * If not, we have to do this ourselves
	 */
	if (OSAComponent->componentFlags && kOSASupportsCompiling) {
	    OSAID compiledID = kOSANullScript;
	    osaErr = OSACompile(OSAComponent->theComponent, &scrptDesc,
		    modeFlags, &compiledID);
	    if (osaErr == noErr) {
		osaErr = OSAExecute(OSAComponent->theComponent, compiledID,
			contextID, modeFlags, &resultID);
	    }
	    OSADispose(OSAComponent->theComponent, compiledID);
	} else {
	    /*
	     * The scripting component had better be able to load text data...
	     */
	    OSAID loadedID = kOSANullScript;
			
	    scrptDesc.descriptorType = OSAComponent->languageID;
	    osaErr = OSALoad(OSAComponent->theComponent, &scrptDesc,
		    modeFlags, &loadedID);
	    if (osaErr == noErr) {
		OSAExecute(OSAComponent->theComponent, loadedID,
			contextID, modeFlags, &resultID);
	    }
	    OSADispose(OSAComponent->theComponent, loadedID);
	}
    }
    if (osaErr == errOSAScriptError) {
	tclOSAASError(interp, OSAComponent->theComponent,
		Tcl_DStringValue(&scrptData));
	tclError = TCL_ERROR;
    } else if (osaErr != noErr) {
	sprintf(buffer, "Error #%-6d compiling script", osaErr);
	Tcl_AppendResult(interp, buffer, (char *) NULL);
	tclError = TCL_ERROR;		
    } else  {
	tclOSAResultFromID(interp, OSAComponent->theComponent, resultID);
	osaErr = OSADispose(OSAComponent->theComponent, resultID);
	tclError = TCL_OK;
    } 

    Tcl_DStringFree(&scrptData);
    AEDisposeDesc(&scrptDesc);	

    return tclError;	
} 

/*
 *----------------------------------------------------------------------
 *
 * tclOSAInfoCmd --
 *
 * This implements the Info subcommand of the component command
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Info on scripts and contexts.  See the user documentation for details.
 *
 *----------------------------------------------------------------------
 */
static int 
tclOSAInfoCmd(
    Tcl_Interp *interp,
    tclOSAComponent *OSAComponent,
    int argc, 
    char **argv)
{
    char c;
    int length;
    Tcl_DString theResult;
	
    if (argc == 2) {
	Tcl_AppendResult(interp, "Wrong # of arguments, should be \"",
		argv[0], " ", argv[1], " what \"", (char *) NULL );
	return TCL_ERROR;
    }
 	
    c = *argv[2];
    length = strlen(argv[2]);
    if (c == 's' && strncmp(argv[2], "scripts", length) == 0) {
	Tcl_DStringInit(&theResult);
	if (argc == 3) {
	    getSortedHashKeys(&OSAComponent->scriptTable, (char *) NULL,
		    &theResult);
	} else if (argc == 4) {
	    getSortedHashKeys(&OSAComponent->scriptTable, argv[3], &theResult);
	} else {
	    Tcl_AppendResult(interp, "Error: wrong # of arguments,",
		    " should be \"", argv[0], " ", argv[1], " ",
		    argv[2], " ?pattern?", (char *) NULL);
	    return TCL_ERROR;
	}
	Tcl_DStringResult(interp, &theResult);
	return TCL_OK;			
    } else if (c == 'c' && strncmp(argv[2], "contexts", length) == 0) {
	Tcl_DStringInit(&theResult);		
	if (argc == 3) {
	    getSortedHashKeys(&OSAComponent->contextTable, (char *) NULL,
		   &theResult);
	} else if (argc == 4) {
	    getSortedHashKeys(&OSAComponent->contextTable,
		    argv[3], &theResult);
	} else {
	    Tcl_AppendResult(interp, "Error: wrong # of arguments for ,",
		    " should be \"", argv[0], " ", argv[1], " ",
		    argv[2], " ?pattern?", (char *) NULL);
	    return TCL_ERROR;
	}
	Tcl_DStringResult(interp, &theResult);
	return TCL_OK;			
    } else if (c == 'l' && strncmp(argv[2], "language", length) == 0) {
	Tcl_SetResult(interp, OSAComponent->languageName, TCL_STATIC);
	return TCL_OK;
    } else {
	Tcl_AppendResult(interp, "Unknown argument \"", argv[2],
		"\" for \"", argv[0], " info \", should be one of ",
		"\"scripts\" \"language\", or \"contexts\"",
		(char *) NULL);
	return TCL_ERROR;
    } 
}
		
/*
 *----------------------------------------------------------------------
 *
 * tclOSALoadCmd --
 *
 *	This is the load subcommand for the Component Command
 *
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Loads script data from the given file, creates a new context
 *	for it, and sets interp's result to the name of the new context.
 *
 *----------------------------------------------------------------------
 */
 
static int 
tclOSALoadCmd(
    Tcl_Interp *interp,
    tclOSAComponent *OSAComponent,
    int argc,
    char **argv)
{
    int tclError = TCL_OK, resID = 128;
    char c, autoName[24],
	*contextName = NULL, *scriptName = NULL, *resName = NULL;
    Boolean makeNewContext = false, makeContext = false;
    AEDesc scrptDesc = { typeNull, NULL };
    long modeFlags = kOSAModeCanInteract;
    OSAID resultID = kOSANullScript,
	contextID = kOSANullScript,
	parentID = kOSANullScript;
    OSAError osaErr = noErr;
    OSErr  sysErr = noErr;
    long scptInfo;
	
    autoName[0] = '\0';
    scriptName = autoName;
    contextName = autoName;
	
    if (argc == 2) {
	Tcl_AppendResult(interp,
		"Error, no data for \"", argv[0], " ", argv[1],
		"\"", (char *) NULL);
	return TCL_ERROR;
    } 

    argv += 2;
    argc -= 2;

    /*
     * Do the argument parsing.
     */
	
    while (argc > 0) {
		
	if (*argv[0] == '-') {
	    c = *(argv[0] + 1);
			
	    /*
	     * "--" is the only switch that has no value.
	     */
			
	    if (c == '-' && *(argv[0] + 2) == '\0') {
		argv += 1;
		argc--;
		break;
	    }
			
	    /*
	     * So we can check here a switch with no value.
	     */
			
	    if (argc == 1)  {
		Tcl_AppendResult(interp, "Error, no value given for switch ",
			argv[0], (char *) NULL);
		return TCL_ERROR;
	    }
			
	    if (c == 'r' && strcmp(argv[0] + 1, "rsrcname") == 0) {
		resName = argv[1];
	    } else if (c == 'r' && strcmp(argv[0] + 1, "rsrcid") == 0) {
		if (Tcl_GetInt(interp, argv[1], &resID) != TCL_OK) {
		    Tcl_AppendResult(interp,
			    "Error getting resource ID", (char *) NULL);
		    return TCL_ERROR;
		}
	    } else {
		Tcl_AppendResult(interp, "Error, invalid switch ", argv[0],
			" should be \"--\", \"-rsrcname\" or \"-rsrcid\"",
			(char *) NULL);
		return TCL_ERROR;
	    }
			
	    argv += 2;
	    argc -= 2;
	} else {
	    break;
	}
    }
    /*
     * Ok, now we have the options, so we can load the resource,
     */
    if (argc == 0) {
	Tcl_AppendResult(interp, "Error, no filename given", (char *) NULL);
	return TCL_ERROR;
    }
	
    if (tclOSALoad(interp, OSAComponent, resName, resID,
	    argv[0], &resultID) != TCL_OK) {
	Tcl_AppendResult(interp, "Error in load command", (char *) NULL);
	return TCL_ERROR;
    }
	 
    /*
     *  Now find out whether we have a script, or a script context.
     */
	 
    OSAGetScriptInfo(OSAComponent->theComponent, resultID,
	    kOSAScriptIsTypeScriptContext, &scptInfo);
    
    if (scptInfo) {
	autoName[0] = '\0';
	tclOSAAddContext(OSAComponent, autoName, resultID);
		
	Tcl_SetResult(interp, autoName, TCL_VOLATILE);
    } else {
	/*
	 * For a script, we return the script name
	 */
	autoName[0] = '\0';
	tclOSAAddScript(OSAComponent, autoName, kOSAModeCanInteract, resultID);
	Tcl_SetResult(interp, autoName, TCL_VOLATILE);
    }		 	
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * tclOSARunCmd --
 *
 *	This implements the run subcommand of the component command
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Runs the given compiled script, and returns the OSA
 *	component's result.
 *
 *----------------------------------------------------------------------
 */
 
static int 
tclOSARunCmd(
    Tcl_Interp *interp,
    tclOSAComponent *OSAComponent,
    int argc,
    char **argv)
{
    int tclError = TCL_OK,
	resID = 128;
    char c, *contextName = NULL,
	*scriptName = NULL, 
	*resName = NULL;
    AEDesc scrptDesc = { typeNull, NULL };
    long modeFlags = kOSAModeCanInteract;
    OSAID resultID = kOSANullScript,
	contextID = kOSANullScript,
	parentID = kOSANullScript;
    OSAError osaErr = noErr;
    OSErr sysErr = noErr;
    char *componentName = argv[0];
    OSAID scriptID;
	
    if (argc == 2) {
	Tcl_AppendResult(interp, "Wrong # of arguments, should be \"",
		argv[0], " ", argv[1], " scriptName", (char *) NULL);
	return TCL_ERROR;
    }
	
    /*