Ejemplo n.º 1
0
static int
ExportTif(Tcl_Interp *interp, unsigned int index, Blt_Chain chain, int objc, 
	  Tcl_Obj *const *objv)
{
    Blt_DBuffer dbuffer;
    Blt_Picture picture;
    TifExportSwitches switches;
    int result;

    /* Default export switch settings. */
    memset(&switches, 0, sizeof(switches));
    switches.index = index;
    if (Blt_ParseSwitches(interp, exportSwitches, objc - 3, objv + 3, 
	&switches, BLT_SWITCH_DEFAULTS) < 0) {
	Blt_FreeSwitches(exportSwitches, (char *)&switches, 0);
	return TCL_ERROR;
    }
    if ((switches.dataObjPtr != NULL) && (switches.fileObjPtr != NULL)) {
	Tcl_AppendResult(interp, "more than one export destination: ",
		"use only one -file or -data flag.", (char *)NULL);
	Blt_FreeSwitches(exportSwitches, (char *)&switches, 0);
	return TCL_ERROR;
    }
    picture = Blt_GetNthPicture(chain, switches.index);
    if (picture == NULL) {
	Tcl_AppendResult(interp, "no picture at index ", 
		Blt_Itoa(switches.index), (char *)NULL);
	Blt_FreeSwitches(exportSwitches, (char *)&switches, 0);
	return TCL_ERROR;
    }
    dbuffer = Blt_DBuffer_Create();
    result = PictureToTif(interp, picture, dbuffer, &switches);
    if (result != TCL_OK) {
	Tcl_AppendResult(interp, "can't convert \"", 
		Tcl_GetString(objv[2]), "\"", (char *)NULL);
	goto error;
    }

    /* Write the TIF data to file or convert it to a base64 string. */
    if (switches.fileObjPtr != NULL) {
	char *fileName;

	fileName = Tcl_GetString(switches.fileObjPtr);
	result = Blt_DBuffer_SaveFile(interp, fileName, dbuffer);
    } else if (switches.dataObjPtr != NULL) {
	Tcl_Obj *objPtr;

	objPtr = Tcl_ObjSetVar2(interp, switches.dataObjPtr, NULL, 
		Blt_DBuffer_ByteArrayObj(dbuffer), 0);
	result = (objPtr == NULL) ? TCL_ERROR : TCL_OK;
    } else {
	char *string;

	string = Blt_DBuffer_EncodeBase64(interp, dbuffer);
	if (string != NULL) {
	    Tcl_Obj *objPtr;

	    objPtr = Tcl_NewStringObj(string, -1);
	    Blt_Free(string);
	    Tcl_SetObjResult(interp, objPtr);
	}
	result = (string == NULL) ? TCL_ERROR : TCL_OK;
    }
 error:
    Blt_FreeSwitches(exportSwitches, (char *)&switches, 0);
    Blt_DBuffer_Destroy(dbuffer);
    return result;
}
Ejemplo n.º 2
0
int
Extension::foreachCmd (
    ClientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    if (objc != 4) {
	Tcl_WrongNumArgs(
            interp, 1, objv, "varList collectionHandle script");
	return TCL_ERROR;
    }

    Tcl_Obj *pVarList = objv[1];
    Tcl_Obj *pBody = objv[3];

    Reference *pCollection = referenceHandles.find(interp, objv[2]);
    if (pCollection == 0) {
        const char *arg = Tcl_GetStringFromObj(objv[2], 0);
        Tcl_AppendResult(
            interp, "invalid interface pointer handle ", arg, 0);
        return TCL_ERROR;
    }

    // Collections should implement a _NewEnum method which returns an object
    // that enumerates the elements.
    HRESULT hr;
    PositionalArguments arguments;
    _variant_t varResult;

    hr = pCollection->invoke(
        DISPID_NEWENUM,
        DISPATCH_METHOD | DISPATCH_PROPERTYGET,
        arguments,
        &varResult);
    if (FAILED(hr) || V_VT(&varResult) != VT_UNKNOWN) {
	Tcl_AppendResult(interp, "object is not a collection", NULL);
	return TCL_ERROR;
    }
    IUnknownPtr pUnk(V_UNKNOWN(&varResult));
    
    // Get a specific kind of enumeration.
    IEnumVARIANTPtr pEnumVARIANT;
    IEnumUnknownPtr pEnumUnknown;
    enum EnumKind { ENUM_VARIANT, ENUM_UNKNOWN };
    EnumKind enumKind;

    hr = pUnk->QueryInterface(
        IID_IEnumVARIANT, reinterpret_cast<void **>(&pEnumVARIANT));
    if (SUCCEEDED(hr)) {
        enumKind = ENUM_VARIANT;
    } else {
        hr = pUnk->QueryInterface(
            IID_IEnumUnknown, reinterpret_cast<void **>(&pEnumUnknown));
        if (SUCCEEDED(hr)) {
	    enumKind = ENUM_UNKNOWN;
        }
    }
    
    if (FAILED(hr)) {
        Tcl_AppendResult(interp,
            "Unknown enumerator type: not IEnumVARIANT or IEnumUnknown", NULL);
        return TCL_ERROR;
    }

    int completionCode;

    int varc;				// number of loop variables
    completionCode = Tcl_ListObjLength(interp, pVarList, &varc);
    if (completionCode != TCL_OK) {
        return TCL_ERROR;
    }
    if (varc < 1) {
	Tcl_AppendResult(interp, "foreach varlist is empty", NULL);
	return TCL_ERROR;
    }

    while (true) {
        // If the variable list has been converted to another kind of Tcl
        // object, convert it back to a list and refetch the pointer to its
        // element array.
        Tcl_Obj **varv;
        completionCode =
            Tcl_ListObjGetElements(interp, pVarList, &varc, &varv);
        if (completionCode != TCL_OK) {
            return TCL_ERROR;
        }

        // Assign values to all loop variables.
        int v = 0;
	for (;  v < varc;  ++v) {
            TclObject value;
	    ULONG count;

	    switch (enumKind) {
	    case ENUM_VARIANT:
		{
		    _variant_t elementVar;
		    hr = pEnumVARIANT->Next(1, &elementVar, &count);
		    if (hr == S_OK && count > 0) {
			value = TclObject(&elementVar, Type::variant(), interp, 0);
		    }
		}
		break;

	    case ENUM_UNKNOWN:
		{
		    IUnknown *pElement;
		    hr = pEnumUnknown->Next(1, &pElement, &count);
		    if (hr == S_OK && count > 0) {
			value = referenceHandles.newObj(
			    interp, Reference::newReference(pElement));
		    }
		}
		break;
	    }

	    if (FAILED(hr)) {
		_com_issue_error(hr);
	    }
	    if (hr != S_OK || count == 0) {
		break;
	    }

	    Tcl_Obj *varValuePtr = Tcl_ObjSetVar2(
                interp, varv[v], NULL, value, TCL_LEAVE_ERR_MSG);
	    if (varValuePtr == NULL) {
		return TCL_ERROR;
	    }
	}

        if (v == 0) {
            completionCode = TCL_OK;
            break;
        }

        if (v < varc) {
            TclObject empty;

            for (; v < varc;  ++v) {
	        Tcl_Obj *varValuePtr = Tcl_ObjSetVar2(
                    interp, varv[v], NULL, empty, TCL_LEAVE_ERR_MSG);
	        if (varValuePtr == NULL) {
		    return TCL_ERROR;
	        }
            }
        }

        // Execute the script body.
        completionCode =
#if TCL_MINOR_VERSION >= 1
            Tcl_EvalObjEx(interp, pBody, 0);
#else
            Tcl_EvalObj(interp, pBody);
#endif

        if (completionCode == TCL_CONTINUE) {
            // do nothing
        } else if (completionCode == TCL_BREAK) {
            completionCode = TCL_OK;
            break;
        } else if (completionCode == TCL_ERROR) {
	    std::ostringstream oss;
            oss << "\n    (\"foreach\" body line %d)" << interp->errorLine;
            Tcl_AddObjErrorInfo(
                interp, const_cast<char *>(oss.str().c_str()), -1);
            break;
        } else if (completionCode != TCL_OK) {
            break;
        }
    }

    if (completionCode == TCL_OK) {
	Tcl_ResetResult(interp);
    }
    return completionCode;
}