tclmacosa.c

linux系统下的音频通信

	}
		 	
	c = *argv[2];
	length = strlen(argv[2]);
		
	if (c == 'c' && strncmp(argv[2], "components", length) == 0) {
	    Tcl_DString theResult;
			
	    Tcl_DStringInit(&theResult);
			
	    if (argc == 3) {
		getSortedHashKeys(ComponentTable,(char *) NULL, &theResult);
	    } else if (argc == 4) {
		getSortedHashKeys(ComponentTable, 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 == 'l' && strncmp(argv[2],"languages",length) == 0) {
	    Tcl_DString theResult;
	    Tcl_HashTable *LanguagesTable;
			
	    Tcl_DStringInit(&theResult);
	    LanguagesTable = Tcl_GetAssocData(interp,
		    "OSAScript_LangTable", (Tcl_InterpDeleteProc **) NULL);
							
	    if (argc == 3) {
		getSortedHashKeys(LanguagesTable, (char *) NULL, &theResult);
	    } else if (argc == 4) {
		getSortedHashKeys(LanguagesTable, 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 {
	    Tcl_AppendResult(interp, "Unknown option: ", argv[2],
		    " for OSA info, should be one of",
		    " \"components\" or \"languages\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
    } else {
	Tcl_AppendResult(interp, "Unknown option: ", argv[1],
		", should be one of \"open\", \"close\" or \"info\".",
		(char *) NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/* 
 *----------------------------------------------------------------------
 *
 * Tcl_OSAComponentCmd --
 *
 *	This is the command that provides the interface with an OSA
 *	component.  The sub commands are:
 *	- compile ? -context context? scriptData
 *		compiles the script data, returns the ScriptID
 *	- decompile ? -context context? scriptData
 *		decompiles the script data, source code
 *	- execute ?-context context? scriptData
 *		compiles and runs script data
 *	- info what: get component info
 *	- load ?-flags values? fileName
 *		loads & compiles script data from fileName
 *	- run scriptId ?options?
 *		executes the compiled script 
 *
 * Results:
 *	A standard Tcl result
 *
 * Side Effects:
 *	Depends on the subcommand, see the user documentation
 *	for more details.
 *
 *----------------------------------------------------------------------
 */
 
int 
Tcl_OSAComponentCmd(
    ClientData clientData,
    Tcl_Interp *interp, 
    int argc,
    char **argv)
{
    int length;
    char c;
	
    tclOSAComponent *OSAComponent = (tclOSAComponent *) clientData;
	
    if (argc == 1) {
	Tcl_AppendResult(interp, "wrong # args: should be \"",
		argv[0], " option ?arg ...?\"",
		(char *) NULL);
	return TCL_ERROR;
    }
	
    c = *argv[1];
    length = strlen(argv[1]);
    if (c == 'c' && strncmp(argv[1], "compile", length) == 0) {
	return TclOSACompileCmd(interp, OSAComponent, argc, argv);
    } else if (c == 'l' && strncmp(argv[1], "load", length) == 0) {
	return tclOSALoadCmd(interp, OSAComponent, argc, argv);
    } else if (c == 'e' && strncmp(argv[1], "execute", length) == 0) {
	return tclOSAExecuteCmd(interp, OSAComponent, argc, argv);
    } else if (c == 'i' && strncmp(argv[1], "info", length) == 0) {
	return tclOSAInfoCmd(interp, OSAComponent, argc, argv);
    } else if (c == 'd' && strncmp(argv[1], "decompile", length) == 0) {
	return tclOSADecompileCmd(interp, OSAComponent, argc, argv);
    } else if (c == 'd' && strncmp(argv[1], "delete", length) == 0) {
	return tclOSADeleteCmd(interp, OSAComponent, argc, argv);
    } else if (c == 'r' && strncmp(argv[1], "run", length) == 0) {
	return tclOSARunCmd(interp, OSAComponent, argc, argv);
    } else if (c == 's' && strncmp(argv[1], "store", length) == 0) {
	return tclOSAStoreCmd(interp, OSAComponent, argc, argv);
    } else {
	Tcl_AppendResult(interp,"bad option \"", argv[1],
		"\": should be compile, decompile, delete, ",
		 "execute, info, load, run or store",
		 (char *) NULL);
	return TCL_ERROR;
    }

    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclOSACompileCmd --
 *
 *	This is the compile subcommand for the component command.
 *
 * Results:
 *	A standard Tcl result
 *
 * Side Effects:
 *  	Compiles the script data either into a script or a script
 *	context.  Adds the script to the component's script or context
 *	table.  Sets interp's result to the name of the new script or
 *	context.
 *
 *----------------------------------------------------------------------
 */
 
static int 
TclOSACompileCmd(
    Tcl_Interp *interp,
    tclOSAComponent *OSAComponent,
    int argc,
    char **argv)
{
    int  tclError = TCL_OK;
    int augment = 1;
    int makeContext = 0;
    char c;
    char autoName[16];
    char buffer[32];
    char *resultName;
    Boolean makeNewContext = false;
    Tcl_DString scrptData;
    AEDesc scrptDesc = { typeNull, NULL };
    long modeFlags = kOSAModeCanInteract;
    OSAID resultID = kOSANullScript;
    OSAID contextID = kOSANullScript;
    OSAID parentID = kOSANullScript;
    OSAError osaErr = noErr;
	
    if (!(OSAComponent->componentFlags && kOSASupportsCompiling)) {
	Tcl_AppendResult(interp,
		"OSA component does not support compiling",
		(char *) NULL);
	return TCL_ERROR;
    }

    /* 
     * This signals that we should make up a name, which is the
     * default behavior:
     */
	 
    autoName[0] = '\0';
    resultName = NULL;
	
    if (argc == 2) {
	numArgs:
	Tcl_AppendResult(interp,
		"wrong # args: should be \"", argv[0], " ", argv[1],
		" ?options? code\"",(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, stops processing
	     */
			
	    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,
			"no value given for switch: ",
			argv[0], (char *) NULL);
		return TCL_ERROR;
	    }
			
	    if (c == 'c' && strcmp(argv[0] + 1, "context") == 0) {
		if (Tcl_GetBoolean(interp, argv[1], &makeContext) != TCL_OK) {
		    return TCL_ERROR;
		}
	    } else if (c == 'a' && strcmp(argv[0] + 1, "augment") == 0) {
		/*
		 * Augment the current context which implies making a context.
		 */

		if (Tcl_GetBoolean(interp, argv[1], &augment) != TCL_OK) {
		    return TCL_ERROR;
		}
		makeContext = 1;
	    } else if (c == 'n' && strcmp(argv[0] + 1, "name") == 0) {
		resultName = argv[1];
	    } else if (c == 'p' && strcmp(argv[0] + 1,"parent") == 0) {
		/*
		 * Since this implies we are compiling into a context, 
		 * set makeContext here
		 */
		if (tclOSAGetContextID(OSAComponent,
			argv[1], &parentID) != TCL_OK) {
		    Tcl_AppendResult(interp, "context not found \"",
			    argv[1], "\"", (char *) NULL);
		    return TCL_ERROR;
		}
		makeContext = 1;
	    } else {
		Tcl_AppendResult(interp, "bad option \"", argv[0],
			"\": should be -augment, -context, -name or -parent",
			 (char *) NULL);
		return TCL_ERROR;
	    }
	    argv += 2;
	    argc -= 2;
			
	} else {
	    break;
	}
    }

    /*
     * Make sure we have some data left...
     */
    if (argc == 0) {
	goto numArgs;
    }
	
    /* 
     * Now if we are making a context, see if it is a new one... 
     * There are three options here:
     * 1) There was no name provided, so we autoName it
     * 2) There was a name, then check and see if it already exists
     *  a) If yes, then makeNewContext is false
     *  b) Otherwise we are making a new context
     */

    if (makeContext) {
	modeFlags |= kOSAModeCompileIntoContext;
	if (resultName == NULL) {
	    /*
	     * Auto name the new context.
	     */
	    resultName = autoName;
	    resultID = kOSANullScript;
	    makeNewContext = true;
	} else if (tclOSAGetContextID(OSAComponent,
		resultName, &resultID) == TCL_OK) {
	    makeNewContext = false;
	} else { 
	    makeNewContext = true;
	    resultID = kOSANullScript;
	}
		
	/*
	 * Deal with the augment now...
	 */
	if (augment && !makeNewContext) {
	    modeFlags |= kOSAModeAugmentContext;
	}
    }
	
    /*
     * Ok, now we have the options, so we can compile the script data.
     */
			
    if (prepareScriptData(argc, argv, &scrptData, &scrptDesc) == TCL_ERROR) {
	Tcl_DStringResult(interp, &scrptData);
	AEDisposeDesc(&scrptDesc);
	return TCL_ERROR;
    }

    /* 
     * If we want to use a parent context, we have to make the context 
     * by hand. Note, parentID is only specified when you make a new context. 
     */
	
    if (parentID != kOSANullScript && makeNewContext) {
	AEDesc contextDesc = { typeNull, NULL };

	osaErr = OSAMakeContext(OSAComponent->theComponent,
		&contextDesc, parentID, &resultID);
	modeFlags |= kOSAModeAugmentContext;
    }
	
    osaErr = OSACompile(OSAComponent->theComponent, &scrptDesc,
	    modeFlags, &resultID);								
    if (osaErr == noErr) {
	 
	if (makeContext) {
	    /* 
	     * For the compiled context to be active, you need to run 
	     * the code that is in the context.
	     */
	    OSAID activateID;

	    osaErr = OSAExecute(OSAComponent->theComponent, resultID,
		    resultID, kOSAModeCanInteract, &activateID);
	    OSADispose(OSAComponent->theComponent, activateID);

	    if (osaErr == noErr) {
		if (makeNewContext) {
		    /*
		     * If we have compiled into a context, 
		     * this is added to the context table 
		     */
					 
		    tclOSAAddContext(OSAComponent, resultName, resultID);
		}
				
		Tcl_SetResult(interp, resultName, TCL_VOLATILE);
		tclError = TCL_OK;
	    }
	} else {
	    /*
	     * For a script, we return the script name.
	     */
	    tclOSAAddScript(OSAComponent, resultName, modeFlags, resultID);
	    Tcl_SetResult(interp, resultName, TCL_VOLATILE);
	    tclError = TCL_OK;	
	}
    }
	
    /* 
     * This catches the error either from the original compile, 
     * or from the execute in case makeContext == true
     */
	 						
    if (osaErr == errOSAScriptError) {
	OSADispose(OSAComponent->theComponent, resultID);
	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;		
    } 

    Tcl_DStringFree(&scrptData);
    AEDisposeDesc(&scrptDesc);
	
    return tclError;
}

/*
 *----------------------------------------------------------------------
 *
 * tclOSADecompileCmd --
 *
 * 	This implements the Decompile subcommand of the component command
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side Effects:
 *  	Decompiles the script, and sets interp's result to the
 *	decompiled script data.
 *
 *----------------------------------------------------------------------
 */
 		
static int 
tclOSADecompileCmd(
    Tcl_Interp * interp,
    tclOSAComponent *OSAComponent,
    int argc, 
    char **argv)
{
    AEDesc resultingSourceData = { typeChar, NULL };
    OSAID scriptID;
    Boolean isContext;
    long result;
    OSErr sysErr = noErr;
 		
    if (argc == 2) {
	Tcl_AppendResult(interp, "Wrong # of arguments, should be \"",
		argv[0], " ",argv[1], " scriptName \"", (char *) NULL );
	return TCL_ERROR;
    }
 	
    if (!(OSAComponent->componentFlags && kOSASupportsGetSource)) {
	Tcl_AppendResult(interp,
		"Error, this component does not support get source",
		(char *) NULL);
	return TCL_ERROR;
    }
 	
    if (tclOSAGetScriptID(OSAComponent, argv[2], &scriptID) == TCL_OK) {
	isContext = false;
    } else if (tclOSAGetContextID(OSAComponent, argv[2], &scriptID)
	    == TCL_OK ) {
	isContext = true;
    } else { 
	Tcl_AppendResult(interp, "Could not find script \"",
		argv[2], "\"", (char *) NULL);
	return TCL_ERROR;
    }
	
    OSAGetScriptInfo(OSAComponent->theComponent, scriptID,
	    kOSACanGetSource, &result);
						
    sysErr = OSAGetSource(OSAComponent->theComponent, 
	    scriptID, typeChar, &resultingSourceData);
	
    if (sysErr == noErr) {
	Tcl_DString theResult;
	Tcl_DStringInit(&theResult);

	Tcl_DStringAppend(&theResult, *resultingSourceData.dataHandle,
		GetHandleSize(resultingSourceData.dataHandle));
	Tcl_DStringResult(interp, &theResult);
	AEDisposeDesc(&resultingSourceData);
	return TCL_OK;
    } else {
	Tcl_AppendResult(interp, "Error getting source data", (char *) NULL);
	AEDisposeDesc(&resultingSourceData);
	return TCL_ERROR;
    }
}			
	 	
/*
 *----------------------------------------------------------------------
 *
 * tclOSADeleteCmd --
 *
 *	This implements the Delete subcommand of the Component command.
 *
 * Results:
 *	A standard Tcl result.