static int cget( Tcl_Interp *interp, SpinButtonParams *para, GnoclOption options[], int idx ) { GtkAdjustment *adjust = gtk_spin_button_get_adjustment( para->spinButton ); Tcl_Obj *obj = NULL; if( idx == variableIdx ) obj = Tcl_NewStringObj( para->variable, -1 ); else if( idx == onValueChangedIdx ) { obj = Tcl_NewStringObj( para->onValueChanged ? para->onValueChanged : "", -1 ); } else if( idx == lowerIdx ) obj = Tcl_NewDoubleObj( adjust->lower ); else if( idx == upperIdx ) obj = Tcl_NewDoubleObj( adjust->upper ); else if( idx == stepIncIdx ) obj = Tcl_NewDoubleObj( adjust->step_increment ); else if( idx == pageIncIdx ) obj = Tcl_NewDoubleObj( adjust->page_increment ); else if( idx == valueIdx ) obj = getObjValue( para->spinButton ); if( obj != NULL ) { Tcl_SetObjResult( interp, obj ); return TCL_OK; } return gnoclCgetNotImplemented( interp, options + idx ); }
void TclTextInterp::mouse_pos_cb(float x, float y, int buttondown) { Tcl_Obj *poslist = Tcl_NewListObj(0, NULL); Tcl_ListObjAppendElement(interp, poslist, Tcl_NewDoubleObj(x)); Tcl_ListObjAppendElement(interp, poslist, Tcl_NewDoubleObj(y)); Tcl_ListObjAppendElement(interp, poslist, Tcl_NewIntObj(buttondown)); Tcl_Obj *varname = Tcl_NewStringObj("vmd_mouse_pos", -1); Tcl_ObjSetVar2(interp, varname, NULL, poslist, TCL_LEAVE_ERR_MSG | TCL_GLOBAL_ONLY); }
/* helper function: create tcl list from complex number */ static Tcl_Obj *make_list_cpx(Tcl_Interp *interp, Tcl_Obj *list, kiss_fft_cpx *num) { Tcl_Obj *cmplx; cmplx = Tcl_NewListObj(0, NULL); Tcl_ListObjAppendElement(interp, cmplx, Tcl_NewDoubleObj(num->r)); Tcl_ListObjAppendElement(interp, cmplx, Tcl_NewDoubleObj(num->i)); Tcl_ListObjAppendElement(interp, list, cmplx); return list; }
static int windowToCanvas( Tcl_Interp *interp, int objc, Tcl_Obj * const objv[], CanvasParams *params, int reverse ) { Tcl_Obj *resList; int noCoords, n; if( objc != 3 ) { Tcl_WrongNumArgs( interp, 2, objv, /* canvas windowToCanvas */ "list-of-coordinates ?option val ...?" ); return TCL_ERROR; } /* TODO -only [xy]: only x, y coordinates -pairs [true|false]: list of coordinate pairs (lists) */ if( Tcl_ListObjLength( interp, objv[2], &noCoords ) != TCL_OK || ( noCoords % 2 ) ) { Tcl_SetResult( interp, "size of list-of-coordinates must be even", TCL_STATIC ); return TCL_ERROR; } resList = Tcl_NewListObj( 0, NULL ); for( n = 0; n < noCoords; n += 2 ) { Tcl_Obj *tp; double xw, yw, x, y; int ret = Tcl_ListObjIndex( interp, objv[2], n, &tp ); if( ret == TCL_OK ) ret = Tcl_GetDoubleFromObj( interp, tp, &xw ); if( ret == TCL_OK ) ret = Tcl_ListObjIndex( interp, objv[2], n + 1, &tp ); if( ret == TCL_OK ) ret = Tcl_GetDoubleFromObj( interp, tp, &yw ); if( ret != TCL_OK ) { Tcl_DecrRefCount( resList ); /* FIXME: is this correct? */ return TCL_ERROR; } if( reverse ) gnome_canvas_world_to_window( params->canvas, xw, yw, &x, &y ); else gnome_canvas_window_to_world( params->canvas, xw, yw, &x, &y ); Tcl_ListObjAppendElement( interp, resList, Tcl_NewDoubleObj( x ) ); Tcl_ListObjAppendElement( interp, resList, Tcl_NewDoubleObj( y ) ); } Tcl_SetObjResult( interp, resList ); return TCL_OK; }
static int BitmapCoords( Tcl_Interp *interp, /* Used for error reporting. */ Tk_Canvas canvas, /* Canvas containing item. */ Tk_Item *itemPtr, /* Item whose coordinates are to be read or * modified. */ int objc, /* Number of coordinates supplied in objv. */ Tcl_Obj *const objv[]) /* Array of coordinates: x1, y1, x2, y2, ... */ { BitmapItem *bmapPtr = (BitmapItem *) itemPtr; if (objc == 0) { Tcl_Obj *obj = Tcl_NewObj(); Tcl_Obj *subobj = Tcl_NewDoubleObj(bmapPtr->x); Tcl_ListObjAppendElement(interp, obj, subobj); subobj = Tcl_NewDoubleObj(bmapPtr->y); Tcl_ListObjAppendElement(interp, obj, subobj); Tcl_SetObjResult(interp, obj); } else if (objc < 3) { if (objc == 1) { if (Tcl_ListObjGetElements(interp, objv[0], &objc, (Tcl_Obj ***) &objv) != TCL_OK) { return TCL_ERROR; } else if (objc != 2) { char buf[64 + TCL_INTEGER_SPACE]; sprintf(buf, "wrong # coordinates: expected 2, got %d", objc); Tcl_SetResult(interp, buf, TCL_VOLATILE); return TCL_ERROR; } } if ((Tk_CanvasGetCoordFromObj(interp, canvas, objv[0], &bmapPtr->x) != TCL_OK) || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[1], &bmapPtr->y) != TCL_OK)) { return TCL_ERROR; } ComputeBitmapBbox(canvas, bmapPtr); } else { char buf[64 + TCL_INTEGER_SPACE]; sprintf(buf, "wrong # coordinates: expected 0 or 2, got %d", objc); Tcl_SetResult(interp, buf, TCL_VOLATILE); return TCL_ERROR; } return TCL_OK; }
/* $sb fraction $x $y -- * Returns a real number between 0 and 1 indicating where the * point given by x and y lies in the trough area of the scrollbar. */ static int ScrollbarFractionCommand( Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], void *recordPtr) { Scrollbar *sb = recordPtr; Ttk_Box b = sb->scrollbar.troughBox; int minSize = sb->scrollbar.minSize; double x, y; double fraction = 0.0; if (objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "x y"); return TCL_ERROR; } if (Tcl_GetDoubleFromObj(interp, objv[2], &x) != TCL_OK || Tcl_GetDoubleFromObj(interp, objv[3], &y) != TCL_OK) { return TCL_ERROR; } fraction = 0.0; if (sb->scrollbar.orient == TTK_ORIENT_VERTICAL) { if (b.height > minSize) { fraction = (double)(y - b.y) / (double)(b.height - minSize); } } else { if (b.width > minSize) { fraction = (double)(x - b.x) / (double)(b.width - minSize); } } Tcl_SetObjResult(interp, Tcl_NewDoubleObj(fraction)); return TCL_OK; }
/* $scale get ?x y? -- * Returns the current value of the scale widget, or if $x and * $y are specified, the value represented by point @x,y. */ static int ScaleGetCommand( void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Scale *scalePtr = recordPtr; int x, y, r = TCL_OK; double value = 0; if ((objc != 2) && (objc != 4)) { Tcl_WrongNumArgs(interp, 1, objv, "get ?x y?"); return TCL_ERROR; } if (objc == 2) { Tcl_SetObjResult(interp, scalePtr->scale.valueObj); } else { r = Tcl_GetIntFromObj(interp, objv[2], &x); if (r == TCL_OK) r = Tcl_GetIntFromObj(interp, objv[3], &y); if (r == TCL_OK) { value = PointToValue(scalePtr, x, y); Tcl_SetObjResult(interp, Tcl_NewDoubleObj(value)); } } return r; }
static Tcl_Obj* getObject(const QVariant& v) { Tcl_Obj* value; QString text; switch (v.type()) { case QVariant::Int: case QVariant::UInt: value = Tcl_NewLongObj(v.toInt()); break; case QVariant::Bool: value = Tcl_NewBooleanObj(v.toBool()); break; case QVariant::Double: value = Tcl_NewDoubleObj(v.toDouble()); break; case QVariant::Date: text = v.toDate().toString(Qt::ISODate); value = Tcl_NewStringObj(text.utf8(), text.utf8().length()); break; default: text = v.toString(); value = Tcl_NewStringObj(text.utf8(), text.utf8().length()); break; } Tcl_IncrRefCount(value); return value; }
/* create a constant double obj */ Tcl_Obj* TSP_Util_const_double(double d) { Tcl_Obj* constObj; constObj = Tcl_NewDoubleObj(d); Tcl_IncrRefCount(constObj); return constObj; }
static int _get(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj* const *objv) { if (argc != 2) return fw_error_obj(interp, Tcl_ObjPrintf("usage: %s get", Tcl_GetString(objv[0]))); _t *data = (_t *)clientData; Tcl_SetObjResult(interp, Tcl_NewDoubleObj(crealf(data->r.r))); return TCL_OK; }
//----------------------------------------------------------------------- extern "C" int If_SetReal(const char *name, Real val) { if (!theInterp) return IF_ERROR; #if 0 // unfortunately Tcl_EvalObjv was not available under Tcl 8.0 Tcl_Obj *objv[2]; objv[0] = Tcl_NewStringObj((char *)name, -1); objv[1] = Tcl_NewDoubleObj(val); int retcode; retcode = Tcl_EvalObjv(theInterp, 2, objv, 0); Tcl_DecrRefCount(objv[0]); Tcl_DecrRefCount(objv[1]); if (retcode != TCL_OK) return IF_ERROR; #else char valstr[50]; sprintf(valstr, "%g", val); if (Tcl_VarEval(theInterp, (char *)name, " ", valstr, NULL) != TCL_OK) return IF_ERROR; #endif Tcl_ResetResult(theInterp); // reset result as val was accepted return IF_OK; }
/* $sb delta $dx $dy -- * Returns the percentage change corresponding to a mouse movement * of $dx, $dy. */ static int ScrollbarDeltaCommand( Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], void *recordPtr) { Scrollbar *sb = recordPtr; double dx, dy; double delta = 0.0; if (objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "dx dy"); return TCL_ERROR; } if (Tcl_GetDoubleFromObj(interp, objv[2], &dx) != TCL_OK || Tcl_GetDoubleFromObj(interp, objv[3], &dy) != TCL_OK) { return TCL_ERROR; } delta = 0.0; if (sb->scrollbar.orient == TTK_ORIENT_VERTICAL) { int size = sb->scrollbar.troughBox.height - sb->scrollbar.minSize; if (size > 0) { delta = (double)dy / (double)size; } } else { int size = sb->scrollbar.troughBox.width - sb->scrollbar.minSize; if (size > 0) { delta = (double)dx / (double)size; } } Tcl_SetObjResult(interp, Tcl_NewDoubleObj(delta)); return TCL_OK; }
int bn_cmd_noise_perlin(ClientData clientData, Tcl_Interp *interp, int argc, char **argv) { point_t pt; double v; if (argc != 4) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " X Y Z \"", NULL); return TCL_ERROR; } pt[X] = atof(argv[1]); pt[Y] = atof(argv[2]); pt[Z] = atof(argv[3]); v = bn_noise_perlin( pt ); Tcl_SetObjResult( interp, Tcl_NewDoubleObj(v) ); return TCL_OK; }
/**** * implementation of shape2list (from RFshape creates a list { {a p} {a p} ... } ****/ int tclShape2List(ClientData data,Tcl_Interp* interp,int argc, char *argv[]) { Tcl_Obj *lptr1, *lptr2; Tcl_Obj *elemptr[2]; int i, slot; if (argc != 2) return TclError(interp,"Usage: <list> shape2list <RFshape>"); if (Tcl_GetInt(interp,argv[1],&slot) == TCL_ERROR) return TclError(interp,"shape2list: argument must be integer <RFshape>"); /* check for RFshape existence */ if (!RFshapes[slot]) return TclError(interp,"shape2list: trying to acces non-existing RFshape"); /* create list objects */ lptr1 = Tcl_NewListObj(0,NULL); if (!lptr1) return TclError(interp,"shape2list unable to create outer list"); for (i=1; i<=RFshapes_len(slot); i++) { elemptr[0] = Tcl_NewDoubleObj(RFshapes[slot][i].ampl); if (!elemptr[0]) { /* Tcl_Free(lptr2); Tcl_Free(lptr1); */ return TclError(interp,"shape2list unable to create double from RFshape amplitude element %d",i); } elemptr[1] = Tcl_NewDoubleObj(RFshapes[slot][i].phase); if (!elemptr[1]) { /* Tcl_Free(lptr2); Tcl_Free(lptr1); */ return TclError(interp,"shape2list unable to create double from RFshape amplitude element %d",i); } lptr2 = Tcl_NewListObj(2,elemptr); if (!lptr2) return TclError(interp,"shape2list unable to create inner list"); if ( Tcl_ListObjAppendElement(interp,lptr1,lptr2) != TCL_OK ) { /* Tcl_Free(lptr2); Tcl_Free(lptr1); */ return TclError(interp,"shape2list unable to append element %d to oute list",i); } } Tcl_SetObjResult(interp,lptr1); return TCL_OK; }
static int TextCoords( Tcl_Interp *interp, /* Used for error reporting. */ Tk_Canvas canvas, /* Canvas containing item. */ Tk_Item *itemPtr, /* Item whose coordinates are to be read or * modified. */ int objc, /* Number of coordinates supplied in objv. */ Tcl_Obj *const objv[]) /* Array of coordinates: x1, y1, x2, y2, ... */ { TextItem *textPtr = (TextItem *) itemPtr; if (objc == 0) { Tcl_Obj *obj = Tcl_NewObj(); Tcl_Obj *subobj = Tcl_NewDoubleObj(textPtr->x); Tcl_ListObjAppendElement(interp, obj, subobj); subobj = Tcl_NewDoubleObj(textPtr->y); Tcl_ListObjAppendElement(interp, obj, subobj); Tcl_SetObjResult(interp, obj); return TCL_OK; } else if (objc > 2) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "wrong # coordinates: expected 0 or 2, got %d", objc)); Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "TEXT", NULL); return TCL_ERROR; } if (objc == 1) { if (Tcl_ListObjGetElements(interp, objv[0], &objc, (Tcl_Obj ***) &objv) != TCL_OK) { return TCL_ERROR; } else if (objc != 2) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "wrong # coordinates: expected 2, got %d", objc)); Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "TEXT", NULL); return TCL_ERROR; } } if ((Tk_CanvasGetCoordFromObj(interp, canvas, objv[0], &textPtr->x) != TCL_OK) || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[1], &textPtr->y) != TCL_OK)) { return TCL_ERROR; } ComputeTextBbox(canvas, textPtr); return TCL_OK; }
int BasicGFunEvaluator::setTclRandomVariables(const Vector &x) { char theIndex[80]; double xval; RandomVariable *theRV; // Set values of random variables in the Tcl intepreter int nrv = theReliabilityDomain->getNumberOfRandomVariables(); int lsf = theReliabilityDomain->getTagOfActiveLimitStateFunction(); for (int i = 0; i < nrv; i++) { theRV = theReliabilityDomain->getRandomVariablePtrFromIndex(i); int rvTag = theRV->getTag(); xval = x(i); // put in x(1) format sprintf(theIndex,"%d",rvTag); if (Tcl_SetVar2Ex(theTclInterp,"xrv",theIndex,Tcl_NewDoubleObj(xval),TCL_LEAVE_ERR_MSG) == NULL) { opserr << "ERROR GFunEvaluator -- error in setTclRandomVariables xrv" << endln; opserr << theTclInterp->result << endln; return -1; } // put in x(1,lsfTag) format (useful for reporting design point) sprintf(theIndex,"%d,%d",rvTag,lsf); if (Tcl_SetVar2Ex(theTclInterp,"xrv",theIndex,Tcl_NewDoubleObj(xval),TCL_LEAVE_ERR_MSG) == NULL) { opserr << "ERROR GFunEvaluator -- error in setTclRandomVariables xrv" << endln; opserr << theTclInterp->result << endln; return -1; } // for legacy reasons, also put random variables in x_1 format sprintf(theIndex,"x_%d",rvTag); if (Tcl_SetVar2Ex(theTclInterp,theIndex,NULL,Tcl_NewDoubleObj(xval),TCL_LEAVE_ERR_MSG) == NULL) { opserr << "ERROR GFunEvaluator -- error in setTclRandomVariables x" << endln; opserr << theTclInterp->result << endln; return -1; } } return 0; }
static int ImageCoords( Tcl_Interp *interp, /* Used for error reporting. */ Tk_Canvas canvas, /* Canvas containing item. */ Tk_Item *itemPtr, /* Item whose coordinates are to be read or * modified. */ int objc, /* Number of coordinates supplied in objv. */ Tcl_Obj *const objv[]) /* Array of coordinates: x1, y1, x2, y2, ... */ { ImageItem *imgPtr = (ImageItem *) itemPtr; if (objc == 0) { Tcl_Obj *objs[2]; objs[0] = Tcl_NewDoubleObj(imgPtr->x); objs[1] = Tcl_NewDoubleObj(imgPtr->y); Tcl_SetObjResult(interp, Tcl_NewListObj(2, objs)); } else if (objc < 3) { if (objc==1) { if (Tcl_ListObjGetElements(interp, objv[0], &objc, (Tcl_Obj ***) &objv) != TCL_OK) { return TCL_ERROR; } else if (objc != 2) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "wrong # coordinates: expected 2, got %d", objc)); Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "IMAGE", NULL); return TCL_ERROR; } } if ((Tk_CanvasGetCoordFromObj(interp, canvas, objv[0], &imgPtr->x) != TCL_OK) || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[1], &imgPtr->y) != TCL_OK)) { return TCL_ERROR; } ComputeImageBbox(canvas, imgPtr); } else { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "wrong # coordinates: expected 0 or 2, got %d", objc)); Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS", "IMAGE", NULL); return TCL_ERROR; } return TCL_OK; }
int NS(ReadF) (NS_ARGS) { SETUP_mqctx MQ_FLT val; CHECK_NOARGS ErrorMqToTclWithCheck(MqReadF(mqctx, &val)); Tcl_SetObjResult(interp, Tcl_NewDoubleObj(val)); RETURN_TCL }
Tcl_Obj* TclUtils::toListOfDouble(Tcl_Interp *interp, const std::vector<double>& v) { Tcl_Obj *ret = Tcl_NewListObj(0, NULL); for (std::vector<double>::const_iterator i = v.begin(), end = v.end(); i != end; ++i) { Tcl_ListObjAppendElement(interp, ret, Tcl_NewDoubleObj(*i)); } return ret; }
/* $sb get -- * Returns the last thing passed to 'set'. */ static int ScrollbarGetCommand( Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], void *recordPtr) { Scrollbar *scrollbar = recordPtr; Tcl_Obj *result[2]; if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, ""); return TCL_ERROR; } result[0] = Tcl_NewDoubleObj(scrollbar->scrollbar.first); result[1] = Tcl_NewDoubleObj(scrollbar->scrollbar.last); Tcl_SetObjResult(interp, Tcl_NewListObj(2, result)); return TCL_OK; }
/* assign a var from an double */ Tcl_Obj* TSP_Util_lang_assign_var_double(Tcl_Obj* targetVarName, double sourceVarName) { if (targetVarName != NULL) { Tcl_DecrRefCount(targetVarName); } targetVarName = Tcl_NewDoubleObj(sourceVarName); Tcl_IncrRefCount(targetVarName); return targetVarName; }
static Tcl_Obj *NewIntOrDoubleObj(double x) { /* This function works around two quirks: (1) that numeric values in R are generally stored as doubles, even small integer constants and (2) that Tcl stringifies a double constant like 2 into the form 2.0, which will not work ins some connections */ int i = (int) x; return ((double) i == x) ? Tcl_NewIntObj(i) : Tcl_NewDoubleObj(x); }
static Tcl_Obj* AsObj(PyObject *value) { Tcl_Obj *result; if (PyString_Check(value)) return Tcl_NewStringObj(PyString_AS_STRING(value), PyString_GET_SIZE(value)); else if (PyInt_Check(value)) return Tcl_NewLongObj(PyInt_AS_LONG(value)); else if (PyFloat_Check(value)) return Tcl_NewDoubleObj(PyFloat_AS_DOUBLE(value)); else if (PyTuple_Check(value)) { Tcl_Obj **argv = (Tcl_Obj**) ckalloc(PyTuple_Size(value)*sizeof(Tcl_Obj*)); int i; if(!argv) return 0; for(i=0;i<PyTuple_Size(value);i++) argv[i] = AsObj(PyTuple_GetItem(value,i)); result = Tcl_NewListObj(PyTuple_Size(value), argv); ckfree(FREECAST argv); return result; } else if (PyUnicode_Check(value)) { #if TKMAJORMINOR <= 8001 /* In Tcl 8.1 we must use UTF-8 */ PyObject* utf8 = PyUnicode_AsUTF8String(value); if (!utf8) return 0; result = Tcl_NewStringObj(PyString_AS_STRING(utf8), PyString_GET_SIZE(utf8)); Py_DECREF(utf8); return result; #else /* TKMAJORMINOR > 8001 */ /* In Tcl 8.2 and later, use Tcl_NewUnicodeObj() */ if (sizeof(Py_UNICODE) != sizeof(Tcl_UniChar)) { /* XXX Should really test this at compile time */ PyErr_SetString(PyExc_SystemError, "Py_UNICODE and Tcl_UniChar differ in size"); return 0; } return Tcl_NewUnicodeObj(PyUnicode_AS_UNICODE(value), PyUnicode_GET_SIZE(value)); #endif /* TKMAJORMINOR > 8001 */ } else { PyObject *v = PyObject_Str(value); if (!v) return 0; result = AsObj(v); Py_DECREF(v); return result; } }
static int itemBounds( Tcl_Interp *interp, int objc, Tcl_Obj * const objv[], CanvasParams *param, GPtrArray *items ) { if( objc != 3 ) { Tcl_WrongNumArgs( interp, 2, objv, NULL ); return TCL_ERROR; } if( items != NULL && items->len > 0 ) { Tcl_Obj *resList; double xMin, yMin, xMax, yMax; guint k; Gnocl_CanvasItemInfo *info = GET_INFO( items, 0 ); gnome_canvas_item_get_bounds( info->item, &xMin, &yMin, &xMax, &yMax ); for( k = 1; k < items->len; ++k ) { double x1, y1, x2, y2; info = GET_INFO( items, k ); gnome_canvas_item_get_bounds( info->item, &x1, &y1, &x2, &y2 ); if( x1 < xMin ) xMin = x1; if( y1 < yMin ) yMin = y1; if( x2 > xMax ) xMax = x2; if( y2 > yMax ) yMax = y2; } resList = Tcl_NewListObj( 0, NULL ); Tcl_ListObjAppendElement( interp, resList, Tcl_NewDoubleObj( xMin ) ); Tcl_ListObjAppendElement( interp, resList, Tcl_NewDoubleObj( yMin ) ); Tcl_ListObjAppendElement( interp, resList, Tcl_NewDoubleObj( xMax ) ); Tcl_ListObjAppendElement( interp, resList, Tcl_NewDoubleObj( yMax ) ); Tcl_SetObjResult( interp, resList ); } return TCL_OK; }
/* * usage: bn_noise_fbm X Y Z h_val lacunarity octaves * */ int bn_cmd_noise(ClientData clientData, Tcl_Interp *interp, int argc, char **argv) { point_t pt; double h_val; double lacunarity; double octaves; double val; if (argc != 7) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " X Y Z h_val lacunarity octaves\"", NULL); return TCL_ERROR; } pt[0] = atof(argv[1]); pt[1] = atof(argv[2]); pt[2] = atof(argv[3]); h_val = atof(argv[4]); lacunarity = atof(argv[5]); octaves = atof(argv[6]); if (!strcmp("bn_noise_turb", argv[0])) { val = bn_noise_turb(pt, h_val, lacunarity, octaves); Tcl_SetObjResult( interp, Tcl_NewDoubleObj(val) ); } else if (!strcmp("bn_noise_fbm", argv[0])) { val = bn_noise_fbm(pt, h_val, lacunarity, octaves); Tcl_SetObjResult( interp, Tcl_NewDoubleObj(val) ); } else { Tcl_AppendResult(interp, "Unknown noise type \"", argv[0], "\"", NULL); return TCL_ERROR; } return TCL_OK; }
/* *---------------------------------------------------------------------- * * casstcl_logging_eventProc -- * * this routine is called by the Tcl event handler to process callbacks * we have set up from logging callbacks we've gotten from Cassandra * loop is * * Results: * returns 1 to say we handled the event and the dispatcher can delete it * *---------------------------------------------------------------------- */ int casstcl_logging_eventProc (Tcl_Event *tevPtr, int flags) { // we got called with a Tcl_Event pointer but really it's a pointer to // our casstcl_loggingEvent structure that has the Tcl_Event plus a pointer // to casstcl_sessionClientData, which is our key to the kindgdom. // Go get that. casstcl_loggingEvent *evPtr = (casstcl_loggingEvent *)tevPtr; Tcl_Interp *interp = evPtr->interp; #define CASSTCL_LOG_CALLBACK_LISTCOUNT 12 Tcl_Obj *listObjv[CASSTCL_LOG_CALLBACK_LISTCOUNT]; // probably won't happen but if we get a logging callback and have // no callback object, return 1 saying we handled it and let the // dispatcher delete the message NB this isn't exactly cool if (casstcl_loggingCallbackObj == NULL) { return 1; } // construct a list of key-value pairs representing the log message listObjv[0] = Tcl_NewStringObj ("clock", -1); listObjv[1] = Tcl_NewDoubleObj (evPtr->message.time_ms / 1000.0); listObjv[2] = Tcl_NewStringObj ("severity", -1); listObjv[3] = Tcl_NewStringObj (casstcl_cass_log_level_to_string (evPtr->message.severity), -1); listObjv[4] = Tcl_NewStringObj ("file", -1); listObjv[5] = Tcl_NewStringObj (evPtr->message.file, -1); listObjv[6] = Tcl_NewStringObj ("line", -1); listObjv[7] = Tcl_NewIntObj (evPtr->message.line); listObjv[8] = Tcl_NewStringObj ("function", -1); listObjv[9] = Tcl_NewStringObj (evPtr->message.function, -1); listObjv[10] = Tcl_NewStringObj ("message", -1); int messageLength = strnlen (evPtr->message.message, CASS_LOG_MAX_MESSAGE_SIZE); listObjv[11] = Tcl_NewStringObj (evPtr->message.message, messageLength); Tcl_Obj *listObj = Tcl_NewListObj (CASSTCL_LOG_CALLBACK_LISTCOUNT, listObjv); // even if this fails we still want the event taken off the queue // this function will do the background error thing if there is a tcl // error running the callback casstcl_invoke_callback_with_argument (interp, casstcl_loggingCallbackObj, listObj); // tell the dispatcher we handled it. 0 would mean we didn't deal with // it and don't want it removed from the queue return 1; }
/* TtkScrollviewCommand -- * Widget [xy]view command implementation. * * $w [xy]view -- return current view region * $w [xy]view $index -- set topmost item * $w [xy]view moveto $fraction * $w [xy]view scroll $number $what -- scrollbar interface */ int TtkScrollviewCommand( Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], ScrollHandle h) { Scrollable *s = h->scrollPtr; int newFirst = s->first; if (objc == 2) { Tcl_Obj *result[2]; result[0] = Tcl_NewDoubleObj((double)s->first / s->total); result[1] = Tcl_NewDoubleObj((double)s->last / s->total); Tcl_SetObjResult(interp, Tcl_NewListObj(2, result)); return TCL_OK; } else if (objc == 3) { if (Tcl_GetIntFromObj(interp, objv[2], &newFirst) != TCL_OK) { return TCL_ERROR; } } else { double fraction; int count; switch (Tk_GetScrollInfoObj(interp, objc, objv, &fraction, &count)) { case TK_SCROLL_ERROR: return TCL_ERROR; case TK_SCROLL_MOVETO: newFirst = (int) ((fraction * s->total) + 0.5); break; case TK_SCROLL_UNITS: newFirst = s->first + count; break; case TK_SCROLL_PAGES: { int perPage = s->last - s->first; /* @@@ */ newFirst = s->first + count * perPage; break; } } } TtkScrollTo(h, newFirst); return TCL_OK; }
static int _get(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj* const *objv) { if (argc != 2) return fw_error_obj(interp, Tcl_ObjPrintf("usage: %s get", Tcl_GetString(objv[0]))); _t *data = (_t *)clientData; Tcl_Obj *result[] = { Tcl_NewIntObj(jack_frame_time(data->fw.client)), Tcl_NewDoubleObj(data->sam.pll.freq.f), NULL }; Tcl_SetObjResult(interp, Tcl_NewListObj(2, result)); return TCL_OK; }
/* ScaleVariableChanged -- * Variable trace procedure for scale -variable; * Updates the scale's value. * If the linked variable is not a valid double, * sets the 'invalid' state. */ static void ScaleVariableChanged(void *recordPtr, const char *value) { Scale *scale = recordPtr; double v; if (value == NULL || Tcl_GetDouble(0, value, &v) != TCL_OK) { TtkWidgetChangeState(&scale->core, TTK_STATE_INVALID, 0); } else { Tcl_Obj *valueObj = Tcl_NewDoubleObj(v); Tcl_IncrRefCount(valueObj); Tcl_DecrRefCount(scale->scale.valueObj); scale->scale.valueObj = valueObj; TtkWidgetChangeState(&scale->core, 0, TTK_STATE_INVALID); } TtkRedisplayWidget(&scale->core); }
Tcl_Obj * Tk_PathDashOptionGetProc( ClientData clientData, Tk_Window tkwin, char *recordPtr, /* Pointer to widget record. */ int internalOffset) /* Offset within *recordPtr containing the * value. */ { Tk_PathDash *dashPtr = (Tk_PathDash *) (recordPtr + internalOffset); Tcl_Obj *listObj = Tcl_NewListObj(0, NULL); int i; for (i = 0; i < dashPtr->number; i++) { Tcl_ListObjAppendElement(NULL, listObj, Tcl_NewDoubleObj(dashPtr->array[i])); } return listObj; }