Beispiel #1
0
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 );
}
Beispiel #2
0
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);
}
Beispiel #3
0
/* 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;
}
Beispiel #4
0
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;
}
Beispiel #5
0
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;
}
Beispiel #6
0
/* $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;
}
Beispiel #7
0
/* $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;
}
Beispiel #8
0
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;
}
Beispiel #9
0
/* 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;
}
Beispiel #10
0
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;
}
Beispiel #11
0
Datei: If.C Projekt: vruge/hqp
//-----------------------------------------------------------------------
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;
}
Beispiel #12
0
/* $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;
}
Beispiel #13
0
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;
}
Beispiel #14
0
/****
 * 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;
} 
Beispiel #15
0
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;
}
Beispiel #17
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;
}
Beispiel #18
0
int NS(ReadF) (NS_ARGS)
{
  SETUP_mqctx
  MQ_FLT val;
  CHECK_NOARGS
  ErrorMqToTclWithCheck(MqReadF(mqctx, &val));
  Tcl_SetObjResult(interp, Tcl_NewDoubleObj(val));
  RETURN_TCL
}
Beispiel #19
0
	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;
	}
Beispiel #20
0
/* $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;
}
Beispiel #21
0
/* 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;
}
Beispiel #22
0
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);
}
Beispiel #23
0
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;
	}
}
Beispiel #24
0
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;
}
Beispiel #25
0
/*
 *  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;
}
Beispiel #26
0
/*
 *----------------------------------------------------------------------
 *
 * 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;
}
Beispiel #27
0
/* 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;
}
Beispiel #28
0
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;
}
Beispiel #29
0
/* 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);
}
Beispiel #30
0
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;
}