tclmacosa.c

linux系统下的音频通信

     * Set the context to the global context for this component,
     * as a default
     */
    if (tclOSAGetContextID(OSAComponent, "global", &contextID) != TCL_OK) {
	Tcl_AppendResult(interp,
		"Could not find the global context for component ",
		OSAComponent->theName, (char *) NULL );
	return TCL_ERROR;
    }

    /*
     * Now parse the argument list for switches
     */
    argv += 2;
    argc -= 2;
	
    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 (argc == 1) {
		    Tcl_AppendResult(interp,
			    "Error - no context provided for the -context switch",
			    (char *) NULL);
		    return TCL_ERROR;
		} else 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],
			" for ", componentName,
			" should be \"-context\"", (char *) NULL);
		return TCL_ERROR;
	    }
	    argv += 2;
	    argc -= 2;
	} else {
	    break;
	}
    }
	
    if (tclOSAGetScriptID(OSAComponent, argv[0], &scriptID) != TCL_OK) {
	if (tclOSAGetContextID(OSAComponent, argv[0], &scriptID) != TCL_OK) {
	    Tcl_AppendResult(interp, "Could not find script \"",
		    argv[2], "\"", (char *) NULL);
	    return TCL_ERROR;
	}
    }
	
    sysErr = OSAExecute(OSAComponent->theComponent,
	    scriptID, contextID, modeFlags, &resultID);
							
    if (sysErr == errOSAScriptError) {
	tclOSAASError(interp, OSAComponent->theComponent, (char *) NULL);
	tclError = TCL_ERROR;
    } else if (sysErr != noErr) {
	char buffer[32];
	sprintf(buffer, "Error #%6.6d encountered in run", sysErr);
	Tcl_SetResult(interp, buffer, TCL_VOLATILE);
	tclError = TCL_ERROR;
    } else {
	tclOSAResultFromID(interp, OSAComponent->theComponent, resultID );
    }
    OSADispose(OSAComponent->theComponent, resultID);

    return tclError;		
}

/*
 *----------------------------------------------------------------------
 *
 * tclOSAStoreCmd --
 *
 *	This implements the store 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 
tclOSAStoreCmd(
    Tcl_Interp *interp,
    tclOSAComponent *OSAComponent,
    int argc,
    char **argv)
{
    int tclError = TCL_OK, resID = 128;
    char c, *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;
		
    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 != 2) {
	Tcl_AppendResult(interp, "Error, wrong # of arguments, should be ",
		argv[0], " ", argv[1], "?option flag? scriptName fileName",
		(char *) NULL);
	return TCL_ERROR;
    }
	
    if (tclOSAStore(interp, OSAComponent, resName, resID,
	    argv[0], argv[1]) != TCL_OK) {
	Tcl_AppendResult(interp, "Error in load command", (char *) NULL);
	return TCL_ERROR;
    } else {
	Tcl_ResetResult(interp);
	tclError = TCL_OK;
    }
    
    return tclError;
}

/*
 *----------------------------------------------------------------------
 *
 * tclOSAMakeNewComponent --
 *
 *	Makes a command cmdName to represent a new connection to the
 *	OSA component with componentSubType scriptSubtype.
 *
 * Results: 
 *	Returns the tclOSAComponent structure for the connection.
 *
 * Side Effects: 
 *	Adds a new element to the component table.  If there is an
 *	error, then the result of the Tcl interpreter interp is set
 *	to an appropriate error message.
 *
 *----------------------------------------------------------------------
 */
 
tclOSAComponent *
tclOSAMakeNewComponent(
    Tcl_Interp *interp,
    char *cmdName,
    char *languageName, 
    OSType scriptSubtype,
    long componentFlags) 
{
    char buffer[32];
    AEDesc resultingName = {typeNull, NULL};
    AEDesc nullDesc = {typeNull, NULL };
    OSAID globalContext;
    char global[] = "global";
    int nbytes;
    ComponentDescription requestedComponent = {
	kOSAComponentType,
	(OSType) 0,
	(OSType) 0,
	(long int) 0,
	(long int) 0
    };
    Tcl_HashTable *ComponentTable;
    Component foundComponent = NULL;
    OSAActiveUPP myActiveProcUPP;
			
    tclOSAComponent *newComponent;
    Tcl_HashEntry *hashEntry;
    int newPtr;
	
    requestedComponent.componentSubType = scriptSubtype;
    nbytes = sizeof(tclOSAComponent);
    newComponent = (tclOSAComponent *) ckalloc(sizeof(tclOSAComponent));
    if (newComponent == NULL) {
	goto CleanUp;
    }
	
    foundComponent = FindNextComponent(0, &requestedComponent);
    if (foundComponent == 0) {
	Tcl_AppendResult(interp,
		"Could not find component of requested type", (char *) NULL);
	goto CleanUp;
    } 
	
    newComponent->theComponent = OpenComponent(foundComponent); 
	
    if (newComponent->theComponent == NULL) {
	Tcl_AppendResult(interp,
		"Could not open component of the requested type",
		(char *) NULL);
	goto CleanUp;
    }
							
    newComponent->languageName = (char *) ckalloc(strlen(languageName) + 1);
    strcpy(newComponent->languageName,languageName);
	
    newComponent->componentFlags = componentFlags;
	
    newComponent->theInterp = interp;
	
    Tcl_InitHashTable(&newComponent->contextTable, TCL_STRING_KEYS);
    Tcl_InitHashTable(&newComponent->scriptTable, TCL_STRING_KEYS);
		
    if (tclOSAMakeContext(newComponent, global, &globalContext) != TCL_OK) {
	sprintf(buffer, "%-6.6d", globalContext);
	Tcl_AppendResult(interp, "Error ", buffer, " making ", global,
		" context.", (char *) NULL);
	goto CleanUp;
    }
    
    newComponent->languageID = scriptSubtype;
	
    newComponent->theName = (char *) ckalloc(strlen(cmdName) + 1 );
    strcpy(newComponent->theName, cmdName);

    Tcl_CreateCommand(interp, newComponent->theName, Tcl_OSAComponentCmd,
	    (ClientData) newComponent, tclOSAClose);
					
    /*
     * Register the new component with the component table
     */ 

    ComponentTable = (Tcl_HashTable *) Tcl_GetAssocData(interp,
	    "OSAScript_CompTable", (Tcl_InterpDeleteProc **) NULL);
	
    if (ComponentTable == NULL) {
	Tcl_AppendResult(interp, "Error, could not get the Component Table",
		" from the Associated data.", (char *) NULL);
	return (tclOSAComponent *) NULL;
    }
	
    hashEntry = Tcl_CreateHashEntry(ComponentTable,
	    newComponent->theName, &newPtr);	
    Tcl_SetHashValue(hashEntry, (ClientData) newComponent);

    /*
     * Set the active proc to call Tcl_DoOneEvent() while idle
     */
    if (OSAGetActiveProc(newComponent->theComponent,
	    &newComponent->defActiveProc, &newComponent->defRefCon) != noErr ) {
    	/* TODO -- clean up here... */
    }

    myActiveProcUPP = NewOSAActiveProc(TclOSAActiveProc);
    OSASetActiveProc(newComponent->theComponent,
	    myActiveProcUPP, (long) newComponent);
    return newComponent;
	
    CleanUp:
	
    ckfree((char *) newComponent);
    return (tclOSAComponent *) NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * tclOSAClose --
 *
 *	This procedure closes the connection to an OSA component, and 
 *	deletes all the script and context data associated with it.
 *	It is the command deletion callback for the component's command.
 *
 * Results:
 *	None
 *
 * Side effects:
 *	Closes the connection, and releases all the script data.
 *
 *----------------------------------------------------------------------
 */

void 
tclOSAClose(
    ClientData clientData) 
{
    tclOSAComponent *theComponent = (tclOSAComponent *) clientData;
    Tcl_HashEntry *hashEntry;
    Tcl_HashSearch search;
    tclOSAScript *theScript;
    Tcl_HashTable *ComponentTable;
	
    /* 
     * Delete the context and script tables 
     * the memory for the language name, and
     * the hash entry.
     */
	
    for (hashEntry = Tcl_FirstHashEntry(&theComponent->scriptTable, &search);
	 hashEntry != NULL;
	 hashEntry = Tcl_NextHashEntry(&search)) {

	theScript = (tclOSAScript *) Tcl_GetHashValue(hashEntry);
	OSADispose(theComponent->theComponent, theScript->scriptID);	
	ckfree((char *) theScript);
	Tcl_DeleteHashEntry(hashEntry);
    }
	
    for (hashEntry = Tcl_FirstHashEntry(&theComponent->contextTable, &search);
	 hashEntry != NULL;
	 hashEntry = Tcl_NextHashEntry(&search)) {

	Tcl_DeleteHashEntry(hashEntry);
    }
	
    ckfree(theComponent->languageName);
    ckfree(theComponent->theName);
	
    /*
     * Finally close the component
     */
	
    CloseComponent(theComponent->theComponent);
	
    ComponentTable = (Tcl_HashTable *)
	Tcl_GetAssocData(theComponent->theInterp,
		"OSAScript_CompTable", (Tcl_InterpDeleteProc **) NULL);
	
    if (ComponentTable == NULL) {
	panic("Error, could not get the Component Table from the Associated data.");
    }
	
    hashEntry = Tcl_FindHashEntry(ComponentTable, theComponent->theName);
    if (hashEntry != NULL) {
	Tcl_DeleteHashEntry(hashEntry);
    }
    
    ckfree((char *) theComponent);
}

/*
 *----------------------------------------------------------------------
 *
 * tclOSAGetContextID  --
 *
 *	This returns the context ID, given the component name.
 *
 * Results:
 *	A context ID
 *
 * Side effects:
 *	None
 *
 *----------------------------------------------------------------------
 */

static int 
tclOSAGetContextID(
    tclOSAComponent *theComponent, 
    char *contextName, 
    OSAID *theContext)
{
    Tcl_HashEntry *hashEntry;
    tclOSAContext *contextStruct;
	
    if ((hashEntry = Tcl_FindHashEntry(&theComponent->contextTable,
	    contextName)) == NULL ) {			
	return TCL_ERROR;
    } else {
	contextStruct = (tclOSAContext *) Tcl_GetHashValue(hashEntry);
	*theContext = contextStruct->contextID;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * tclOSAAddContext  --
 *
 *	This adds the context ID, with the name contextName.  If the
 *	name is passed in as a NULL string, space is malloc'ed for the
 *	string and a new name is made up, if the string is empty, you
 *	must have allocated enough space ( 24 characters is fine) for
 *	the name, which is made up and passed out.
 *
 * Results:
 *	Nothing
 *
 * Side effects:
 *	Adds the script context to the component's context table.
 *
 *----------------------------------------------------------------------
 */

static void 
tclOSAAddContext(
    tclOSAComponent *theComponent, 
    char *contextName,
    const OSAID theContext)
{
    static unsigned short contextIndex = 0;
    tclOSAContext *contextStruct;
    Tcl_HashEntry *hashEntry;
    int newPtr;

    if (contextName == NULL) {
	contextName = ckalloc(24 * sizeof(char));
	sprintf(contextName, "OSAContext%d", contextIndex++);
    } else if (*contextName == '\0') {
	sprintf(contextName, "OSAContext%d", contextIndex++);