C++ Tcl_NewIntObj函数代码示例

Tcl_Obj *
TkDebugColor(
    Tk_Window tkwin,		/* The window in which the color will be used
				 * (not currently used). */
    char *name)			/* Name of the desired color. */
{
    Tcl_HashEntry *hashPtr;
    Tcl_Obj *resultPtr;
    TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;

    resultPtr = Tcl_NewObj();
    hashPtr = Tcl_FindHashEntry(&dispPtr->colorNameTable, name);
    if (hashPtr != NULL) {
        TkColor *tkColPtr = Tcl_GetHashValue(hashPtr);

        if (tkColPtr == NULL) {
            Tcl_Panic("TkDebugColor found empty hash table entry");
        }
        for ( ; (tkColPtr != NULL); tkColPtr = tkColPtr->nextPtr) {
            Tcl_Obj *objPtr = Tcl_NewObj();

            Tcl_ListObjAppendElement(NULL, objPtr,
                                     Tcl_NewIntObj(tkColPtr->resourceRefCount));
            Tcl_ListObjAppendElement(NULL, objPtr,
                                     Tcl_NewIntObj(tkColPtr->objRefCount));
            Tcl_ListObjAppendElement(NULL, resultPtr, objPtr);
        }
    }
    return resultPtr;
}

static int
PrologToTclResult(Tcl_Interp *interp, AP_World *w, AP_Result prolog_result)
{
	switch (prolog_result) {
	case AP_SUCCESS:
	default:
		Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
		return TCL_OK;
		break;
	case AP_FAIL:
		Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
		return TCL_OK;
		break;
	case AP_EXCEPTION: {
		AP_Obj term_to_string, string;
		term_to_string = AP_NewInitStructure(w,
						AP_NewSymbolFromStr(w, "term_to_string"),
						2,
						AP_GetException(w),
						AP_UNBOUND_OBJ);
		AP_Call(w, tcltk_module, &term_to_string); // ignore result
		string = AP_GetArgument(w, term_to_string, 2);
		
		Tcl_ResetResult(interp);
		Tcl_AppendResult(interp,
			"prolog exception: ",
			AP_GetAtomStr(w, string),
			NULL);
		return TCL_ERROR;
		break;
		}
	}
}

static Tcl_Obj *_make_value(jackctl_parameter_t *parameter, union jackctl_parameter_value value) {
  switch (jackctl_parameter_get_type(parameter)) {
  case JackParamInt: return Tcl_NewIntObj(value.i);
  case JackParamUInt: return Tcl_NewIntObj(value.ui);
  case JackParamChar: return Tcl_NewStringObj(&value.c, 1);
  case JackParamString: return Tcl_NewStringObj(value.str, -1);
  case JackParamBool: return Tcl_NewBooleanObj(value.b);
  default: return Tcl_ObjPrintf("unknown type %d returned by jackctl_parameter_get_type", jackctl_parameter_get_type(parameter));
  }
}

static int _version(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj* const *objv) {
  _t *dp = (_t *)clientData;
  if (argc != 2) return fw_error_str(interp, "jack-client version");
  int major, minor, micro, proto;
  jack_get_version(&major, &minor, &micro, &proto);
  Tcl_Obj *result[] = {
    Tcl_NewIntObj(major), Tcl_NewIntObj(minor), Tcl_NewIntObj(micro), Tcl_NewIntObj(proto), NULL
  };
  Tcl_SetObjResult(interp, Tcl_NewListObj(4, result));
  return TCL_OK;
}

/* Sets up a Tcl interpreter for the game. Adds commands to implement our
   scripting interface. */
void InitScripting(void)
{

    /* First, create an interpreter and make sure it's valid. */
    interp = Tcl_CreateInterp();
    if (interp == NULL) {
	fprintf(stderr, "Unable to initialize Tcl.\n");
	exit(1);
    }

    /* Add the "fireWeapon" command. */
    if (Tcl_CreateObjCommand(interp, "fireWeapon",
			     HandleFireWeaponCmd, (ClientData) 0,
			     NULL) == NULL) {
	fprintf(stderr, "Error creating Tcl command.\n");
	exit(1);
    }

    /* Link the important parts of our player data structures to global
       variables in Tcl. (Ignore the char * typecast; Tcl will treat the data
       as the requested type, in this case double.) */
    Tcl_LinkVar(interp, "player_x", (char *) &player.world_x,
		TCL_LINK_DOUBLE);
    Tcl_LinkVar(interp, "player_y", (char *) &player.world_y,
		TCL_LINK_DOUBLE);
    Tcl_LinkVar(interp, "player_angle", (char *) &player.angle,
		TCL_LINK_DOUBLE);
    Tcl_LinkVar(interp, "player_accel", (char *) &player.accel,
		TCL_LINK_DOUBLE);
    Tcl_LinkVar(interp, "computer_x", (char *) &opponent.world_x,
		TCL_LINK_DOUBLE);
    Tcl_LinkVar(interp, "computer_y", (char *) &opponent.world_y,
		TCL_LINK_DOUBLE);
    Tcl_LinkVar(interp, "computer_angle", (char *) &opponent.angle,
		TCL_LINK_DOUBLE);
    Tcl_LinkVar(interp, "computer_accel", (char *) &opponent.accel,
		TCL_LINK_DOUBLE);

    /* Make the constants in gamedefs.h available to the script. The script
       should play by the game's rules, just like the human player.
       Tcl_SetVar2Ex is part of the Tcl_SetVar family of functions, which
       you can read about in the manpage. It simply sets a variable to a new
       value given by a Tcl_Obj structure. */
    Tcl_SetVar2Ex(interp, "world_width", NULL, Tcl_NewIntObj(WORLD_WIDTH),
		  0);
    Tcl_SetVar2Ex(interp, "world_height", NULL,
		  Tcl_NewIntObj(WORLD_HEIGHT), 0);
    Tcl_SetVar2Ex(interp, "player_forward_thrust", NULL,
		  Tcl_NewIntObj(PLAYER_FORWARD_THRUST), 0);
    Tcl_SetVar2Ex(interp, "player_reverse_thrust", NULL,
		  Tcl_NewIntObj(PLAYER_REVERSE_THRUST), 0);
}

int MkView::RestrictCmd() {
  int index = asIndex(view, objv[2], false);
  int pos = tcl_GetIntFromObj(objv[3]);
  int count = tcl_GetIntFromObj(objv[4]);

  int result = view.RestrictSearch(view[index], pos, count);

  Tcl_Obj *r = tcl_GetObjResult();
  tcl_ListObjAppendElement(r, Tcl_NewIntObj(result));
  tcl_ListObjAppendElement(r, Tcl_NewIntObj(pos));
  tcl_ListObjAppendElement(r, Tcl_NewIntObj(count));
  return _error;
}

int NS(pErrorFromMq) (
  Tcl_Interp * interp,
  struct MqS * const mqctx
)
{
  Tcl_Obj *objv[4];
  objv[0] = Tcl_NewStringObj ("TCLMSGQUE", -1);
  objv[1] = Tcl_NewIntObj (MqErrorGetNumI(mqctx));
  objv[2] = Tcl_NewIntObj (MqErrorGetCodeI(mqctx));
  objv[3] = Tcl_NewStringObj (MqErrorGetText(mqctx), -1);
  Tcl_SetObjErrorCode (interp, Tcl_NewListObj (4, objv));
  Tcl_SetResult(interp, (MQ_STR) MqErrorGetText(mqctx), TCL_VOLATILE);
  MqErrorReset(mqctx);
  return TCL_ERROR;
}

int xFilter(sqlite3_vtab_cursor *cursorP, int idx, const char *idxstrP,
            int argc, sqlite3_value **argv)
{
    VTableInfo *vtabP = (VTableInfo *) cursorP->pVtab;
    Tcl_Obj *objv[4];
    Tcl_Interp *interp;
    int i;

    if (vtabP->vtdbP == NULL || (interp = vtabP->vtdbP->vticP->interp) == NULL) {
        /* Should not really happen */
        SetVTableError(vtabP, gNullInterpError);
        return SQLITE_ERROR;
    }

    objv[0] = ObjFromPtr(cursorP, "sqlite3_vtab_cursor*");
    objv[1] = Tcl_NewIntObj(idx);
    objv[2] = Tcl_NewStringObj(idxstrP ? idxstrP : "", -1);
    objv[3] = Tcl_NewListObj(0, NULL);
    for (i = 0; i < argc; ++i) {
        Tcl_ListObjAppendElement(NULL, objv[3], ObjFromSqliteValue(argv[i], vtabP->vtdbP));
    }

    if (VTableInvokeCmd(interp, vtabP, "xFilter", 4 , objv) != TCL_OK) {
        SetVTableErrorFromInterp(vtabP, interp);
        return SQLITE_ERROR;
    }
    return SQLITE_OK;
}

static int
rcSeek (ClientData cd_, long offset, int seekMode, int* errorCodePtr)
{
  ReflectingChannel* chan = (ReflectingChannel*) cd_;
  int n = -1;

  Tcl_SavedResult sr;
  Tcl_Obj* cmd = rcBuildCmdList(chan, chan->_seek);
  Tcl_Interp* ip = chan->_interp;

  Tcl_ListObjAppendElement(NULL, cmd, Tcl_NewLongObj(offset));
  Tcl_ListObjAppendElement(NULL, cmd, Tcl_NewIntObj(seekMode));
  Tcl_SaveResult(ip, &sr);

  if (Tcl_EvalObjEx(ip, cmd, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT) == TCL_OK &&
      Tcl_GetIntFromObj(NULL, Tcl_GetObjResult(ip), &n) == TCL_OK)
    chan->_watchMask = chan->_validMask;

  Tcl_RestoreResult(ip, &sr);
  Tcl_DecrRefCount(cmd);

  if (n < 0)
    *errorCodePtr = EINVAL;
  return n;
}

static int
rcInput (ClientData cd_, char* buf, int toRead, int* errorCodePtr)
{
  ReflectingChannel* chan = (ReflectingChannel*) cd_;
  int n = -1;

  if (chan->_validMask & TCL_READABLE) {
    Tcl_SavedResult sr;
    Tcl_Obj* cmd = rcBuildCmdList(chan, chan->_read);
    Tcl_Interp* ip = chan->_interp;

    Tcl_ListObjAppendElement(NULL, cmd, Tcl_NewIntObj(toRead));
    Tcl_SaveResult(ip, &sr);

    if (Tcl_EvalObjEx(ip, cmd, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT) == TCL_OK) {
      void* s = Tcl_GetByteArrayFromObj(Tcl_GetObjResult(ip), &n);
      if (0 <= n && n <= toRead)
      	if (n > 0)
      	  memcpy(buf, s, n);
      	else
      	  chan->_watchMask &= ~TCL_READABLE;
      else
      	n = -1;
    }

    Tcl_RestoreResult(ip, &sr);
    Tcl_DecrRefCount(cmd);
  }

  if (n < 0)
    *errorCodePtr = EINVAL;
  return n;
}

/*
 * Tcl callback to allow reading of game configuration variables from Tcl.
 */
static int get_param_cb ( ClientData cd, Tcl_Interp *ip, 
			  int argc, const char *argv[]) 
{
    int i;
    int num_params;
    struct param *parm;

    if ( argc != 2 ) {
        Tcl_AppendResult(ip, argv[0], ": invalid number of arguments\n", 
			 "Usage: ", argv[0], " <parameter name>",
			 (char *)0 );
        return TCL_ERROR;
    } 

    /* Search for parameter */
    parm = NULL;
    num_params = sizeof(Params)/sizeof(struct param);
    for (i=0; i<num_params; i++) {
	parm = (struct param*)&Params + i;

	if ( strcmp( parm->name, argv[1] ) == 0 ) {
	    break;
	}
    }

    /* If can't find parameter, report error */
    if ( parm == NULL || i == num_params ) {
	Tcl_AppendResult(ip, argv[0], ": invalid parameter `",
			 argv[1], "'", (char *)0 );
	return TCL_ERROR;
    }

    /* Get value of parameter */
    switch ( parm->type ) {
    case PARAM_STRING:
	fetch_param_string( parm );
	Tcl_SetObjResult( ip, Tcl_NewStringObj( parm->val.string_val, -1 ) );
	break;

    case PARAM_CHAR:
	fetch_param_char( parm );
	Tcl_SetObjResult( ip, Tcl_NewStringObj( &parm->val.char_val, 1 ) );
	break;

    case PARAM_INT:
	fetch_param_int( parm );
	Tcl_SetObjResult( ip, Tcl_NewIntObj( parm->val.int_val ) );
	break;

    case PARAM_BOOL:
	fetch_param_bool( parm );
	Tcl_SetObjResult( ip, Tcl_NewBooleanObj( parm->val.bool_val ) );
	break;

    default:
	code_not_reached();
    }

    return TCL_OK;
} 

static int
Tcl_DoOneEventCmd(ClientData data, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv)
{
	int index, result;
	
	enum {EVENT_WAIT, EVENT_DONT_WAIT};
	const char *eventOptions[] = {"wait", "dont_wait", NULL};

	if (objc != 2) {
		Tcl_WrongNumArgs(interp, 1, objv, (char *)"option");
		return TCL_ERROR;
	}
	
    if (Tcl_GetIndexFromObj(interp, objv[1], eventOptions, (char *)"option", 0, &index)
	    != TCL_OK) {
    	return TCL_ERROR;
    }

	switch (index) {
	case EVENT_WAIT:
		result = Tcl_DoOneEvent(0);
		break;
	case EVENT_DONT_WAIT:
		result = Tcl_DoOneEvent(TCL_DONT_WAIT);
		break;
	default:
	  result = 0;
	  break;
	}
	
	Tcl_SetObjResult(interp, Tcl_NewIntObj(result));
	return TCL_OK;
}

static int _list_ports(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj* const *objv) {
  if (argc != 2) return fw_error_str(interp, "jack-client list-ports");
  _t *dp = (_t *)clientData;
  Tcl_Obj *dict = Tcl_NewDictObj();
  const char **portv[] = {
    jack_get_ports (dp->fw.client, NULL, JACK_DEFAULT_AUDIO_TYPE, 0),
    jack_get_ports (dp->fw.client, NULL, JACK_DEFAULT_MIDI_TYPE, 0)
  };
  for (int p = 0; p < 2; p += 1)
    if (portv[p] != NULL) {
      for (int i = 0; portv[p][i] != NULL; i += 1) {
	jack_port_t *port = jack_port_by_name(dp->fw.client, portv[p][i]);
	if (port != NULL) {
	  Tcl_Obj *pdict = Tcl_NewDictObj();
	  int flags = jack_port_flags(port);
	  Tcl_DictObjPut(interp, pdict, Tcl_NewStringObj("direction", -1), flags & JackPortIsInput ? Tcl_NewStringObj("input", -1) : Tcl_NewStringObj("output", -1) );
	  Tcl_DictObjPut(interp, pdict, Tcl_NewStringObj("physical", -1), Tcl_NewIntObj(flags & JackPortIsPhysical ? 1 : 0));
	  Tcl_DictObjPut(interp, pdict, Tcl_NewStringObj("type", -1), p == 0 ? Tcl_NewStringObj("audio", -1) : Tcl_NewStringObj("midi", -1));
	  const char **connv = jack_port_get_all_connections(dp->fw.client, port);
	  Tcl_Obj *list = Tcl_NewListObj(0, NULL);
	  if (connv != NULL) {
	    for (int j = 0; connv[j] != NULL; j += 1)
	      Tcl_ListObjAppendElement(interp, list, Tcl_NewStringObj(connv[j], -1));
	    jack_free(connv);
	  }
	  Tcl_DictObjPut(interp, pdict, Tcl_NewStringObj("connections", -1), list);
	  Tcl_DictObjPut(interp, dict, Tcl_NewStringObj(portv[p][i], -1), pdict);
	}
      }
      jack_free(portv[p]);
    }
  Tcl_SetObjResult(interp, dict);
  return TCL_OK;
}

/**
\brief
    Description yet to be added.
**/
static int notebookNext ( GtkNotebook *notebook, Tcl_Interp *interp,
						  int objc, Tcl_Obj * const objv[], int isNext )
{
	int cur = gtk_notebook_get_current_page ( notebook );
	int num = 1;

	/* widget next ?count? */

	if ( objc < 2 || objc > 3 )
	{
		Tcl_WrongNumArgs ( interp, 2, objv, "?count?" );
		return TCL_ERROR;
	}

	if ( objc == 3 && Tcl_GetIntFromObj ( interp, objv[2], &num ) != TCL_OK )
		return TCL_ERROR;

	if ( isNext )
	{
		cur = gtk_notebook_get_current_page ( notebook );
		gtk_notebook_set_current_page ( notebook, cur + num );
	}

	else if ( objc == 3 ) /* current val */
		gtk_notebook_set_current_page ( notebook, num );

	cur = gtk_notebook_get_current_page ( notebook );

	Tcl_SetObjResult ( interp, Tcl_NewIntObj ( cur ) );

	return TCL_OK;
}

int xColumn(sqlite3_vtab_cursor *cursorP, sqlite3_context *ctxP, int colindex)
{
    VTableInfo *vtabP = (VTableInfo *) cursorP->pVtab;
    Tcl_Obj *objv[2];
    Tcl_Interp *interp;

    if (vtabP->vtdbP == NULL || (interp = vtabP->vtdbP->vticP->interp) == NULL) {
        /* Should not really happen */
        SetVTableError(vtabP, gNullInterpError);
        return SQLITE_ERROR;
    }

    objv[0] = ObjFromPtr(cursorP, "sqlite3_vtab_cursor*");
    objv[1] = Tcl_NewIntObj(colindex);
    switch (VTableInvokeCmd(interp, vtabP, "xColumn", 2, objv)) {
    case TCL_OK:
        ObjToSqliteContextValue(Tcl_GetObjResult(interp), ctxP);
        return SQLITE_OK;
    case TCL_RETURN:
        /* Treat as SQL NULL value. Simply don't call any sqlite3_result_* */
        return SQLITE_OK;
    default:
        sqlite3_result_error(ctxP, Tcl_GetStringResult(interp), -1); 
        return SQLITE_ERROR;
    }
}