C++ Tcl_GetInt函数代码示例

static int
getresid(Tcl_Interp *interp, CONST84 char *id, Pg_ConnectionId ** connid_p)
{
	Tcl_Channel conn_chan;
	char	   *mark;
	int			resid;
	Pg_ConnectionId *connid;

	if (!(mark = strchr(id, '.')))
		return -1;
	*mark = '\0';
	conn_chan = Tcl_GetChannel(interp, id, 0);
	*mark = '.';
	if (conn_chan == NULL || Tcl_GetChannelType(conn_chan) != &Pg_ConnType)
	{
		Tcl_SetResult(interp, "Invalid connection handle", TCL_STATIC);
		return -1;
	}

	if (Tcl_GetInt(interp, mark + 1, &resid) == TCL_ERROR)
	{
		Tcl_SetResult(interp, "Poorly formated result handle", TCL_STATIC);
		return -1;
	}

	connid = (Pg_ConnectionId *) Tcl_GetChannelInstanceData(conn_chan);

	if (resid < 0 || resid >= connid->res_max || connid->results[resid] == NULL)
	{
		Tcl_SetResult(interp, "Invalid result handle", TCL_STATIC);
		return -1;
	}

	*connid_p = connid;

	return resid;
}

/*
** Usage:   fake_big_file  N  FILENAME
**
** Write a few bytes at the N megabyte point of FILENAME.  This will
** create a large file.  If the file was a valid SQLite database, then
** the next time the database is opened, SQLite will begin allocating
** new pages after N.  If N is 2096 or bigger, this will test the
** ability of SQLite to write to large files.
*/
static int fake_big_file(
  void *NotUsed,
  Tcl_Interp *interp,    /* The TCL interpreter that invoked this command */
  int argc,              /* Number of arguments */
  const char **argv      /* Text of each argument */
){
  int rc;
  int n;
  i64 offset;
  OsFile *fd = 0;
  int readOnly = 0;
  if( argc!=3 ){
    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
       " N-MEGABYTES FILE\"", 0);
    return TCL_ERROR;
  }
  if( Tcl_GetInt(interp, argv[1], &n) ) return TCL_ERROR;
  rc = sqlite3OsOpenReadWrite(argv[2], &fd, &readOnly);
  if( rc ){
    Tcl_AppendResult(interp, "open failed: ", errorName(rc), 0);
    return TCL_ERROR;
  }
  offset = n;
  offset *= 1024*1024;
  rc = sqlite3OsSeek(fd, offset);
  if( rc ){
    Tcl_AppendResult(interp, "seek failed: ", errorName(rc), 0);
    return TCL_ERROR;
  }
  rc = sqlite3OsWrite(fd, "Hello, World!", 14);
  sqlite3OsClose(&fd);
  if( rc ){
    Tcl_AppendResult(interp, "write failed: ", errorName(rc), 0);
    return TCL_ERROR;
  }
  return TCL_OK;
}

/* Parse an n-tuple of ints specified as a tcl-list. */
int get_tcl_int_tuple( Tcl_Interp *ip, const char *inList, int *p, int n ) 
{
    CONST84 char **indices;
    int tmp;
    int num_ints;
    int rtn;
    char s[100];
    int i;

    rtn = Tcl_SplitList(ip, inList, &num_ints, &indices);

    if ((TCL_OK != rtn) || (n != num_ints)) {
	sprintf(s,"%d",n);
	Tcl_AppendResult(ip, 
			 "Expected a tuple of ", s, " integers.\n",
			 (char *) 0
	    );
	Tcl_Free((char *)indices);
	return TCL_ERROR;
    }

    for (i = 0; i < n; i++) {
	if (TCL_OK != Tcl_GetInt(ip, indices[i], &tmp)) {
	    Tcl_Free((char *)indices);
	    sprintf(s,"%d",n);
	    Tcl_AppendResult(ip, 
			     "Expected a tuple of ", s, " integers.\n",
			     (char *) 0
		);
	    return TCL_ERROR;
	}
	p[i] = tmp;
    }
    Tcl_Free((char *)indices);
    return TCL_OK;
}

int TclNullPlasticMaterialCommand(ClientData clienData, Tcl_Interp *interp, int argc,
					TCL_Char **argv, TclModelBuilder *theTclBuilder)
{
    PlasticHardeningMaterial *theMaterial = 0;

	int tag;

	if (Tcl_GetInt(interp, argv[2], &tag) != TCL_OK)
	{
	    	opserr << "WARNING invalid  PlaticHardening quadrReducing tag" << endln;
	    	return TCL_ERROR;
	}

	theMaterial = new NullPlasticMaterial(tag);
    if (theTclBuilder->addPlasticMaterial(*theMaterial) < 0)
	{
		opserr << "WARNING could not add uniaxialMaterial to the domain\n";
		opserr << *theMaterial << endln;
		delete theMaterial; // invoke the material objects destructor, otherwise mem leak
		return TCL_ERROR;
    }

	return TCL_OK;
}

static int page_lookup(
  void *NotUsed,
  Tcl_Interp *interp,    
  int argc,              
  const char **argv      
){
  Pager *pPager;
  char zBuf[100];
  DbPage *pPage;
  int pgno;
  if( argc!=3 ){
    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
       " ID PGNO\"", 0);
    return TCL_ERROR;
  }
  pPager = sqlite3TestTextToPtr(argv[1]);
  if( Tcl_GetInt(interp, argv[2], &pgno) ) return TCL_ERROR;
  pPage = sqlite3PagerLookup(pPager, pgno);
  if( pPage ){
    sqlite3_snprintf(sizeof(zBuf),zBuf,"%p",pPage);
    Tcl_AppendResult(interp, zBuf, 0);
  }
  return TCL_OK;
}

/*******************************************************************************
 * dhsSysCloseTcl ( ... )
 *  Use: set dhsStat [dhs::SysClose <sID>]
 *******************************************************************************/
static int dhsSysCloseTcl ( ClientData clientData, Tcl_Interp *interp, int argc, char *argv[] ) {
 /* declare local scope variable and initialize them */
 dhsHandle sID=(dhsHandle)0;
 int ival=0;
 long lstat=0;
 /* initialize static variables */
 (void) memset(response,'\0',MAXMSG);
 (void) memset(result,'\0',DHS_RESULT_LEN);
 /* check handle */
 if ( Tcl_GetInt(interp,argv[1],&ival) != TCL_OK ) {
  (void) sprintf(result,"%s","dhsSysCloseTcl-E-bad handle\n");
  (void) Tcl_SetResult(interp,result,TCL_STATIC);
  return TCL_ERROR;
 }
 sID = (dhsHandle)ival;
 #ifdef DEBUGTCL
  (void) fprintf(stderr,"dhs::SysClose>> sID=%d\n",(int)sID); (void) fflush(stderr);
 #endif
 /* execute the dhs function */
 dhsSysClose(&lstat,response,sID);
 if ( STATUS_BAD(lstat) ) {
  (void) Tcl_SetResult(interp,response,TCL_STATIC);
  return TCL_ERROR;
 }
 #ifdef DEBUGTCL
  (void) fprintf(stderr,"dhs::SysClose>> lstat=%ld\n",lstat); (void) fflush(stderr);
 #endif
 /* return result */  
 (void) sprintf(result,"%ld",lstat);
 #ifdef DEBUGTCL
  (void) fprintf(stderr,"dhs::SysClose>> response=\"%s\"\n",response); (void) fflush(stderr);
  (void) fprintf(stderr,"dhs::SysClose>> result=\"%s\"\n",result); (void) fflush(stderr);
 #endif
 (void) Tcl_SetResult(interp,result,TCL_STATIC);
 return TCL_OK;
}

/** Reads a Tcl vector and returns a C vector.

    \param interp The Tcl interpreter
    \param data_in String containing a Tcl vector of integers
    \param nrep Pointer to the C vector
    \param len Pointer to an int to store the length of the vector
    \return \em TCL_OK if everything went fine \em TCL_ERROR otherwise and 
            interp->result is set to an error message.

	    If \em TCL_OK is returned you have to make sure to free the memory
	    pointed to by nrep.
 */
int uwerr_read_int_vector(Tcl_Interp *interp, char * data_in ,
			  int ** nrep, int * len)
{
  char ** col;
  int i;

  *len  = -1;
  *nrep =  0;

  if (Tcl_SplitList(interp, data_in, len, &col) == TCL_ERROR)
    return TCL_ERROR;

  if (*len < 1) {
    Tcl_AppendResult(interp, "Argument is not a vector.",
		     (char *)NULL);
    return TCL_ERROR;
  }

  if (!(*nrep = (int*)malloc((*len)*sizeof(int)))) {
    Tcl_AppendResult(interp, "Out of Memory.",
		     (char *)NULL);
    Tcl_Free((char *)col);
    return TCL_ERROR;
  }

  for (i = 0; i < *len; ++i) {
      if (Tcl_GetInt(interp, col[i], &((*nrep)[i])) == TCL_ERROR) {
	Tcl_Free((char *)col);
	free(*nrep);
	return TCL_ERROR;
      }
  }

  Tcl_Free((char *)col);
  return TCL_OK;
}

/*
** Usage:   fake_big_file  N  FILENAME
**
** Write a few bytes at the N megabyte point of FILENAME.  This will
** create a large file.  If the file was a valid SQLite database, then
** the next time the database is opened, SQLite will begin allocating
** new pages after N.  If N is 2096 or bigger, this will test the
** ability of SQLite to write to large files.
*/
static int fake_big_file(
  void *NotUsed,
  Tcl_Interp *interp,    /* The TCL interpreter that invoked this command */
  int argc,              /* Number of arguments */
  const char **argv      /* Text of each argument */
){
  sqlite3_vfs *pVfs;
  sqlite3_file *fd = 0;
  int rc;
  int n;
  i64 offset;
  if( argc!=3 ){
    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
       " N-MEGABYTES FILE\"", 0);
    return TCL_ERROR;
  }
  if( Tcl_GetInt(interp, argv[1], &n) ) return TCL_ERROR;

  pVfs = sqlite3_vfs_find(0);
  rc = sqlite3OsOpenMalloc(pVfs, argv[2], &fd, 
      (SQLITE_OPEN_CREATE|SQLITE_OPEN_READWRITE|SQLITE_OPEN_MAIN_DB), 0
  );
  if( rc ){
    Tcl_AppendResult(interp, "open failed: ", errorName(rc), 0);
    return TCL_ERROR;
  }
  offset = n;
  offset *= 1024*1024;
  rc = sqlite3OsWrite(fd, "Hello, World!", 14, offset);
  sqlite3OsCloseFree(fd);
  if( rc ){
    Tcl_AppendResult(interp, "write failed: ", errorName(rc), 0);
    return TCL_ERROR;
  }
  return TCL_OK;
}

int GraphCmdMask(GRAPH_ARGS)
{
  int mask;

  if ((argc != 2) && (argc != 3)) {
    Tcl_AppendResult(interp, "wrong # args", (char *) NULL);
    return TCL_ERROR;
  }

  if (argc == 3) {
    if ((Tcl_GetInt(interp, argv[2], &mask) != TCL_OK) ||
	(mask < 0) || (mask > 63)) {
      Tcl_AppendResult(interp, " bogus args", (char *) NULL);
      return TCL_ERROR;
    }

    graph->mask = mask;
    NewGraph = 1;
  }

  sprintf(interp->result, "%d", graph->mask);

  return TCL_OK;
}

/*
** Usage:   page_lookup ID PGNO
**
** Return a pointer to a page if the page is already in cache.
** If not in cache, return an empty string.
*/
static int page_lookup(
  void *NotUsed,
  Tcl_Interp *interp,    /* The TCL interpreter that invoked this command */
  int argc,              /* Number of arguments */
  const char **argv      /* Text of each argument */
){
  Pager *pPager;
  char zBuf[100];
  DbPage *pPage;
  int pgno;
  if( argc!=3 ){
    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
       " ID PGNO\"", 0);
    return TCL_ERROR;
  }
  pPager = sqlite3TestTextToPtr(argv[1]);
  if( Tcl_GetInt(interp, argv[2], &pgno) ) return TCL_ERROR;
  pPage = sqlite3PagerLookup(pPager, pgno);
  if( pPage ){
    sqlite3_snprintf(sizeof(zBuf),zBuf,"%p",pPage);
    Tcl_AppendResult(interp, zBuf, 0);
  }
  return TCL_OK;
}

/*
** usage:   btree_set_cache_size ID NCACHE
**
** Set the size of the cache used by btree $ID.
*/
static int btree_set_cache_size(
  void *NotUsed,
  Tcl_Interp *interp,    /* The TCL interpreter that invoked this command */
  int argc,              /* Number of arguments */
  const char **argv      /* Text of each argument */
){
  int nCache;
  Btree *pBt;
  
  if( argc!=3 ){
    Tcl_AppendResult(
        interp, "wrong # args: should be \"", argv[0], " BT NCACHE\"", 0);
    return TCL_ERROR;
  }
  pBt = sqlite3TestTextToPtr(argv[1]);
  if( Tcl_GetInt(interp, argv[2], &nCache) ) return TCL_ERROR;

  sqlite3_mutex_enter(pBt->db->mutex);
  sqlite3BtreeEnter(pBt);
  sqlite3BtreeSetCacheSize(pBt, nCache);
  sqlite3BtreeLeave(pBt);
  sqlite3_mutex_leave(pBt->db->mutex);
  return TCL_OK;
}      

int GraphCmdRange(GRAPH_ARGS)
{
  int range;

  if ((argc != 2) && (argc != 3)) {
    Tcl_AppendResult(interp, "wrong # args", (char *) NULL);
    return TCL_ERROR;
  }

  if (argc == 3) {
    if ((Tcl_GetInt(interp, argv[2], &range) != TCL_OK) ||
	((range != 10) && (range != 120))) {
      Tcl_AppendResult(interp, " bogus args", (char *) NULL);
      return TCL_ERROR;
    }

    graph->range = range;
    NewGraph = 1;
  }

  sprintf(interp->result, "%d", graph->range);

  return TCL_OK;
}

	/* ARGSUSED */
static int
ImageCmd(
    ClientData clientData,	/* Main window for application. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    TImageMaster *timPtr = clientData;
    int x, y, width, height;

    if (argc < 2) {
	Tcl_AppendResult(interp, "wrong # args: should be \"",
		argv[0], "option ?arg ...?", NULL);
	return TCL_ERROR;
    }
    if (strcmp(argv[1], "changed") == 0) {
	if (argc != 8) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		    " changed x y width height imageWidth imageHeight", NULL);
	    return TCL_ERROR;
	}
	if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK)
		|| (Tcl_GetInt(interp, argv[3], &y) != TCL_OK)
		|| (Tcl_GetInt(interp, argv[4], &width) != TCL_OK)
		|| (Tcl_GetInt(interp, argv[5], &height) != TCL_OK)
		|| (Tcl_GetInt(interp, argv[6], &timPtr->width) != TCL_OK)
		|| (Tcl_GetInt(interp, argv[7], &timPtr->height) != TCL_OK)) {
	    return TCL_ERROR;
	}
	Tk_ImageChanged(timPtr->master, x, y, width, height, timPtr->width,
		timPtr->height);
    } else {
	Tcl_AppendResult(interp, "bad option \"", argv[1],
		"\": must be changed", NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}

int
NurbsSurface (Tcl_Interp *interp, int argc, char* argv [])
{
    int result = TCL_OK;
    GLint uOrder = 4;
    GLint vOrder = 4;
    GLenum type = GL_MAP2_VERTEX_3;
    int nCoords = 3;
    FloatArray uKnot = NewFloatArray ();
    FloatArray vKnot = NewFloatArray ();
    FloatArray cPoint = NewFloatArray ();
    GLfloat samplingTolerance = 50.0;
    GLfloat displayMode = GLU_FILL;
    GLfloat culling = GL_FALSE;
    int iarg;
    int dlist = 0;

    for (iarg = 2; iarg < argc; iarg++) {
        int len = (int)strlen (argv [iarg]);
        if (strncmp (argv [iarg], "-uorder", len) == 0) {
            int val;
            iarg++;
            if (iarg >= argc) ERRMSG ("No value given for -uorder");
            if (Tcl_GetInt (interp, argv [iarg], &val) != TCL_OK ||
                    val < 2 || val > 8)
                ERRMSG2 ("\nInvalid value for -uorder:", argv [iarg]);
            uOrder = val;
        }
        else if (strncmp (argv [iarg], "-vorder", len) == 0) {
            int val;
            iarg++;
            if (iarg >= argc) ERRMSG ("No value given for -vorder");
            if (Tcl_GetInt (interp, argv [iarg], &val) != TCL_OK ||
                    val < 2 || val > 8)
                ERRMSG2 ("\nInvalid value for -vorder:", argv [iarg]);
            vOrder = val;
        }
        else if (strncmp (argv [iarg], "-uknots", len) == 0) {
            if (uKnot->count != 0) ERRMSG ("uknot values already given");
            iarg++;
            while (iarg < argc &&
                    !(argv [iarg][0] == '-' && isalpha(argv [iarg][1]))) {
                double val;
                if (Tcl_GetDouble (interp, argv [iarg], &val) != TCL_OK)
                    ERRMSG ("\nError parsing uknot value");
                if (uKnot->count > 0 &&
                        uKnot->value [uKnot->count-1] > val)
                    ERRMSG ("uknot values not in non-descending order");
                AddFloat (uKnot, (GLfloat)val);
                iarg++;
            }
            iarg--;
        }
        else if (strncmp (argv [iarg], "-vknots", len) == 0) {
            if (vKnot->count != 0) ERRMSG ("vknot values already given");
            iarg++;
            while (iarg < argc &&
                    !(argv [iarg][0] == '-' && isalpha(argv [iarg][1]))) {
                double val;
                if (Tcl_GetDouble (interp, argv [iarg], &val) != TCL_OK)
                    ERRMSG ("\nError parsing uknot value");
                if (vKnot->count > 0 &&
                        vKnot->value [vKnot->count-1] > val)
                    ERRMSG ("vknot values not in non-descending order");
                AddFloat (vKnot, (GLfloat)val);
                iarg++;
            }
            iarg--;
        }
        else if (strncmp (argv [iarg], "-controlpoints", len) == 0) {
            if (cPoint->count != 0) ERRMSG ("controlpoint values already given");
            iarg++;
            while (iarg < argc &&
                    !(argv [iarg][0] == '-' && isalpha(argv [iarg][1]))) {
                double val;
                if (Tcl_GetDouble (interp, argv [iarg], &val) != TCL_OK)
                    ERRMSG ("\nError parsing uknot value");
                AddFloat (cPoint, (GLfloat)val);
                iarg++;
            }
            iarg--;
        }
        else if (strncmp (argv [iarg], "-type", len) == 0) {
            iarg++;
            if (iarg >= argc) ERRMSG ("No -type value given");
            if (strcmp (argv [iarg], "map2vertex3") ==0) {
                type = GL_MAP2_VERTEX_3;
                nCoords = 3;
            } else if (strcmp (argv [iarg], "map2vertex4") == 0) {
                type = GL_MAP2_VERTEX_4;
                nCoords = 4;
            } else if (strcmp (argv [iarg], "map2color4") == 0) {
                type = GL_MAP2_COLOR_4;
                nCoords = 4;
            } else if (strcmp (argv [iarg], "map2normal") == 0) {
                type = GL_MAP2_NORMAL;
                nCoords = 3;
            } else if (strcmp (argv [iarg], "map2texturecoord1") == 0) {
                type = GL_MAP2_TEXTURE_COORD_1;
                nCoords = 1;
//.........这里部分代码省略.........

int TclModelBuilder_addElastomericBearingPlasticity(ClientData clientData,
    Tcl_Interp *interp, int argc, TCL_Char **argv, Domain *theTclDomain,
    TclModelBuilder *theTclBuilder, int eleArgStart)
{
    // ensure the destructor has not been called
    if (theTclBuilder == 0)  {
        opserr << "WARNING builder has been destroyed - elastomericBearing\n";
        return TCL_ERROR;
    }
    
    Element *theElement = 0;
    int ndm = theTclBuilder->getNDM();
    int ndf = theTclBuilder->getNDF();
    int tag;
    
    if (ndm == 2)  {
        // check plane frame problem has 3 dof per node
        if (ndf != 3)  {
            opserr << "WARNING invalid ndf: " << ndf;
            opserr << ", for plane problem need 3 - elastomericBearing\n";
            return TCL_ERROR;
        } 
        
        // check the number of arguments is correct
        if ((argc-eleArgStart) < 13)  {
            opserr << "WARNING insufficient arguments\n";
            printCommand(argc, argv);
            opserr << "Want: elastomericBearing eleTag iNode jNode kInit fy alpha1 alpha2 mu -P matTag -Mz matTag <-orient x1 x2 x3 y1 y2 y3> <-shearDist sDratio> <-doRayleigh> <-mass m>\n";
            return TCL_ERROR;
        }    
        
        // get the id and end nodes
        int iNode, jNode, matTag, argi, j;
        int recvMat = 0;
        double kInit, fy, alpha1;
        double alpha2 = 0.0;
        double mu = 2.0;
        double shearDistI = 0.5;
        int doRayleigh = 0;
        double mass = 0.0;
        
        if (Tcl_GetInt(interp, argv[1+eleArgStart], &tag) != TCL_OK)  {
            opserr << "WARNING invalid elastomericBearing eleTag\n";
            return TCL_ERROR;
        }
        if (Tcl_GetInt(interp, argv[2+eleArgStart], &iNode) != TCL_OK)  {
            opserr << "WARNING invalid iNode\n";
            opserr << "elastomericBearing element: " << tag << endln;
            return TCL_ERROR;
        }
        if (Tcl_GetInt(interp, argv[3+eleArgStart], &jNode) != TCL_OK)  {
            opserr << "WARNING invalid jNode\n";
            opserr << "elastomericBearing element: " << tag << endln;
            return TCL_ERROR;
        }
        if (Tcl_GetDouble(interp, argv[4+eleArgStart], &kInit) != TCL_OK)  {
            opserr << "WARNING invalid kInit\n";
            opserr << "elastomericBearing element: " << tag << endln;
            return TCL_ERROR;
        }
        if (Tcl_GetDouble(interp, argv[5+eleArgStart], &fy) != TCL_OK)  {
            opserr << "WARNING invalid fy\n";
            opserr << "elastomericBearing element: " << tag << endln;
            return TCL_ERROR;
        }
        if (Tcl_GetDouble(interp, argv[6+eleArgStart], &alpha1) != TCL_OK)  {
            opserr << "WARNING invalid alpha1\n";
            opserr << "elastomericBearing element: " << tag << endln;
            return TCL_ERROR;
        }
        if (Tcl_GetDouble(interp, argv[7+eleArgStart], &alpha2) != TCL_OK)  {
            opserr << "WARNING invalid alpha2\n";
            opserr << "elastomericBearing element: " << tag << endln;
            return TCL_ERROR;
        }
        if (Tcl_GetDouble(interp, argv[8+eleArgStart], &mu) != TCL_OK)  {
            opserr << "WARNING invalid mu\n";
            opserr << "elastomericBearing element: " << tag << endln;
            return TCL_ERROR;
        }
        UniaxialMaterial *theMaterials[2];
        for (int i = 9+eleArgStart; i < argc; i++)  {
            if (i+1 < argc && strcmp(argv[i], "-P") == 0)  {
                theMaterials[0] = 0;
                if (Tcl_GetInt(interp, argv[i+1], &matTag) != TCL_OK)  {
                    opserr << "WARNING invalid matTag\n";
                    opserr << "elastomericBearing element: " << tag << endln;
                    return TCL_ERROR;
                }
                theMaterials[0] = OPS_getUniaxialMaterial(matTag);
                if (theMaterials[0] == 0)  {
                    opserr << "WARNING material model not found\n";
                    opserr << "uniaxialMaterial: " << matTag << endln;
                    opserr << "elastomericBearing element: " << tag << endln;
                    return TCL_ERROR;
                }
                recvMat++;
            }
        }
        for (int i = 9+eleArgStart; i < argc; i++)  {
//.........这里部分代码省略.........