Exemplo n.º 1
0
test() {
  int code;
  int i=123;
  double d=3.14;

  // Link C/C++ variable and Tcl variable
  Tcl_LinkVar(interp,"i",(char*)(&i),TCL_LINK_INT);
  Tcl_LinkVar(interp,"d",(char*)(&d),TCL_LINK_DOUBLE);

  printf("i=%s\n",Tcl_GetVar(interp,"i",0));
  printf("d=%s\n",Tcl_GetVar(interp,"d",0));

  Tcl_SetVar(interp,"i","456",0);
  Tcl_SetVar(interp,"d","1.41421356",0);
  printf("i=%d\n",i);
  printf("d=%g\n",d);

  i=3229;
  d=1.6e-19;
  code=Tcl_Eval(interp,"expr $i");
  if(*interp->result!=0) printf("%s\n",interp->result);
  code=Tcl_Eval(interp,"expr $d");
  if(*interp->result!=0) printf("%s\n",interp->result);

  if(code!=TCL_OK) exit(1);
}
Exemplo n.º 2
0
    virtual void SetParameters (Tcl_Interp * interp) 
    {
      occparam.resthcloseedgefac =
	atof (Tcl_GetVar (interp, "::stloptions.resthcloseedgefac", 0));
      occparam.resthcloseedgeenable =
	atoi (Tcl_GetVar (interp, "::stloptions.resthcloseedgeenable", 0));
    }
Exemplo n.º 3
0
int NpInitInterp(Tcl_Interp *interp, int install_tk) {
  Tcl_Preserve((ClientData) interp);
  
  /*
   * Set sharedlib in interp while we are here.  This will be used to
   * base the location of the default pluginX.Y package in the stardll
   * usage scenario.
   */
  if (Tcl_SetVar2(interp, "plugin", "sharedlib", dllName, TCL_GLOBAL_ONLY)
      == NULL) {
    NpPlatformMsg("Failed to set plugin(sharedlib)!", "NpInitInterp");
    return TCL_ERROR;
  }
  
  /*
   * The plugin doesn't directly call Tk C APIs - it's all managed at
   * the Tcl level, so we can just pkg req Tk here instead of calling
   * Tk_InitStubs.
   */
  if (TCL_OK != Tcl_Init(interp)) {
    CONST char *msg = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
    fprintf(stderr, "GTKWAVE | Tcl_Init error: %s\n", msg) ;
    exit(EXIT_FAILURE);
  }
  if (install_tk) {
    NpLog("Tcl_PkgRequire(\"Tk\", \"%s\", 0)\n", TK_VERSION);
    if (1 && Tcl_PkgRequire(interp, "Tk", TK_VERSION, 0) == NULL) {
      CONST char *msg = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);      
      NpPlatformMsg(msg, "NpInitInterp Tcl_PkgRequire(Tk)");
      NpPlatformMsg("Failed to create initialize Tk", "NpInitInterp");
      return TCL_ERROR;
    }
  }
  return TCL_OK;
}
Exemplo n.º 4
0
static int
ThreadEventProc(
    Tcl_Event *evPtr,		/* Really ThreadEvent */
    int mask)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    ThreadEvent *threadEventPtr = (ThreadEvent *)evPtr;
    ThreadEventResult *resultPtr = threadEventPtr->resultPtr;
    Tcl_Interp *interp = tsdPtr->interp;
    int code;
    const char *result, *errorCode, *errorInfo;

    if (interp == NULL) {
	code = TCL_ERROR;
	result = "no target interp!";
	errorCode = "THREAD";
	errorInfo = "";
    } else {
	Tcl_Preserve((ClientData) interp);
	Tcl_ResetResult(interp);
	Tcl_CreateThreadExitHandler(ThreadFreeProc,
		(ClientData) threadEventPtr->script);
	code = Tcl_GlobalEval(interp, threadEventPtr->script);
	Tcl_DeleteThreadExitHandler(ThreadFreeProc,
		(ClientData) threadEventPtr->script);
	if (code != TCL_OK) {
	    errorCode = Tcl_GetVar(interp, "errorCode", TCL_GLOBAL_ONLY);
	    errorInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
	} else {
	    errorCode = errorInfo = NULL;
	}
	result = Tcl_GetStringResult(interp);
    }
    ckfree(threadEventPtr->script);
    if (resultPtr) {
	Tcl_MutexLock(&threadMutex);
	resultPtr->code = code;
	resultPtr->result = ckalloc(strlen(result) + 1);
	strcpy(resultPtr->result, result);
	if (errorCode != NULL) {
	    resultPtr->errorCode = ckalloc(strlen(errorCode) + 1);
	    strcpy(resultPtr->errorCode, errorCode);
	}
	if (errorInfo != NULL) {
	    resultPtr->errorInfo = ckalloc(strlen(errorInfo) + 1);
	    strcpy(resultPtr->errorInfo, errorInfo);
	}
	Tcl_ConditionNotify(&resultPtr->done);
	Tcl_MutexUnlock(&threadMutex);
    }
    if (interp != NULL) {
	Tcl_Release((ClientData) interp);
    }
    return 1;
}
Exemplo n.º 5
0
void handle_error(Tcl_Interp *interp, char *msg)
{
    char *info = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
#ifdef USE_TIDE
    char *code = Tcl_GetVar(interp, "errorCode", TCL_GLOBAL_ONLY);

    if(handle_tide_error(interp, code, msg, info))
        return;
#endif

    fprintf(stderr, "error in Tcl script: %s\n%s\n", msg, info);
}
Exemplo n.º 6
0
/*
 * cat命令处理
 */
int PacketDefCmd::cat_proc(ClientData clientData, Tcl_Interp *interp, int argc,char *argv[])
{
    if(argc < 2)
    {
        //DataLog::insertERROR("cat command wrong, usage: cat 00 11 ...");
        return TCL_ERROR;
    }

    char result[512] = {0} ;
    memset(result,0,argc);
    int pos = 0;

    for(int i=1;i<argc;i++)
    {
        if(argv[i][0] != '$')
        {
            strcpy(result+pos,argv[i]);
            pos += strlen(argv[i]);
        }
        else      //进行值替换
        {
            const char* value = Tcl_GetVar(interp,argv[i]+1,TCL_GLOBAL_ONLY);
            strcpy(result+pos,value);
            pos += strlen(value);
        }
    }

    //interp->result的缺省大小为200字节
    strcpy(interp->result,result);

    //output data log
//    DataLog::insertDEBUG("[cat ...] command success!");

    return TCL_OK;
}
Exemplo n.º 7
0
/*
 * header命令处理
 */
int PacketDefCmd::header_proc(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])
{
    //Check the StopTcl flag
    const char* stoptcl = Tcl_GetVar(interp,"StopTcl",TCL_GLOBAL_ONLY);
    if(stoptcl != NULL && (bcmp(stoptcl,"yes",3) == 0))    //TclIntepreter thread stop
        return TCL_BREAK;

    if(argc != 3)
    {
        //DataLog::insertERROR("header command wrong, usage: header name body");
        return TCL_ERROR;
    }

    memset(headerName,0,sizeof(headerName));
    strcpy(headerName,argv[1]);  //save the header name;

    int len = strlen(argv[2]);
    getLine(argv[2],len,interp,0);

    //output data log
    snprintf(logdata,LOGLEN,"header %s {...} command success!",argv[1]);
//    DataLog::insertDEBUG(logdata);

    return TCL_OK;
}
Exemplo n.º 8
0
static int echoBegin(sqlite3_vtab *tab){
  int rc;
  echo_vtab *pVtab = (echo_vtab *)tab;
  Tcl_Interp *interp = pVtab->interp;
  const char *zVal; 

  assert( !pVtab->inTransaction );

  if( simulateVtabError(pVtab, "xBegin") ){
    return SQLITE_ERROR;
  }

  rc = echoTransactionCall(tab, "xBegin");

  if( rc==SQLITE_OK ){
    zVal = Tcl_GetVar(interp, "echo_module_begin_fail", TCL_GLOBAL_ONLY);
    if( zVal && 0==strcmp(zVal, pVtab->zTableName) ){
      rc = SQLITE_ERROR;
    }
  }
  if( rc==SQLITE_OK ){
    pVtab->inTransaction = 1;
  }
  return rc;
}
Exemplo n.º 9
0
int TCLSH_MAIN(int argc, char **argv){
#ifndef TCL_THREADS
  Tcl_Interp *interp;
  Tcl_FindExecutable(argv[0]);
  interp = Tcl_CreateInterp();
  Libsqlite_Init(interp);
  if( argc>=2 ){
    int i;
    Tcl_SetVar(interp,"argv0",argv[1],TCL_GLOBAL_ONLY);
    Tcl_SetVar(interp,"argv", "", TCL_GLOBAL_ONLY);
    for(i=2; i<argc; i++){
      Tcl_SetVar(interp, "argv", argv[i],
          TCL_GLOBAL_ONLY | TCL_LIST_ELEMENT | TCL_APPEND_VALUE);
    }
    if( Tcl_EvalFile(interp, argv[1])!=TCL_OK ){
      const char *zInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
      if( zInfo==0 ) zInfo = interp->result;
      fprintf(stderr,"%s: %s\n", *argv, zInfo);
      return TCL_ERROR;
    }
  }else{
    Tcl_GlobalEval(interp, zMainloop);
  }
  return 0;
#else
  Tcl_Main(argc, argv, Libsqlite_Init);
#endif /* TCL_THREADS */
  return 0;
}
Exemplo n.º 10
0
static int echoSync(sqlite3_vtab *tab){
  int rc;
  echo_vtab *pVtab = (echo_vtab *)tab;
  Tcl_Interp *interp = pVtab->interp;
  const char *zVal; 

  /* Ticket #3083 - Only call xSync if we have previously started a
  ** transaction */
  assert( pVtab->inTransaction );

  if( simulateVtabError(pVtab, "xSync") ){
    return SQLITE_ERROR;
  }

  rc = echoTransactionCall(tab, "xSync");

  if( rc==SQLITE_OK ){
    /* Check if the $::echo_module_sync_fail variable is defined. If it is,
    ** and it is set to the name of the real table underlying this virtual
    ** echo module table, then cause this xSync operation to fail.
    */
    zVal = Tcl_GetVar(interp, "echo_module_sync_fail", TCL_GLOBAL_ONLY);
    if( zVal && 0==strcmp(zVal, pVtab->zTableName) ){
      rc = -1;
    }
  }
  return rc;
}
Exemplo n.º 11
0
void fetch_param_bool( struct param *p )
{
    const char *str_val;
    int val;
    bool_t no_val = False;

    check_assertion( p->type == PARAM_BOOL, 
		     "configuration parameter type mismatch" );

    str_val = Tcl_GetVar( g_game.tcl_interp, p->name, TCL_GLOBAL_ONLY );
    
    if ( str_val == NULL ) {
	no_val = True;
    } else if ( string_cmp_no_case( str_val, "false" ) == 0 ) {
	p->val.bool_val = False;
    } else if ( string_cmp_no_case( str_val, "true" ) == 0 ) {
	p->val.bool_val = True;
    } else if ( Tcl_GetInt( g_game.tcl_interp, str_val, &val) == TCL_ERROR ) {
	no_val = True;
    } else {
	p->val.bool_val = (val == 0) ? False : True ;
    }

    if ( no_val ) {
	p->val.bool_val = p->deflt.bool_val;
    }

    p->loaded = True;
}
Exemplo n.º 12
0
static void
ThreadErrorProc(
    Tcl_Interp *interp)		/* Interp that failed */
{
    Tcl_Channel errChannel;
    const char *errorInfo, *argv[3];
    char *script;
    char buf[TCL_DOUBLE_SPACE+1];
    sprintf(buf, "%ld", (long) Tcl_GetCurrentThread());

    errorInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
    if (errorProcString == NULL) {
	errChannel = Tcl_GetStdChannel(TCL_STDERR);
	Tcl_WriteChars(errChannel, "Error from thread ", -1);
	Tcl_WriteChars(errChannel, buf, -1);
	Tcl_WriteChars(errChannel, "\n", 1);
	Tcl_WriteChars(errChannel, errorInfo, -1);
	Tcl_WriteChars(errChannel, "\n", 1);
    } else {
	argv[0] = errorProcString;
	argv[1] = buf;
	argv[2] = errorInfo;
	script = Tcl_Merge(3, argv);
	TclThreadSend(interp, errorThreadId, script, 0);
	ckfree(script);
    }
}
Exemplo n.º 13
0
static int
SetupMainInterp(
    Tcl_Interp *interp)
{
    /*
     * Initialize the console only if we are running as an interactive
     * application.
     */

    TkMacInitAppleEvents(interp);
    TkMacInitMenus(interp);

    if (strcmp(Tcl_GetVar(interp, "tcl_interactive", TCL_GLOBAL_ONLY), "1")
	    == 0) {
	if (Tk_CreateConsoleWindow(interp) == TCL_ERROR) {
	    goto error;
	}
	SetupSIOUX();
	TclMacInstallExitToShellPatch(NoMoreOutput);
    }

    /*
     * Attach the global interpreter to tk's expected global console
     */

    gStdoutInterp = interp;

    return TCL_OK;

error:
    panic(Tcl_GetStringResult(interp));
    return TCL_ERROR;
}
Exemplo n.º 14
0
static int echoBegin(sqlite3_vtab *tab){
  int rc;
  echo_vtab *pVtab = (echo_vtab *)tab;
  Tcl_Interp *interp = pVtab->interp;
  const char *zVal; 

  /* Ticket #3083 - do not start a transaction if we are already in
  ** a transaction */
  assert( !pVtab->inTransaction );

  if( simulateVtabError(pVtab, "xBegin") ){
    return SQLITE_ERROR;
  }

  rc = echoTransactionCall(tab, "xBegin");

  if( rc==SQLITE_OK ){
    /* Check if the $::echo_module_begin_fail variable is defined. If it is,
    ** and it is set to the name of the real table underlying this virtual
    ** echo module table, then cause this xSync operation to fail.
    */
    zVal = Tcl_GetVar(interp, "echo_module_begin_fail", TCL_GLOBAL_ONLY);
    if( zVal && 0==strcmp(zVal, pVtab->zTableName) ){
      rc = SQLITE_ERROR;
    }
  }
  if( rc==SQLITE_OK ){
    pVtab->inTransaction = 1;
  }
  return rc;
}
Exemplo n.º 15
0
static void ThreadErrorProc(Tcl_Interp *interpreter)
{
#ifdef WIN32
/* George Petasis, 21 Feb 2006:
 * Unfortunatelly, I cannot find a way to measure the LONG_MAX characters
 * with Visual C++ preprocessor. char buffer[strlen("")] does nto seem to work
 * with static functions under Visual C++ .NET.*/
    char buffer[15];
#else
    char buffer[strlen(XSTRING(LONG_MAX))];
#endif
    CONST char *errorInformation;
    Tcl_Channel errorChannel;

    errorInformation = Tcl_GetVar(interpreter, "errorInfo", TCL_GLOBAL_ONLY);
    if (errorInformation == 0) {
        errorInformation = "";
    }
    errorChannel = Tcl_GetStdChannel(TCL_STDERR);
    if (errorChannel == NULL) return;
    sprintf(buffer, "%ld", (long)CURRENTTHREAD);
    Tcl_WriteChars(errorChannel, "Error from thread ", -1);
    Tcl_WriteChars(errorChannel, buffer, -1);
    Tcl_WriteChars(errorChannel, "\n", 1);
    Tcl_WriteChars(errorChannel, errorInformation, -1);
    Tcl_WriteChars(errorChannel, "\n", 1);
}
Exemplo n.º 16
0
void
gdbtk_interp::pre_command_loop ()
{
  /* We no longer want to use stdin as the command input stream: disable
     events from stdin. */
  main_ui->input_fd = -1;

  if (Tcl_Eval (gdbtk_tcl_interp, "gdbtk_tcl_preloop") != TCL_OK)
    {
      const char *msg;

      /* Force errorInfo to be set up propertly.  */
      Tcl_AddErrorInfo (gdbtk_tcl_interp, "");

      msg = Tcl_GetVar (gdbtk_tcl_interp, "errorInfo", TCL_GLOBAL_ONLY);
#ifdef _WIN32
      MessageBox (NULL, msg, NULL, MB_OK | MB_ICONERROR | MB_TASKMODAL);
#else
      fputs_unfiltered (msg, gdb_stderr);
#endif
    }

#ifdef _WIN32
  close_bfds ();
#endif
}
Exemplo n.º 17
0
/*--------------------------------------------------------------------------*/
BOOL TCL_ArrayExist(Tcl_Interp *TCLinterpreter,char *VarName)
{
	BOOL bExist = FALSE;

	if (strcmp(VarName,TCL_VAR_NAME_TMP))
	{
		char MyTclCommand[2048];
		char *StrArrayExist=NULL;

		sprintf(MyTclCommand, "set TclScilabTmpVar [array exists %s];",VarName); 

		if ( Tcl_Eval(TCLinterpreter,MyTclCommand) == TCL_ERROR  )
		{
			Scierror(999,_("Tcl Error : %s\n"),Tcl_GetStringResult(TCLinterpreter));
			return FALSE;
		}

		StrArrayExist = (char *) Tcl_GetVar(TCLinterpreter, TCL_VAR_NAME_TMP,TCL_GLOBAL_ONLY);

		if (StrArrayExist)
		{
			int r  = (int)atoi(StrArrayExist);
			if (r) bExist = TRUE;
			Tcl_UnsetVar(TCLinterpreter,TCL_VAR_NAME_TMP, TCL_GLOBAL_ONLY);
		}
	}

	return bExist;
}
Exemplo n.º 18
0
enum MqErrorE NS(ProcError) (
  struct TclContextS * const tclctx,
  MQ_CST proc
)
{
  SETUP_interp
  enum MqErrorE ret = MQ_OK;
  Tcl_Obj *item;
  Tcl_Obj *errorCode = Tcl_GetVar2Ex (interp, "errorCode", NULL, TCL_GLOBAL_ONLY);
  if (
    Tcl_ListObjIndex (NULL, errorCode, 0, &item) == TCL_ERROR  ||   // index "0" is not in the list "code"
    strncmp (Tcl_GetString (item), "TCLMSGQUE", 9)		    // error is not from "TCLMSGQUE"
  ) {
    // tcl error
    ret = MqErrorC (MQCTX,proc,-1,Tcl_GetVar (interp, "errorInfo", TCL_GLOBAL_ONLY));
  } else {
    // tclmsgque error
    int errnum = -1;
    int errcode = -1;
    Tcl_ListObjIndex (NULL, errorCode, 1, &item);
    Tcl_GetIntFromObj(NULL, item, &errnum); 
    Tcl_ListObjIndex (NULL, errorCode, 2, &item);
    Tcl_GetIntFromObj(NULL, item, &errcode); 
    Tcl_ListObjIndex (NULL, errorCode, 3, &item);
    ret = MqErrorSet (MQCTX, errnum, (enum MqErrorE) errcode, Tcl_GetString(item), NULL);
  }
  Tcl_ResetResult(interp);
  return ret;
}
Exemplo n.º 19
0
static void
gdbtk_command_loop (void)
{
  extern FILE *instream;

  /* We no longer want to use stdin as the command input stream */
  instream = NULL;

  if (Tcl_Eval (gdbtk_interp, "gdbtk_tcl_preloop") != TCL_OK)
    {
      const char *msg;

      /* Force errorInfo to be set up propertly.  */
      Tcl_AddErrorInfo (gdbtk_interp, "");

      msg = Tcl_GetVar (gdbtk_interp, "errorInfo", TCL_GLOBAL_ONLY);
#ifdef _WIN32
      MessageBox (NULL, msg, NULL, MB_OK | MB_ICONERROR | MB_TASKMODAL);
#else
      fputs_unfiltered (msg, gdb_stderr);
#endif
    }

#ifdef _WIN32
  close_bfds ();
#endif

  Tk_MainLoop ();
}
Exemplo n.º 20
0
/*--------------------------------------------------------------------------*/
int TCL_ArraySize(Tcl_Interp *TCLinterpreter, char *VarName)
{
    int ArraySize = 0;

    if (strcmp(VarName, "TclScilabTmpVar"))
    {
        char MyTclCommand[2048];
        char *StrArraySize = NULL;

        sprintf(MyTclCommand, "set TclScilabTmpVar [array size %s];", VarName);

        if ( Tcl_Eval(TCLinterpreter, MyTclCommand) == TCL_ERROR  )
        {
            Scierror(999, _("Tcl Error: %s\n"), Tcl_GetStringResult(TCLinterpreter));
            return 0;
        }

        StrArraySize = (char *) Tcl_GetVar(TCLinterpreter, "TclScilabTmpVar", TCL_GLOBAL_ONLY);

        if (StrArraySize)
        {
            ArraySize = (int)atoi(StrArraySize);
            Tcl_UnsetVar(TCLinterpreter, "TclScilabTmpVar", TCL_GLOBAL_ONLY);
        }
    }
    return ArraySize;
}
Exemplo n.º 21
0
test() {
  Tcl_Interp *interp;
  int code;
  int i=123;
  double d=3.14;

  interp = Tcl_CreateInterp();
  Tcl_AppInit(interp);
  // cinttk_init();

  // Link C/C++ variable and Tcl variable
  Tcl_LinkVar(interp,"i",(char*)(&i),TCL_LINK_INT);
  Tcl_LinkVar(interp,"d",(char*)(&d),TCL_LINK_DOUBLE);

  printf("i=%s\n",Tcl_GetVar(interp,"i",0));
  printf("d=%s\n",Tcl_GetVar(interp,"d",0));

  Tcl_SetVar(interp,"i","456",0);
  Tcl_SetVar(interp,"d","1.41421356",0);
  printf("i=%d\n",i);
  printf("d=%g\n",d);

  code=Tcl_Eval(interp,"set i 789");
  code=Tcl_Eval(interp,"set d 0.71");
  printf("i=%d\n",i);
  printf("d=%g\n",d);

  i=3229;
  d=1.6e-19;
  code=Tcl_Eval(interp,"expr $i");
  if(*interp->result!=0) printf("%s\n",interp->result);
  code=Tcl_Eval(interp,"expr $d");
  if(*interp->result!=0) printf("%s\n",interp->result);

  printf("tcl source code insertion test\n");

#pragma tcl interp
  set i 512
  set d 299.793
#pragma endtcl

  printf("i=%d\n",i);
  printf("d=%g\n",d);

  if(code!=TCL_OK) exit(1);
  exit(0);
}
Exemplo n.º 22
0
char *fset_rem_str(ClientData *cd, Tcl_Interp *intp, char *name1, char *name2, int flags)
{
char *s;
IrcVariable *n;
	n = (IrcVariable *)cd;
	if ((s = Tcl_GetVar(intp, name1, TCL_GLOBAL_ONLY)))
	{
		malloc_strcpy(&n->string, s);
	}
	return NULL;
}
Exemplo n.º 23
0
/*******************************************************************************
 *
 *     Name:        cam_display_list( camera_t *, object_t * )
 *
 *     Purpose:     Display list of given objecst is given list of cameras
 *
 *     Parameters:
 *
 *         Input:   (camera_t *) input list of cameras
 *                  (object_t *) input list of objecst
 *
 *         Output:  graphics
 *
 *   Return value:  if mouse interaction is going on and too slow FALSE,
 *                  otherwise TRUE
 *
 *******************************************************************************/
int cam_display_list( camera_t *camera, object_t *object )
{
    double t = RealTime(), ct = CPUTime();

    int FitToPage = 0, nofcameras;
    camera_t *cam;

    if ( GlobalOptions.OutputPS ) {
       initglp( Tcl_GetVar( TCLInterp, "PSFileName", TCL_GLOBAL_ONLY ), 
                GlobalOptions.FitToPagePS );
    }
    if ( user_hook_before_all ) (*user_hook_before_all)( camera,object );

     nofcameras = 0;
     for( cam=camera; cam != NULL; cam = cam->Next, nofcameras++ );

    for( GlobalPass=0; GlobalPass < 2; GlobalPass++ )
    {
        for( cam=camera; cam != NULL; cam = cam->Next )
        {
            if ( !cam->OnOff ) continue;

            gra_set_projection( cam->ProjectionType, cam->FieldAngle,
                                cam->ViewportLowX, cam->ViewportHighX,
                                cam->ViewportLowY, cam->ViewportHighY,
	       	 	        cam->ClipNear, cam->ClipFar, nofcameras>1 );

            gra_push_matrix();

            gra_look_at(
                         cam->LookFromX, cam->LookFromY, cam->LookFromZ,
                            cam->LookAtX, cam->LookAtY, cam->LookAtZ,
                                  cam->UpX, cam->UpY, cam->UpZ
                       );

            if ( user_hook_camera_before ) (*user_hook_camera_before)( GlobalPass,cam,object,t );

            if ( !obj_display_list( object, t ) ) return FALSE;

            if ( user_hook_camera_after ) (*user_hook_camera_after)( GlobalPass,cam,object,t );

            gra_pop_matrix();

             if ( BreakLoop ) break;

        }
        if ( BreakLoop ) break;
    } 

    if ( user_hook_after_all ) (*user_hook_after_all)( camera,object );
    if ( GlobalOptions.OutputPS ) stopglp();

    return TRUE;
}
Exemplo n.º 24
0
static int simulateVtabError(echo_vtab *p, const char *zMethod){
  const char *zErr;
  char zVarname[128];
  zVarname[127] = '\0';
  sqlite3_snprintf(127, zVarname, "echo_module_fail(%s,%s)", zMethod, p->zTableName);
  zErr = Tcl_GetVar(p->interp, zVarname, TCL_GLOBAL_ONLY);
  if( zErr ){
    p->base.zErrMsg = sqlite3_mprintf("echo-vtab-error: %s", zErr);
  }
  return (zErr!=0);
}
Exemplo n.º 25
0
pure_expr *tk_get(const char *s)
{
  char *result = NULL;
  if (tk_start(&result)) {
    const char *res = Tcl_GetVar(interp, s, TCL_GLOBAL_ONLY);
    if (res)
      return pure_string_dup(res);
    else
      return NULL;
  } else
    return tk_error(result);
}
Exemplo n.º 26
0
void ScriptTcl::doCallback(const char *labels, const char *data) {
  if ( ! callbackname ) return;
  int len = strlen(callbackname) + strlen(labels) + strlen(data) + 7;
  char *cmd = new char[len];
  sprintf(cmd, "%s {%s} {%s}", callbackname, labels, data);
  int rval = Tcl_Eval(interp,cmd);
  delete [] cmd;
  if (rval != TCL_OK) {
    const char *errorInfo = Tcl_GetVar(interp,"errorInfo",0);
    NAMD_die(errorInfo);
  }
}
Exemplo n.º 27
0
int PacketDefCmd::delay_proc(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])
{
    //Check the StopTcl flag
    const char* stoptcl = Tcl_GetVar(interp,"StopTcl",TCL_GLOBAL_ONLY);
    if(stoptcl != NULL && (bcmp(stoptcl,"yes",3) == 0))    //TclIntepreter thread stop
        return TCL_BREAK;

    if(argc != 2 )
    {
        //DataLog::insertERROR("delay command wrong, usage: delay value");
        return TCL_ERROR;
    }

    int timecount;
    timecount = atoi(argv[1]);

    sprintf(logdata,"delay %d milliseconds",timecount*100);
    //DataLog::insertINFO(logdata);

    int time=0;

    while(time < timecount)
    {
        //sleep(1);
        usleep(100000);  //100ms

        time++;

        //Check the StopTcl flag
        const char* stoptcl = Tcl_GetVar(interp,"StopTcl",TCL_GLOBAL_ONLY);
        if(stoptcl != NULL && (bcmp(stoptcl,"yes",3) == 0))    //TclIntepreter thread stop
            return TCL_BREAK;
    }

    //DataLog::insertINFO("delay timeout");

    return TCL_OK;
}
Exemplo n.º 28
0
/*
 *----------------------------------------------------------------------
 *
 * TcpHostPortList --
 *
 *	This function is called by the -gethostname and -getpeername
 *	switches of TcpGetOptionProc() to add three list elements
 *	with the textual representation of the given address to the
 *	given DString.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Adds three elements do dsPtr
 *
 *----------------------------------------------------------------------
 */
static void
TcpHostPortList(
    Tcl_Interp *interp,
    Tcl_DString *dsPtr,
    address addr,
    socklen_t salen)
{
#define SUPPRESS_RDNS_VAR "::tcl::unsupported::noReverseDNS"
    char host[NI_MAXHOST], nhost[NI_MAXHOST], nport[NI_MAXSERV];
    int flags = 0;

    getnameinfo(&addr.sa, salen,
                nhost, sizeof(nhost), nport, sizeof(nport),
                NI_NUMERICHOST | NI_NUMERICSERV);
    Tcl_DStringAppendElement(dsPtr, nhost);
    /*
     * We don't want to resolve INADDR_ANY and sin6addr_any; they
     * can sometimes cause problems (and never have a name).
     */
    if (addr.sa.sa_family == AF_INET) {
        if (addr.sa4.sin_addr.s_addr == INADDR_ANY) {
            flags |= NI_NUMERICHOST;
        }
#ifndef NEED_FAKE_RFC2553
    } else if (addr.sa.sa_family == AF_INET6) {
        if ((IN6_ARE_ADDR_EQUAL(&addr.sa6.sin6_addr,
                                &in6addr_any))
            || (IN6_IS_ADDR_V4MAPPED(&addr.sa6.sin6_addr) &&
                addr.sa6.sin6_addr.s6_addr[12] == 0 &&
                addr.sa6.sin6_addr.s6_addr[13] == 0 &&
                addr.sa6.sin6_addr.s6_addr[14] == 0 &&
                addr.sa6.sin6_addr.s6_addr[15] == 0)) {
            flags |= NI_NUMERICHOST;
        }
#endif /* NEED_FAKE_RFC2553 */
    }
    /* Check if reverse DNS has been switched off globally */
    if (interp != NULL && Tcl_GetVar(interp, SUPPRESS_RDNS_VAR, 0) != NULL) {
        flags |= NI_NUMERICHOST;
    }
    if (getnameinfo(&addr.sa, salen, host, sizeof(host), NULL, 0, flags) == 0) {
        /* Reverse mapping worked */
        Tcl_DStringAppendElement(dsPtr, host);
    } else {
        /* Reverse mappong failed - use the numeric rep once more */
        Tcl_DStringAppendElement(dsPtr, nhost);
    }
    Tcl_DStringAppendElement(dsPtr, nport);
}
Exemplo n.º 29
0
void ScriptTcl::load(char *scriptFile) {

#ifdef NAMD_TCL
  int code = Tcl_EvalFile(interp,scriptFile);
  const char *result = Tcl_GetStringResult(interp);
  if (*result != 0) CkPrintf("TCL: %s\n",result);
  if (code != TCL_OK) {
    const char *errorInfo = Tcl_GetVar(interp,"errorInfo",0);
    NAMD_die(errorInfo);
  }
#else
  NAMD_bug("ScriptTcl::load called without Tcl.");
#endif

}
Exemplo n.º 30
0
static char * setFullButtons(ClientData data, Tcl_Interp * interp, 
			     char * name1, char * name2, int flags) {
    char * val = Tcl_GetVar(interp, "whiptcl_fullbuttons", TCL_GLOBAL_ONLY);
    int rc;
    int state;
    
    if ((rc = Tcl_ExprBoolean(interp, val, &state))) {
	Tcl_FreeResult(interp);
	return "whiptcl_fullbuttons may only contain a boolean value";
    }

    useFullButtons(state);

    return NULL;
}