Example #1
0
/* ********************************************************
   Ndelete_key --

   Delete a keyframe.

   Arguments:
   Floating point position (i.e. time)
   Floating point precision
   Single delete? (boolean)

   Returns:
   Number of keys deleted.

   Side Effects:
   if single delete is false then removes all keyframes
   within precision of position.  Otherwise removes the
   first (lowest pos) keyframe within precision of position.

   ******************************************************** */
int Ndelete_key_cmd(Nv_data * data,	/* Local data */
		    Tcl_Interp * interp,	/* Current interpreter */
		    int argc,	/* Number of arguments */
		    char **argv	/* Argument strings */
    )
{
    /* Parse arguments */
    double pos, precis;
    int justone;
    int num_deleted;
    char tmp[10];

    if (argc != 4) {
	Tcl_SetResult(interp, "Error: should be Ndelete_key pos precis justone", TCL_VOLATILE);
	return (TCL_ERROR);
    }

    if (Tcl_GetDouble(interp, argv[1], &pos) != TCL_OK)
	return TCL_ERROR;
    if (Tcl_GetDouble(interp, argv[2], &precis) != TCL_OK)
	return TCL_ERROR;
    if (Tcl_GetBoolean(interp, argv[3], &justone) != TCL_OK)
	return TCL_ERROR;

    /* Call the function */
    num_deleted = GK_delete_key((float)pos, (float)precis, justone);

    sprintf(tmp, "%d", num_deleted);
    Tcl_SetResult(interp, tmp, TCL_VOLATILE);
    return (TCL_OK);

}
Example #2
0
/* ********************************************************
   Ndo_framestep --

   Hook to move animation to frame number given.
   Should be a value between 1 and the number of frames.

   Arguments:
   Integer frame number.
   Boolean false for fast-mesh, true for full-rendering

   Returns:
   None.

   Side Effects:
   Moves the animation to the given frame.
   ******************************************************** */
int Ndo_framestep_cmd(Nv_data * data,	/* Local data */
		      Tcl_Interp * interp,	/* Current interpreter */
		      int argc,	/* Number of arguments */
		      char **argv	/* Argument strings */
    )
{
    /* Parse arguments */
    long step;
    int render_type;

    if (argc != 3) {
	Tcl_SetResult(interp,
	    "Error: should be Ndo_framestep frame_# [TRUE | FALSE]", TCL_VOLATILE);
	return (TCL_ERROR);
    }

    if (Tcl_GetInt(interp, argv[1], (int *)&step) != TCL_OK)
	return (TCL_ERROR);

    if (Tcl_GetBoolean(interp, argv[2], &render_type) != TCL_OK)
	return (TCL_ERROR);

    /* Call the function */
    GK_do_framestep((int)step, render_type);

    return (TCL_OK);

}
Example #3
0
/*
** Usage:   btree_cursor ID TABLENUM WRITEABLE
**
** Create a new cursor.  Return the ID for the cursor.
*/
static int btree_cursor(
  void *NotUsed,
  Tcl_Interp *interp,    /* The TCL interpreter that invoked this command */
  int argc,              /* Number of arguments */
  const char **argv      /* Text of each argument */
){
  Btree *pBt;
  int iTable;
  BtCursor *pCur;
  int rc;
  int wrFlag;
  char zBuf[30];

  if( argc!=4 ){
    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
       " ID TABLENUM WRITEABLE\"", 0);
    return TCL_ERROR;
  }
  pBt = sqlite3TestTextToPtr(argv[1]);
  if( Tcl_GetInt(interp, argv[2], &iTable) ) return TCL_ERROR;
  if( Tcl_GetBoolean(interp, argv[3], &wrFlag) ) return TCL_ERROR;
  pCur = (BtCursor *)ckalloc(sqlite3BtreeCursorSize());
  memset(pCur, 0, sqlite3BtreeCursorSize());
  sqlite3BtreeEnter(pBt);
  rc = sqlite3BtreeCursor(pBt, iTable, wrFlag, 0, pCur);
  sqlite3BtreeLeave(pBt);
  if( rc ){
    ckfree((char *)pCur);
    Tcl_AppendResult(interp, errorName(rc), 0);
    return TCL_ERROR;
  }
  sqlite3_snprintf(sizeof(zBuf), zBuf,"%p", pCur);
  Tcl_AppendResult(interp, zBuf, 0);
  return SQLITE_OK;
}
Example #4
0
int AsnBool::TclSetVal (Tcl_Interp *interp, const char *valstr)
{
  int valval;

  if (Tcl_GetBoolean (interp, (char*) valstr, &valval) != TCL_OK)
    return TCL_ERROR;

  value = valval;

  return TCL_OK;
}
Example #5
0
static int
winprint_print_text_options (struct winprint_data *wd, Tcl_Interp *interp,
			     int argc, char **argv,
			     struct print_text_options *pto)
{
  int i;

  pto->dialog = 1;
  pto->parent = NULL;
  pto->name = "";
  pto->pageproc = NULL;
  pto->postscript = 0;
  pto->initproc = NULL;
  
  for (i = 4; i < argc; i += 2)
    {
      if (i + 1 >= argc)
	{
	  Tcl_ResetResult (interp);
	  Tcl_AppendStringsToObj (Tcl_GetObjResult (interp),
				  "value for \"", argv[i], "\" missing",
				  (char *) NULL);
	  return TCL_ERROR;
	}

      if (strcmp (argv[i], "-dialog") == 0)
	{
	  if (Tcl_GetBoolean (interp, argv[i + 1], &pto->dialog) != TCL_OK)
	    return TCL_ERROR;
	}
      else if (strcmp (argv[i], "-parent") == 0)
	pto->parent = argv[i + 1];
      else if (strcmp (argv[i], "-name") == 0)
	pto->name = argv[i + 1];
      else if (strcmp (argv[i], "-pageproc") == 0)
	pto->pageproc = argv[i + 1];
      else if (strcmp (argv[i], "-initproc") == 0)
	pto->initproc = argv[i + 1];
      else if (strcmp (argv[i], "-postscript") == 0)
	pto->postscript = 1;
      else
	{
	  Tcl_ResetResult (interp);
	  Tcl_AppendStringsToObj (Tcl_GetObjResult (interp),
				  "unknown option \"", argv[i], "\"",
				  (char *) NULL);
	  return TCL_ERROR;
	}
    }

  return TCL_OK;
}
Example #6
0
/*
 * Options for bits in an int
 * This will set/clear one bit in an int, the specific bit
 * being passed in clientData
 */
int
Cmd_BitSet(ClientData clientData, Tcl_Interp *interp,
	   Tk_Window unused, char *value, char *widgRec, int offset)
{
  int mode;
  if (Tcl_GetBoolean(interp, value, &mode) != TCL_OK) {
    return TCL_ERROR;
  }
  if (mode) {
    *((int*)(widgRec+offset)) |= (int)clientData;
  } else {
    *((int*)(widgRec+offset)) &= ~((int)clientData);
  }
  return TCL_OK;
}
Example #7
0
// turn them on or off
static int tcl_graphics_materials(MoleculeGraphics *gmol,
				  int argc, const char *argv[],
				  Tcl_Interp *interp)
{
  MUST_HAVE(1, "materials");
  int val;
  if (Tcl_GetBoolean(interp, argv[0], &val) != TCL_OK) {
    return TCL_ERROR;
  }
  
  // enable/disable materials
  char tmpstring[64];
  sprintf(tmpstring, "%d", gmol->use_materials(val));
  Tcl_SetResult(interp, tmpstring, TCL_VOLATILE);
  return TCL_OK;
}
Example #8
0
/*
** For the markup <a href=XXX>, find out if the URL has been visited
** before or not.  Return COLOR_Visited or COLOR_Unvisited, as
** appropriate.
**
** This routine may invoke a callback procedure which could delete
** the HTML widget.  The calling function should call HtmlLock()
** if it needs the widget structure to be preserved.
*/
static int GetLinkColor(HtmlWidget *htmlPtr, char *zURL){
  char *zCmd;
  int result;
  int isVisited;

  if( htmlPtr->tkwin==0 ){
    TestPoint(0);
    return COLOR_Normal;
  }
  if( htmlPtr->zIsVisited==0 || htmlPtr->zIsVisited[0]==0 ){
    TestPoint(0);
    return COLOR_Unvisited;
  }
  zCmd = HtmlAlloc( strlen(htmlPtr->zIsVisited) + strlen(zURL) + 10 );
  if( zCmd==0 ){
    TestPoint(0);
    return COLOR_Unvisited;
  }
  sprintf(zCmd,"%s {%s}",htmlPtr->zIsVisited, zURL);
  HtmlLock(htmlPtr);
  result = Tcl_GlobalEval(htmlPtr->interp,zCmd);
  HtmlFree(zCmd);
  if( HtmlUnlock(htmlPtr) ){
    return COLOR_Unvisited;
  }
  if( result!=TCL_OK ){
    TestPoint(0);
    goto errorOut;
  }
  result = Tcl_GetBoolean(htmlPtr->interp,
                          Tcl_GetStringResult(htmlPtr->interp), &isVisited);
  if( result!=TCL_OK ){
    TestPoint(0);
    goto errorOut;
  }
  TestPoint(0);
  return isVisited ? COLOR_Visited : COLOR_Unvisited;

  errorOut:
  Tcl_AddErrorInfo(htmlPtr->interp,
    "\n    (\"-isvisitedcommand\" command executed by html widget)");
  Tcl_BackgroundError(htmlPtr->interp);
  TestPoint(0);
  return COLOR_Unvisited;
}
Example #9
0
static void
SetHelpMenu(
    TkMenu *menuPtr)		/* The menu we are checking */
{
    TkMenuEntry *cascadeEntryPtr;
    int useMotifHelp = 0;
    const char *option = NULL;
    if (menuPtr->tkwin) {
	option = Tk_GetOption(menuPtr->tkwin, "useMotifHelp", "UseMotifHelp");
	if (option != NULL) {
	    Tcl_GetBoolean(NULL, option, &useMotifHelp);
	}
    }

    if (!useMotifHelp) {
	return;
    }

    for (cascadeEntryPtr = menuPtr->menuRefPtr->parentEntryPtr;
	    cascadeEntryPtr != NULL;
	    cascadeEntryPtr = cascadeEntryPtr->nextCascadePtr) {
	if ((cascadeEntryPtr->menuPtr->menuType == MENUBAR)
		&& (cascadeEntryPtr->menuPtr->masterMenuPtr->tkwin != NULL)
		&& (menuPtr->masterMenuPtr->tkwin != NULL)) {
	    TkMenu *masterMenuPtr = cascadeEntryPtr->menuPtr->masterMenuPtr;
	    char *helpMenuName = ckalloc(strlen(Tk_PathName(
		    masterMenuPtr->tkwin)) + strlen(".help") + 1);

	    strcpy(helpMenuName, Tk_PathName(masterMenuPtr->tkwin));
	    strcat(helpMenuName, ".help");
	    if (strcmp(helpMenuName,
		    Tk_PathName(menuPtr->masterMenuPtr->tkwin)) == 0) {
		cascadeEntryPtr->entryFlags |= ENTRY_HELP_MENU;
	    } else {
		cascadeEntryPtr->entryFlags &= ~ENTRY_HELP_MENU;
	    }
	    ckfree(helpMenuName);
	}
    }
}
Example #10
0
int Nshow_path_cmd(Nv_data * data,	/* Local data */
		   Tcl_Interp * interp,	/* Current interpreter */
		   int argc,	/* Number of arguments */
		   char **argv	/* Argument strings */
    )
{
    int arg1;

    /* Parse arguments */
    if (argc != 2) {
	Tcl_SetResult(interp, "Error: should be Nshow_path [ TRUE | FALSE] ", TCL_VOLATILE);
	return (TCL_ERROR);
    }

    /* Parse out the boolean value */
    if (Tcl_GetBoolean(interp, argv[1], &arg1) != TCL_OK)
	return (TCL_ERROR);

    /* Call the function */
    GK_show_path(arg1);

    return (TCL_OK);

}
Example #11
0
// a cylinder has endpoints, radius, and resolution
static int tcl_graphics_cylinder(MoleculeGraphics *gmol, 
				 int argc, const char *argv[],
				 Tcl_Interp *interp)
{
  // the first two are {x, y, z} coordinates
  AT_LEAST(2, "cylinder");
  float vals[6];
  if (tcl_get_vector(argv[0], vals+0,  interp) != TCL_OK ||
      tcl_get_vector(argv[1], vals+3,  interp) != TCL_OK) {
    return TCL_ERROR;
  }
  
  // get the optional values
  double radius = 1.0;
  int resolution = 6;
  int filled = 0;
  argc -= 2;
  argv += 2;
  if (argc %2) {
    Tcl_SetResult(interp, (char *) "graphics: cylinder has wrong number of options", TCL_STATIC);
    return TCL_ERROR;
  }
  while (argc) {
    if (!strcmp(argv[0], "radius")) {
      if (Tcl_GetDouble(interp, argv[1], &radius) != TCL_OK) {
	return TCL_ERROR;
      }
      if (radius <0) radius = 0;
      argc -= 2;
      argv += 2;
      continue;
    }
    if (!strcmp(argv[0], "resolution")) {
      if (Tcl_GetInt(interp, argv[1], &resolution) != TCL_OK) {
	return TCL_ERROR;
      }
      if (resolution < 0) resolution = 0;
      if (resolution > 30) resolution = 30;
      argc -= 2;
      argv += 2;
      continue;
    }
    if (!strcmp(argv[0], "filled")) {
      if (Tcl_GetBoolean(interp, argv[1], &filled) != TCL_OK) {
	return TCL_ERROR;
      }
      argc -= 2;
      argv += 2;
      continue;
    }
    // reaching here is an error
    Tcl_AppendResult(interp, "graphics: unknown option for cylinder: ",
		     argv[0], NULL);
    return TCL_ERROR;
  }
  
  // I have a cylinder, so add it
  char tmpstring[64];
  sprintf(tmpstring, "%d",
	  gmol->add_cylinder(vals+0, vals+3, (float) radius, resolution, filled));
  Tcl_SetResult(interp, tmpstring, TCL_VOLATILE);
  return TCL_OK;
}
Example #12
0
static int
TtySetOptionProc(
    ClientData instanceData,	/* File state. */
    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
    const char *optionName,	/* Which option to set? */
    const char *value)		/* New value for option. */
{
    FileState *fsPtr = instanceData;
    unsigned int len, vlen;
    TtyAttrs tty;
    int argc;
    const char **argv;
    struct termios iostate;

    len = strlen(optionName);
    vlen = strlen(value);

    /*
     * Option -mode baud,parity,databits,stopbits
     */

    if ((len > 2) && (strncmp(optionName, "-mode", len) == 0)) {
	if (TtyParseMode(interp, value, &tty) != TCL_OK) {
	    return TCL_ERROR;
	}

	/*
	 * system calls results should be checked there. - dl
	 */

	TtySetAttributes(fsPtr->fd, &tty);
	return TCL_OK;
    }


    /*
     * Option -handshake none|xonxoff|rtscts|dtrdsr
     */

    if ((len > 1) && (strncmp(optionName, "-handshake", len) == 0)) {
	/*
	 * Reset all handshake options. DTR and RTS are ON by default.
	 */

	tcgetattr(fsPtr->fd, &iostate);
	CLEAR_BITS(iostate.c_iflag, IXON | IXOFF | IXANY);
#ifdef CRTSCTS
	CLEAR_BITS(iostate.c_cflag, CRTSCTS);
#endif /* CRTSCTS */
	if (Tcl_UtfNcasecmp(value, "NONE", vlen) == 0) {
	    /*
	     * Leave all handshake options disabled.
	     */
	} else if (Tcl_UtfNcasecmp(value, "XONXOFF", vlen) == 0) {
	    SET_BITS(iostate.c_iflag, IXON | IXOFF | IXANY);
	} else if (Tcl_UtfNcasecmp(value, "RTSCTS", vlen) == 0) {
#ifdef CRTSCTS
	    SET_BITS(iostate.c_cflag, CRTSCTS);
#else /* !CRTSTS */
	    UNSUPPORTED_OPTION("-handshake RTSCTS");
	    return TCL_ERROR;
#endif /* CRTSCTS */
	} else if (Tcl_UtfNcasecmp(value, "DTRDSR", vlen) == 0) {
	    UNSUPPORTED_OPTION("-handshake DTRDSR");
	    return TCL_ERROR;
	} else {
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"bad value for -handshake: must be one of"
			" xonxoff, rtscts, dtrdsr or none", -1));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE",
			"VALUE", NULL);
	    }
	    return TCL_ERROR;
	}
	tcsetattr(fsPtr->fd, TCSADRAIN, &iostate);
	return TCL_OK;
    }

    /*
     * Option -xchar {\x11 \x13}
     */

    if ((len > 1) && (strncmp(optionName, "-xchar", len) == 0)) {
	Tcl_DString ds;

	if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) {
	    return TCL_ERROR;
	} else if (argc != 2) {
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"bad value for -xchar: should be a list of"
			" two elements", -1));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE",
			"VALUE", NULL);
	    }
	    ckfree(argv);
	    return TCL_ERROR;
	}

	tcgetattr(fsPtr->fd, &iostate);

	Tcl_UtfToExternalDString(NULL, argv[0], -1, &ds);
	iostate.c_cc[VSTART] = *(const cc_t *) Tcl_DStringValue(&ds);
	TclDStringClear(&ds);

	Tcl_UtfToExternalDString(NULL, argv[1], -1, &ds);
	iostate.c_cc[VSTOP] = *(const cc_t *) Tcl_DStringValue(&ds);
	Tcl_DStringFree(&ds);
	ckfree(argv);

	tcsetattr(fsPtr->fd, TCSADRAIN, &iostate);
	return TCL_OK;
    }

    /*
     * Option -timeout msec
     */

    if ((len > 2) && (strncmp(optionName, "-timeout", len) == 0)) {
	int msec;

	tcgetattr(fsPtr->fd, &iostate);
	if (Tcl_GetInt(interp, value, &msec) != TCL_OK) {
	    return TCL_ERROR;
	}
	iostate.c_cc[VMIN] = 0;
	iostate.c_cc[VTIME] = (msec==0) ? 0 : (msec<100) ? 1 : (msec+50)/100;
	tcsetattr(fsPtr->fd, TCSADRAIN, &iostate);
	return TCL_OK;
    }

    /*
     * Option -ttycontrol {DTR 1 RTS 0 BREAK 0}
     */
    if ((len > 4) && (strncmp(optionName, "-ttycontrol", len) == 0)) {
#if defined(TIOCMGET) && defined(TIOCMSET)
	int i, control, flag;

	if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) {
	    return TCL_ERROR;
	}
	if ((argc % 2) == 1) {
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"bad value for -ttycontrol: should be a list of"
			" signal,value pairs", -1));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE",
			"VALUE", NULL);
	    }
	    ckfree(argv);
	    return TCL_ERROR;
	}

	ioctl(fsPtr->fd, TIOCMGET, &control);
	for (i = 0; i < argc-1; i += 2) {
	    if (Tcl_GetBoolean(interp, argv[i+1], &flag) == TCL_ERROR) {
		ckfree(argv);
		return TCL_ERROR;
	    }
	    if (Tcl_UtfNcasecmp(argv[i], "DTR", strlen(argv[i])) == 0) {
		if (flag) {
		    SET_BITS(control, TIOCM_DTR);
		} else {
		    CLEAR_BITS(control, TIOCM_DTR);
		}
	    } else if (Tcl_UtfNcasecmp(argv[i], "RTS", strlen(argv[i])) == 0) {
		if (flag) {
		    SET_BITS(control, TIOCM_RTS);
		} else {
		    CLEAR_BITS(control, TIOCM_RTS);
		}
	    } else if (Tcl_UtfNcasecmp(argv[i], "BREAK", strlen(argv[i])) == 0) {
#if defined(TIOCSBRK) && defined(TIOCCBRK)
		if (flag) {
		    ioctl(fsPtr->fd, TIOCSBRK, NULL);
		} else {
		    ioctl(fsPtr->fd, TIOCCBRK, NULL);
		}
#else /* TIOCSBRK & TIOCCBRK */
		UNSUPPORTED_OPTION("-ttycontrol BREAK");
		ckfree(argv);
		return TCL_ERROR;
#endif /* TIOCSBRK & TIOCCBRK */
	    } else {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "bad signal \"%s\" for -ttycontrol: must be"
			    " DTR, RTS or BREAK", argv[i]));
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE",
			"VALUE", NULL);
		}
		ckfree(argv);
		return TCL_ERROR;
	    }
	} /* -ttycontrol options loop */

	ioctl(fsPtr->fd, TIOCMSET, &control);
	ckfree(argv);
	return TCL_OK;
#else /* TIOCMGET&TIOCMSET */
	UNSUPPORTED_OPTION("-ttycontrol");
#endif /* TIOCMGET&TIOCMSET */
    }

    return Tcl_BadChannelOption(interp, optionName,
	    "mode handshake timeout ttycontrol xchar");
}
Example #13
0
int text_cmd_tool(ClientData cd, Tcl_Interp *interp, int argc,
                            const char *argv[]) {

  VMDApp *app = (VMDApp *)cd;
  CommandQueue *cmdQueue = app->commandQueue;

  char buf[400];

  if(argc<2) {
    Tcl_SetResult(interp, 
      (char *)
      "tool create <type> [<name> [<name> ...]]\n"
      "tool change <type> [<toolid>]\n"
      "tool scale <scale> [<toolid>]\n"
      "tool scaleforce <scale> [<toolid>]\n"
      "tool offset <x> <y> <z> [<toolid>]\n"
      "tool delete [<toolid>]\n"
#if 0
      "tool info [<toolid>]\n"
#endif
      "tool rep <toolid> <mol id> <rep id>\n"
      "tool adddevice <name> [<toolid>]\n"
      "tool removedevice <name> [<toolid>]\n"
      "tool callback on/off",
      TCL_STATIC);
    return TCL_ERROR;
  }

  /* creating a new tool with some number of USLs */
  if(!strupncmp(argv[1], "create", CMDLEN) && argc>=3) {
    if (!app->tool_create(argv[2], argc-3, argv+3)) {
      Tcl_AppendResult(interp, "Failed to create new tool.", NULL);
      return TCL_ERROR;
    }
    return TCL_OK;
  } 

  /* changing the tool but preserving the sensor */
  if(!strupncmp(argv[1], "change", CMDLEN) && (argc==4 || argc==3)) {
    int i=0;

    if(argc==4) { // default to 0
      if (Tcl_GetInt(interp, argv[3], &i) != TCL_OK) 
        return TCL_ERROR;
    }
    if (!app->tool_change_type(i, argv[2])) {
      Tcl_AppendResult(interp, "Unable to change tool type.", NULL);
      return TCL_ERROR;
    }
    return TCL_OK;
  }

  /* Setting the scale of a tool */
  if(!strupncmp(argv[1], "scale", CMDLEN) && (argc==3 || argc==4)) {
    int i=0;
    double dscale=0.0;
    float scale=0.0f;
    if(argc==4) {  // default to 0
      if (Tcl_GetInt(interp, argv[3], &i) != TCL_OK) 
        return TCL_ERROR;
    }
    if (Tcl_GetDouble(interp, argv[2], &dscale) != TCL_OK)
      return TCL_ERROR;
    scale = (float)dscale;
    if (app->tool_set_position_scale(i, scale)) {
      return TCL_OK;
    }
    Tcl_AppendResult(interp, "Unable to set position scale", NULL);
    return TCL_ERROR;
  }

  /* Setting the scale of the force on a tool */
  if(!strupncmp(argv[1], "scaleforce", CMDLEN) && (argc==3 || argc==4)) {
    int i=0;
    double dscale=0;
    float scale=0;
    if(argc==4) {  // default to 0
      if (Tcl_GetInt(interp, argv[3], &i) != TCL_OK)
        return TCL_ERROR;
    }
    if (Tcl_GetDouble(interp, argv[2], &dscale) != TCL_OK)
      return TCL_ERROR;
    scale = (float)dscale;
    if (app->tool_set_force_scale(i, scale))
      return TCL_OK;
    Tcl_AppendResult(interp, "Unable to set force scale", NULL);
    return TCL_ERROR;
  }

  /* Setting the scale of the spring on a tool */
  if(!strupncmp(argv[1], "scalespring", CMDLEN) && (argc==3 || argc==4)) {
    int i=0;
    double dscale=0;
    float scale=0;
    if(argc==4) { // default to 0
      if (Tcl_GetInt(interp, argv[3], &i) != TCL_OK)
        return TCL_ERROR;
    }
    if (Tcl_GetDouble(interp, argv[2], &dscale) != TCL_OK)
      return TCL_ERROR;
    scale = (float)dscale;
    if (app->tool_set_spring_scale(i, scale))
      return TCL_OK;
    Tcl_AppendResult(interp, "Unable to set spring scale", NULL);
    return TCL_ERROR;
  }

  /* Setting the offset of a tool */
  if(!strupncmp(argv[1], "offset", CMDLEN) && (argc==5 || argc==6)) {
    int i=0,j;
    double d_offset[3];
    float offset[3];
    if(argc==6) { // default to 0
      if (Tcl_GetInt(interp, argv[5], &i) != TCL_OK)
        return TCL_ERROR;
    }
    
    if (Tcl_GetDouble(interp, argv[2], &d_offset[0]) != TCL_OK)
      return TCL_ERROR;
    if (Tcl_GetDouble(interp, argv[3], &d_offset[1]) != TCL_OK)
      return TCL_ERROR;
    if (Tcl_GetDouble(interp, argv[4], &d_offset[2]) != TCL_OK)
      return TCL_ERROR;
    for(j=0;j<3;j++) offset[j] = (float)d_offset[j];
    cmdQueue->runcommand(new CmdToolOffset(offset,i));

    sprintf(buf,"Setting offset of tool %i.", i);
    Tcl_AppendResult(interp, buf, NULL);
    return TCL_OK;

  }

  /* deleting a tool */
  if(!strupncmp(argv[1], "delete", CMDLEN) && (argc==3 || argc==2)) {
    int i=0;

    if(argc==3) { // default to 0
      if (Tcl_GetInt(interp, argv[2], &i) != TCL_OK)
        return TCL_ERROR;
    }
    cmdQueue->runcommand(new CmdToolDelete(i));
    sprintf(buf,"Deleting tool %i.\n",i);
    Tcl_AppendResult(interp, buf, NULL);
    return TCL_OK;
  }

#if 0 // XXX
  /* getting info about a tool */
  if(!strupncmp(argv[1], "info", CMDLEN) && (argc==3 || argc==2)) {
    int i=0;
    Tool *tool;

    if(argc==3) {  // default to 0
      if (Tcl_GetInt(interp, argv[2], &i) != TCL_OK)
        return TCL_ERROR;
    }
    tool = vmdGlobal.uiVR->gettool(i);
    if(tool==NULL) {
      Tcl_AppendResult(interp, "No such tool.", NULL);
      return TCL_ERROR;
    }

    sprintf(buf,"Info for tool %i (%s)\n",i,tool->type_name());
    Tcl_AppendResult(interp,buf, NULL);

    const float *pos = tool->position();
    const Matrix4 *rot = tool->orientation();
    if(pos==NULL) {
      Tcl_AppendResult(interp, "Tool has no position!", NULL);
      return TCL_ERROR;
    }
      
    sprintf(buf,"Postion: %.2f %.2f %.2f\n"
	    "Orientation: %.2f %.2f %.2f\n"
	    "             %.2f %.2f %.2f\n"
	    "             %.2f %.2f %.2f\n",
	    pos[0],pos[1],pos[2],
	    rot->mat[4*0+0],rot->mat[4*0+1],rot->mat[4*0+2],
	    rot->mat[4*1+0],rot->mat[4*1+1],rot->mat[4*1+2],
	    rot->mat[4*2+0],rot->mat[4*2+1],rot->mat[4*2+2]);

    Tcl_AppendResult(interp,buf, NULL);

    int j=0;
    char *devices[5];
    const float *offset;
    float scale;

    offset = tool->getoffset();
    if(offset==NULL) {
      Tcl_AppendResult(interp, "tool info:\n",
        "NULL Offset...?\n", NULL); 
      return TCL_ERROR;
    }

    scale = tool->getscale();

    tool->getdevices(devices);
    JString buf2;
    while(devices[j]!=NULL) {
      buf2 += devices[j++];
      buf2 += " ";
    }

    sprintf(buf,"Scale: %.2f\n"
	    "Offset: %.2f %.2f %.2f\n"
	    "USL: %s\n", scale, offset[0],
	    offset[1], offset[2], (const char *)buf2);

    Tcl_AppendResult(interp,buf, NULL);

    return TCL_OK;
  }

#endif  

  /* Assigning a representation to a tool */
  if(!strupncmp(argv[1], "rep", CMDLEN)) {
    if (argc != 3 && argc != 5) {
      Tcl_AppendResult(interp, "tool rep usage:\n",
        "Usage: tool rep toolnum [molid repnum]", NULL); 
      return TCL_ERROR;
    }
    int toolnum, molid, repnum;
    toolnum = atoi(argv[2]);
    if (argc == 5) {
      molid = atoi(argv[3]);
      repnum = atoi(argv[4]);
    } else {
      molid = repnum = -1;
    }
    cmdQueue->runcommand(new CmdToolRep(toolnum, molid, repnum));
    return TCL_OK;
  }

  /* Adding a device to a tool */
  if(!strupncmp(argv[1], "adddevice", CMDLEN) &&
     (argc == 3 || argc == 4)) {
    int i=0;

    if(argc==4) { // default to 0
      if (Tcl_GetInt(interp, argv[3], &i) != TCL_OK)
        return TCL_ERROR;
    }
    cmdQueue->runcommand(new CmdToolAddDevice(argv[2],i));
    return TCL_OK;
  }

  /* Removing a device to a tool */
  if(!strupncmp(argv[1], "removedevice", CMDLEN) &&
     (argc == 3 || argc == 4)) {
    int i=0;

    if(argc==4) { // default to 0
      if (Tcl_GetInt(interp, argv[3], &i) != TCL_OK)
        return TCL_ERROR;
    }
    cmdQueue->runcommand(new CmdToolDeleteDevice(argv[2],i));
    return TCL_OK;
  }

  /* Turning on callbacks for a tool */
  if(!strupncmp(argv[1], "callback", CMDLEN)) {
    if(argc==3) {
      int on=-1;
      if (Tcl_GetBoolean(interp, argv[2], &on) != TCL_OK)
        return TCL_ERROR;
      if(on!=-1) {
	cmdQueue->runcommand(new CmdToolCallback(on));
	return TCL_OK;
      }
    }
    Tcl_AppendResult(interp," tool callback usage:\n",
		     "Usage: tool callback on/off [<toolid>]",NULL);
    return TCL_ERROR;
  }
    
  return TCL_ERROR;
}
Example #14
0
static int
DoConfig(
    Tcl_Interp *interp,		/* Interpreter for error reporting. */
    Tk_Window tkwin,		/* Window containing widget (needed to set up
				 * X resources). */
    Tk_ConfigSpec *specPtr,	/* Specifier to apply. */
    Tk_Uid value,		/* Value to use to fill in widgRec. */
    int valueIsUid,		/* Non-zero means value is a Tk_Uid; zero
				 * means it's an ordinary string. */
    char *widgRec)		/* Record whose fields are to be modified.
				 * Values must be properly initialized. */
{
    char *ptr;
    Tk_Uid uid;
    int nullValue;

    nullValue = 0;
    if ((*value == 0) && (specPtr->specFlags & TK_CONFIG_NULL_OK)) {
        nullValue = 1;
    }

    do {
        ptr = widgRec + specPtr->offset;
        switch (specPtr->type) {
        case TK_CONFIG_BOOLEAN:
            if (Tcl_GetBoolean(interp, value, (int *) ptr) != TCL_OK) {
                return TCL_ERROR;
            }
            break;
        case TK_CONFIG_INT:
            if (Tcl_GetInt(interp, value, (int *) ptr) != TCL_OK) {
                return TCL_ERROR;
            }
            break;
        case TK_CONFIG_DOUBLE:
            if (Tcl_GetDouble(interp, value, (double *) ptr) != TCL_OK) {
                return TCL_ERROR;
            }
            break;
        case TK_CONFIG_STRING: {
            char *oldStr, *newStr;

            if (nullValue) {
                newStr = NULL;
            } else {
                newStr = (char *) ckalloc((unsigned) (strlen(value) + 1));
                strcpy(newStr, value);
            }
            oldStr = *((char **) ptr);
            if (oldStr != NULL) {
                ckfree(oldStr);
            }
            *((char **) ptr) = newStr;
            break;
        }
        case TK_CONFIG_UID:
            if (nullValue) {
                *((Tk_Uid *) ptr) = NULL;
            } else {
                uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
                *((Tk_Uid *) ptr) = uid;
            }
            break;
        case TK_CONFIG_COLOR: {
            XColor *newPtr, *oldPtr;

            if (nullValue) {
                newPtr = NULL;
            } else {
                uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
                newPtr = Tk_GetColor(interp, tkwin, uid);
                if (newPtr == NULL) {
                    return TCL_ERROR;
                }
            }
            oldPtr = *((XColor **) ptr);
            if (oldPtr != NULL) {
                Tk_FreeColor(oldPtr);
            }
            *((XColor **) ptr) = newPtr;
            break;
        }
        case TK_CONFIG_FONT: {
            Tk_Font newFont;

            if (nullValue) {
                newFont = NULL;
            } else {
                newFont = Tk_GetFont(interp, tkwin, value);
                if (newFont == NULL) {
                    return TCL_ERROR;
                }
            }
            Tk_FreeFont(*((Tk_Font *) ptr));
            *((Tk_Font *) ptr) = newFont;
            break;
        }
        case TK_CONFIG_BITMAP: {
            Pixmap newBmp, oldBmp;

            if (nullValue) {
                newBmp = None;
            } else {
                uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
                newBmp = Tk_GetBitmap(interp, tkwin, uid);
                if (newBmp == None) {
                    return TCL_ERROR;
                }
            }
            oldBmp = *((Pixmap *) ptr);
            if (oldBmp != None) {
                Tk_FreeBitmap(Tk_Display(tkwin), oldBmp);
            }
            *((Pixmap *) ptr) = newBmp;
            break;
        }
        case TK_CONFIG_BORDER: {
            Tk_3DBorder newBorder, oldBorder;

            if (nullValue) {
                newBorder = NULL;
            } else {
                uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
                newBorder = Tk_Get3DBorder(interp, tkwin, uid);
                if (newBorder == NULL) {
                    return TCL_ERROR;
                }
            }
            oldBorder = *((Tk_3DBorder *) ptr);
            if (oldBorder != NULL) {
                Tk_Free3DBorder(oldBorder);
            }
            *((Tk_3DBorder *) ptr) = newBorder;
            break;
        }
        case TK_CONFIG_RELIEF:
            uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
            if (Tk_GetRelief(interp, uid, (int *) ptr) != TCL_OK) {
                return TCL_ERROR;
            }
            break;
        case TK_CONFIG_CURSOR:
        case TK_CONFIG_ACTIVE_CURSOR: {
            Tk_Cursor newCursor, oldCursor;

            if (nullValue) {
                newCursor = None;
            } else {
                uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
                newCursor = Tk_GetCursor(interp, tkwin, uid);
                if (newCursor == None) {
                    return TCL_ERROR;
                }
            }
            oldCursor = *((Tk_Cursor *) ptr);
            if (oldCursor != None) {
                Tk_FreeCursor(Tk_Display(tkwin), oldCursor);
            }
            *((Tk_Cursor *) ptr) = newCursor;
            if (specPtr->type == TK_CONFIG_ACTIVE_CURSOR) {
                Tk_DefineCursor(tkwin, newCursor);
            }
            break;
        }
        case TK_CONFIG_JUSTIFY:
            uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
            if (Tk_GetJustify(interp, uid, (Tk_Justify *) ptr) != TCL_OK) {
                return TCL_ERROR;
            }
            break;
        case TK_CONFIG_ANCHOR:
            uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
            if (Tk_GetAnchor(interp, uid, (Tk_Anchor *) ptr) != TCL_OK) {
                return TCL_ERROR;
            }
            break;
        case TK_CONFIG_CAP_STYLE:
            uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
            if (Tk_GetCapStyle(interp, uid, (int *) ptr) != TCL_OK) {
                return TCL_ERROR;
            }
            break;
        case TK_CONFIG_JOIN_STYLE:
            uid = valueIsUid ? (Tk_Uid) value : Tk_GetUid(value);
            if (Tk_GetJoinStyle(interp, uid, (int *) ptr) != TCL_OK) {
                return TCL_ERROR;
            }
            break;
        case TK_CONFIG_PIXELS:
            if (Tk_GetPixels(interp, tkwin, value, (int *) ptr)
                    != TCL_OK) {
                return TCL_ERROR;
            }
            break;
        case TK_CONFIG_MM:
            if (Tk_GetScreenMM(interp, tkwin, value, (double*)ptr) != TCL_OK) {
                return TCL_ERROR;
            }
            break;
        case TK_CONFIG_WINDOW: {
            Tk_Window tkwin2;

            if (nullValue) {
                tkwin2 = NULL;
            } else {
                tkwin2 = Tk_NameToWindow(interp, value, tkwin);
                if (tkwin2 == NULL) {
                    return TCL_ERROR;
                }
            }
            *((Tk_Window *) ptr) = tkwin2;
            break;
        }
        case TK_CONFIG_CUSTOM:
            if ((*specPtr->customPtr->parseProc)(
                        specPtr->customPtr->clientData, interp, tkwin, value,
                        widgRec, specPtr->offset) != TCL_OK) {
                return TCL_ERROR;
            }
            break;
        default: {
            char buf[64 + TCL_INTEGER_SPACE];

            sprintf(buf, "bad config table: unknown type %d", specPtr->type);
            Tcl_SetResult(interp, buf, TCL_VOLATILE);
            return TCL_ERROR;
        }
        }
        specPtr++;
    } while ((specPtr->argvName == NULL) && (specPtr->type != TK_CONFIG_END));
    return TCL_OK;
}
Example #15
0
int
TkTextTagCmd(
    register TkText *textPtr,	/* Information about text widget. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. Someone else has already
				 * parsed this command enough to know that
				 * objv[1] is "tag". */
{
    static const char *const tagOptionStrings[] = {
	"add", "bind", "cget", "configure", "delete", "lower", "names",
	"nextrange", "prevrange", "raise", "ranges", "remove", NULL
    };
    enum tagOptions {
	TAG_ADD, TAG_BIND, TAG_CGET, TAG_CONFIGURE, TAG_DELETE, TAG_LOWER,
	TAG_NAMES, TAG_NEXTRANGE, TAG_PREVRANGE, TAG_RAISE, TAG_RANGES,
	TAG_REMOVE
    };
    int optionIndex, i;
    register TkTextTag *tagPtr;
    TkTextIndex index1, index2;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 2, objv, "option ?arg ...?");
	return TCL_ERROR;
    }

    if (Tcl_GetIndexFromObjStruct(interp, objv[2], tagOptionStrings,
	    sizeof(char *), "tag option", 0, &optionIndex) != TCL_OK) {
	return TCL_ERROR;
    }

    switch ((enum tagOptions)optionIndex) {
    case TAG_ADD:
    case TAG_REMOVE: {
	int addTag;

	if (((enum tagOptions)optionIndex) == TAG_ADD) {
	    addTag = 1;
	} else {
	    addTag = 0;
	}
	if (objc < 5) {
	    Tcl_WrongNumArgs(interp, 3, objv,
		    "tagName index1 ?index2 index1 index2 ...?");
	    return TCL_ERROR;
	}
	tagPtr = TkTextCreateTag(textPtr, Tcl_GetString(objv[3]), NULL);
	if (tagPtr->elide) {
		/*
		* Indices are potentially obsolete after adding or removing
		* elided character ranges, especially indices having "display"
		* or "any" submodifier, therefore increase the epoch.
		*/
		textPtr->sharedTextPtr->stateEpoch++;
	}
	for (i = 4; i < objc; i += 2) {
	    if (TkTextGetObjIndex(interp, textPtr, objv[i],
		    &index1) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (objc > (i+1)) {
		if (TkTextGetObjIndex(interp, textPtr, objv[i+1],
			&index2) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (TkTextIndexCmp(&index1, &index2) >= 0) {
		    return TCL_OK;
		}
	    } else {
		index2 = index1;
		TkTextIndexForwChars(NULL,&index2, 1, &index2, COUNT_INDICES);
	    }

	    if (tagPtr->affectsDisplay) {
		TkTextRedrawTag(textPtr->sharedTextPtr, NULL, &index1, &index2,
			tagPtr, !addTag);
	    } else {
		/*
		 * Still need to trigger enter/leave events on tags that have
		 * changed.
		 */

		TkTextEventuallyRepick(textPtr);
	    }
	    if (TkBTreeTag(&index1, &index2, tagPtr, addTag)) {
		/*
		 * If the tag is "sel", and we actually adjusted something
		 * then grab the selection if we're supposed to export it and
		 * don't already have it.
		 *
		 * Also, invalidate partially-completed selection retrievals.
		 * We only need to check whether the tag is "sel" for this
		 * textPtr (not for other peer widget's "sel" tags) because we
		 * cannot reach this code path with a different widget's "sel"
		 * tag.
		 */

		if (tagPtr == textPtr->selTagPtr) {
		    /*
		     * Send an event that the selection changed. This is
		     * equivalent to:
		     *	   event generate $textWidget <<Selection>>
		     */

		    TkTextSelectionEvent(textPtr);

		    if (addTag && textPtr->exportSelection
			    && !(textPtr->flags & GOT_SELECTION)) {
			Tk_OwnSelection(textPtr->tkwin, XA_PRIMARY,
				TkTextLostSelection, textPtr);
			textPtr->flags |= GOT_SELECTION;
		    }
		    textPtr->abortSelections = 1;
		}
	    }
	}
	break;
    }
    case TAG_BIND:
	if ((objc < 4) || (objc > 6)) {
	    Tcl_WrongNumArgs(interp, 3, objv, "tagName ?sequence? ?command?");
	    return TCL_ERROR;
	}
	tagPtr = TkTextCreateTag(textPtr, Tcl_GetString(objv[3]), NULL);

	/*
	 * Make a binding table if the widget doesn't already have one.
	 */

	if (textPtr->sharedTextPtr->bindingTable == NULL) {
	    textPtr->sharedTextPtr->bindingTable =
		    Tk_CreateBindingTable(interp);
	}

	if (objc == 6) {
	    int append = 0;
	    unsigned long mask;
	    const char *fifth = Tcl_GetString(objv[5]);

	    if (fifth[0] == 0) {
		return Tk_DeleteBinding(interp,
			textPtr->sharedTextPtr->bindingTable,
			(ClientData) tagPtr->name, Tcl_GetString(objv[4]));
	    }
	    if (fifth[0] == '+') {
		fifth++;
		append = 1;
	    }
	    mask = Tk_CreateBinding(interp,
		    textPtr->sharedTextPtr->bindingTable,
		    (ClientData) tagPtr->name, Tcl_GetString(objv[4]), fifth,
		    append);
	    if (mask == 0) {
		return TCL_ERROR;
	    }
	    if (mask & (unsigned) ~(ButtonMotionMask|Button1MotionMask
		    |Button2MotionMask|Button3MotionMask|Button4MotionMask
		    |Button5MotionMask|ButtonPressMask|ButtonReleaseMask
		    |EnterWindowMask|LeaveWindowMask|KeyPressMask
		    |KeyReleaseMask|PointerMotionMask|VirtualEventMask)) {
		Tk_DeleteBinding(interp, textPtr->sharedTextPtr->bindingTable,
			(ClientData) tagPtr->name, Tcl_GetString(objv[4]));
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"requested illegal events; only key, button, motion,"
			" enter, leave, and virtual events may be used", -1));
		Tcl_SetErrorCode(interp, "TK", "TEXT", "TAG_BIND_EVENT",NULL);
		return TCL_ERROR;
	    }
	} else if (objc == 5) {
	    const char *command;

	    command = Tk_GetBinding(interp,
		    textPtr->sharedTextPtr->bindingTable,
		    (ClientData) tagPtr->name, Tcl_GetString(objv[4]));
	    if (command == NULL) {
		const char *string = Tcl_GetString(Tcl_GetObjResult(interp));

		/*
		 * Ignore missing binding errors. This is a special hack that
		 * relies on the error message returned by FindSequence in
		 * tkBind.c.
		 */

		if (string[0] != '\0') {
		    return TCL_ERROR;
		}
		Tcl_ResetResult(interp);
	    } else {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(command, -1));
	    }
	} else {
	    Tk_GetAllBindings(interp, textPtr->sharedTextPtr->bindingTable,
		    (ClientData) tagPtr->name);
	}
	break;
    case TAG_CGET:
	if (objc != 5) {
	    Tcl_WrongNumArgs(interp, 1, objv, "tag cget tagName option");
	    return TCL_ERROR;
	} else {
	    Tcl_Obj *objPtr;

	    tagPtr = FindTag(interp, textPtr, objv[3]);
	    if (tagPtr == NULL) {
		return TCL_ERROR;
	    }
	    objPtr = Tk_GetOptionValue(interp, (char *) tagPtr,
		    tagPtr->optionTable, objv[4], textPtr->tkwin);
	    if (objPtr == NULL) {
		return TCL_ERROR;
	    }
	    Tcl_SetObjResult(interp, objPtr);
	    return TCL_OK;
	}
	break;
    case TAG_CONFIGURE: {
	int newTag;

	if (objc < 4) {
	    Tcl_WrongNumArgs(interp, 3, objv,
		    "tagName ?-option? ?value? ?-option value ...?");
	    return TCL_ERROR;
	}
	tagPtr = TkTextCreateTag(textPtr, Tcl_GetString(objv[3]), &newTag);
	if (objc <= 5) {
	    Tcl_Obj *objPtr = Tk_GetOptionInfo(interp, (char *) tagPtr,
		    tagPtr->optionTable,
		    (objc == 5) ? objv[4] : NULL, textPtr->tkwin);

	    if (objPtr == NULL) {
		return TCL_ERROR;
	    }
	    Tcl_SetObjResult(interp, objPtr);
	    return TCL_OK;
	} else {
	    int result = TCL_OK;

	    if (Tk_SetOptions(interp, (char *) tagPtr, tagPtr->optionTable,
		    objc-4, objv+4, textPtr->tkwin, NULL, NULL) != TCL_OK) {
		return TCL_ERROR;
	    }

	    /*
	     * Some of the configuration options, like -underline and
	     * -justify, require additional translation (this is needed
	     * because we need to distinguish a particular value of an option
	     * from "unspecified").
	     */

	    if (tagPtr->borderWidth < 0) {
		tagPtr->borderWidth = 0;
	    }
	    if (tagPtr->reliefString != NULL) {
		if (Tk_GetRelief(interp, tagPtr->reliefString,
			&tagPtr->relief) != TCL_OK) {
		    return TCL_ERROR;
		}
	    }
	    if (tagPtr->justifyString != NULL) {
		if (Tk_GetJustify(interp, tagPtr->justifyString,
			&tagPtr->justify) != TCL_OK) {
		    return TCL_ERROR;
		}
	    }
	    if (tagPtr->lMargin1String != NULL) {
		if (Tk_GetPixels(interp, textPtr->tkwin,
			tagPtr->lMargin1String, &tagPtr->lMargin1) != TCL_OK) {
		    return TCL_ERROR;
		}
	    }
	    if (tagPtr->lMargin2String != NULL) {
		if (Tk_GetPixels(interp, textPtr->tkwin,
			tagPtr->lMargin2String, &tagPtr->lMargin2) != TCL_OK) {
		    return TCL_ERROR;
		}
	    }
	    if (tagPtr->offsetString != NULL) {
		if (Tk_GetPixels(interp, textPtr->tkwin, tagPtr->offsetString,
			&tagPtr->offset) != TCL_OK) {
		    return TCL_ERROR;
		}
	    }
	    if (tagPtr->overstrikeString != NULL) {
		if (Tcl_GetBoolean(interp, tagPtr->overstrikeString,
			&tagPtr->overstrike) != TCL_OK) {
		    return TCL_ERROR;
		}
	    }
	    if (tagPtr->rMarginString != NULL) {
		if (Tk_GetPixels(interp, textPtr->tkwin,
			tagPtr->rMarginString, &tagPtr->rMargin) != TCL_OK) {
		    return TCL_ERROR;
		}
	    }
	    if (tagPtr->spacing1String != NULL) {
		if (Tk_GetPixels(interp, textPtr->tkwin,
			tagPtr->spacing1String, &tagPtr->spacing1) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (tagPtr->spacing1 < 0) {
		    tagPtr->spacing1 = 0;
		}
	    }
	    if (tagPtr->spacing2String != NULL) {
		if (Tk_GetPixels(interp, textPtr->tkwin,
			tagPtr->spacing2String, &tagPtr->spacing2) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (tagPtr->spacing2 < 0) {
		    tagPtr->spacing2 = 0;
		}
	    }
	    if (tagPtr->spacing3String != NULL) {
		if (Tk_GetPixels(interp, textPtr->tkwin,
			tagPtr->spacing3String, &tagPtr->spacing3) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (tagPtr->spacing3 < 0) {
		    tagPtr->spacing3 = 0;
		}
	    }
	    if (tagPtr->tabArrayPtr != NULL) {
		ckfree(tagPtr->tabArrayPtr);
		tagPtr->tabArrayPtr = NULL;
	    }
	    if (tagPtr->tabStringPtr != NULL) {
		tagPtr->tabArrayPtr =
			TkTextGetTabs(interp, textPtr, tagPtr->tabStringPtr);
		if (tagPtr->tabArrayPtr == NULL) {
		    return TCL_ERROR;
		}
	    }
	    if (tagPtr->underlineString != NULL) {
		if (Tcl_GetBoolean(interp, tagPtr->underlineString,
			&tagPtr->underline) != TCL_OK) {
		    return TCL_ERROR;
		}
	    }
	    if (tagPtr->elideString != NULL) {
		if (Tcl_GetBoolean(interp, tagPtr->elideString,
			&tagPtr->elide) != TCL_OK) {
		    return TCL_ERROR;
		}

		/*
		 * Indices are potentially obsolete after changing -elide,
		 * especially those computed with "display" or "any"
		 * submodifier, therefore increase the epoch.
		 */

		textPtr->sharedTextPtr->stateEpoch++;
	    }

	    /*
	     * If the "sel" tag was changed, be sure to mirror information
	     * from the tag back into the text widget record. NOTE: we don't
	     * have to free up information in the widget record before
	     * overwriting it, because it was mirrored in the tag and hence
	     * freed when the tag field was overwritten.
	     */

	    if (tagPtr == textPtr->selTagPtr) {
		textPtr->selBorder = tagPtr->border;
		textPtr->selBorderWidth = tagPtr->borderWidth;
		textPtr->selBorderWidthPtr = tagPtr->borderWidthPtr;
		textPtr->selFgColorPtr = tagPtr->fgColor;
	    }

	    tagPtr->affectsDisplay = 0;
	    tagPtr->affectsDisplayGeometry = 0;
	    if ((tagPtr->elideString != NULL)
		    || (tagPtr->tkfont != None)
		    || (tagPtr->justifyString != NULL)
		    || (tagPtr->lMargin1String != NULL)
		    || (tagPtr->lMargin2String != NULL)
		    || (tagPtr->offsetString != NULL)
		    || (tagPtr->rMarginString != NULL)
		    || (tagPtr->spacing1String != NULL)
		    || (tagPtr->spacing2String != NULL)
		    || (tagPtr->spacing3String != NULL)
		    || (tagPtr->tabStringPtr != NULL)
		    || (tagPtr->tabStyle != TK_TEXT_TABSTYLE_NONE)
		    || (tagPtr->wrapMode != TEXT_WRAPMODE_NULL)) {
		tagPtr->affectsDisplay = 1;
		tagPtr->affectsDisplayGeometry = 1;
	    }
	    if ((tagPtr->border != NULL)
		    || (tagPtr->reliefString != NULL)
		    || (tagPtr->bgStipple != None)
		    || (tagPtr->fgColor != NULL)
		    || (tagPtr->fgStipple != None)
		    || (tagPtr->overstrikeString != NULL)
		    || (tagPtr->underlineString != NULL)) {
		tagPtr->affectsDisplay = 1;
	    }
	    if (!newTag) {
		/*
		 * This line is not necessary if this is a new tag, since it
		 * can't possibly have been applied to anything yet.
		 */

		/*
		 * VMD: If this is the 'sel' tag, then we don't need to call
		 * this for all peers, unless we actually want to synchronize
		 * sel-style changes across the peers.
		 */

		TkTextRedrawTag(textPtr->sharedTextPtr, NULL,
			NULL, NULL, tagPtr, 1);
	    }
	    return result;
	}
	break;
    }
    case TAG_DELETE: {
	Tcl_HashEntry *hPtr;

	if (objc < 4) {
	    Tcl_WrongNumArgs(interp, 3, objv, "tagName ?tagName ...?");
	    return TCL_ERROR;
	}
	for (i = 3; i < objc; i++) {
	    hPtr = Tcl_FindHashEntry(&textPtr->sharedTextPtr->tagTable,
		    Tcl_GetString(objv[i]));
	    if (hPtr == NULL) {
		/*
		 * Either this tag doesn't exist or it's the 'sel' tag (which
		 * is not in the hash table). Either way we don't want to
		 * delete it.
		 */

		continue;
	    }
	    tagPtr = Tcl_GetHashValue(hPtr);
	    if (tagPtr == textPtr->selTagPtr) {
		continue;
	    }
	    if (tagPtr->affectsDisplay) {
		TkTextRedrawTag(textPtr->sharedTextPtr, NULL,
			NULL, NULL, tagPtr, 1);
	    }
	    TkTextDeleteTag(textPtr, tagPtr);
	    Tcl_DeleteHashEntry(hPtr);
	}
	break;
    }
    case TAG_LOWER: {
	TkTextTag *tagPtr2;
	int prio;

	if ((objc != 4) && (objc != 5)) {
	    Tcl_WrongNumArgs(interp, 3, objv, "tagName ?belowThis?");
	    return TCL_ERROR;
	}
	tagPtr = FindTag(interp, textPtr, objv[3]);
	if (tagPtr == NULL) {
	    return TCL_ERROR;
	}
	if (objc == 5) {
	    tagPtr2 = FindTag(interp, textPtr, objv[4]);
	    if (tagPtr2 == NULL) {
		return TCL_ERROR;
	    }
	    if (tagPtr->priority < tagPtr2->priority) {
		prio = tagPtr2->priority - 1;
	    } else {
		prio = tagPtr2->priority;
	    }
	} else {
	    prio = 0;
	}
	ChangeTagPriority(textPtr, tagPtr, prio);

	/*
	 * If this is the 'sel' tag, then we don't actually need to call this
	 * for all peers.
	 */

	TkTextRedrawTag(textPtr->sharedTextPtr, NULL, NULL, NULL, tagPtr, 1);
	break;
    }
    case TAG_NAMES: {
	TkTextTag **arrayPtr;
	int arraySize;
	Tcl_Obj *listObj;

	if ((objc != 3) && (objc != 4)) {
	    Tcl_WrongNumArgs(interp, 3, objv, "?index?");
	    return TCL_ERROR;
	}
	if (objc == 3) {
	    Tcl_HashSearch search;
	    Tcl_HashEntry *hPtr;

	    arrayPtr = ckalloc(textPtr->sharedTextPtr->numTags
		    * sizeof(TkTextTag *));
	    for (i=0, hPtr = Tcl_FirstHashEntry(
		    &textPtr->sharedTextPtr->tagTable, &search);
		    hPtr != NULL; i++, hPtr = Tcl_NextHashEntry(&search)) {
		arrayPtr[i] = Tcl_GetHashValue(hPtr);
	    }

	    /*
	     * The 'sel' tag is not in the hash table.
	     */

	    arrayPtr[i] = textPtr->selTagPtr;
	    arraySize = ++i;
	} else {
	    if (TkTextGetObjIndex(interp, textPtr, objv[3],
		    &index1) != TCL_OK) {
		return TCL_ERROR;
	    }
	    arrayPtr = TkBTreeGetTags(&index1, textPtr, &arraySize);
	    if (arrayPtr == NULL) {
		return TCL_OK;
	    }
	}

	SortTags(arraySize, arrayPtr);
	listObj = Tcl_NewListObj(0, NULL);

	for (i = 0; i < arraySize; i++) {
	    tagPtr = arrayPtr[i];
	    Tcl_ListObjAppendElement(interp, listObj,
		    Tcl_NewStringObj(tagPtr->name,-1));
	}
	Tcl_SetObjResult(interp, listObj);
	ckfree(arrayPtr);
	break;
    }
    case TAG_NEXTRANGE: {
	TkTextIndex last;
	TkTextSearch tSearch;
	char position[TK_POS_CHARS];
	Tcl_Obj *resultObj;

	if ((objc != 5) && (objc != 6)) {
	    Tcl_WrongNumArgs(interp, 3, objv, "tagName index1 ?index2?");
	    return TCL_ERROR;
	}
	tagPtr = FindTag(NULL, textPtr, objv[3]);
	if (tagPtr == NULL) {
	    return TCL_OK;
	}
	if (TkTextGetObjIndex(interp, textPtr, objv[4], &index1) != TCL_OK) {
	    return TCL_ERROR;
	}
	TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr,
		TkBTreeNumLines(textPtr->sharedTextPtr->tree, textPtr),
		0, &last);
	if (objc == 5) {
	    index2 = last;
	} else if (TkTextGetObjIndex(interp, textPtr, objv[5],
		&index2) != TCL_OK) {
	    return TCL_ERROR;
	}

	/*
	 * The search below is a bit tricky. Rather than use the B-tree
	 * facilities to stop the search at index2, let it search up until the
	 * end of the file but check for a position past index2 ourselves.
	 * The reason for doing it this way is that we only care whether the
	 * *start* of the range is before index2; once we find the start, we
	 * don't want TkBTreeNextTag to abort the search because the end of
	 * the range is after index2.
	 */

	TkBTreeStartSearch(&index1, &last, tagPtr, &tSearch);
	if (TkBTreeCharTagged(&index1, tagPtr)) {
	    TkTextSegment *segPtr;
	    int offset;

	    /*
	     * The first character is tagged. See if there is an on-toggle
	     * just before the character. If not, then skip to the end of this
	     * tagged range.
	     */

	    for (segPtr = index1.linePtr->segPtr, offset = index1.byteIndex;
		    offset >= 0;
		    offset -= segPtr->size, segPtr = segPtr->nextPtr) {
		if ((offset == 0) && (segPtr->typePtr == &tkTextToggleOnType)
			&& (segPtr->body.toggle.tagPtr == tagPtr)) {
		    goto gotStart;
		}
	    }
	    if (!TkBTreeNextTag(&tSearch)) {
		return TCL_OK;
	    }
	}

	/*
	 * Find the start of the tagged range.
	 */

	if (!TkBTreeNextTag(&tSearch)) {
	    return TCL_OK;
	}

    gotStart:
	if (TkTextIndexCmp(&tSearch.curIndex, &index2) >= 0) {
	    return TCL_OK;
	}
	resultObj = Tcl_NewObj();
	TkTextPrintIndex(textPtr, &tSearch.curIndex, position);
	Tcl_ListObjAppendElement(NULL, resultObj,
		Tcl_NewStringObj(position, -1));
	TkBTreeNextTag(&tSearch);
	TkTextPrintIndex(textPtr, &tSearch.curIndex, position);
	Tcl_ListObjAppendElement(NULL, resultObj,
		Tcl_NewStringObj(position, -1));
	Tcl_SetObjResult(interp, resultObj);
	break;
    }
    case TAG_PREVRANGE: {
	TkTextIndex last;
	TkTextSearch tSearch;
	char position1[TK_POS_CHARS];
	char position2[TK_POS_CHARS];
	Tcl_Obj *resultObj;

	if ((objc != 5) && (objc != 6)) {
	    Tcl_WrongNumArgs(interp, 3, objv, "tagName index1 ?index2?");
	    return TCL_ERROR;
	}
	tagPtr = FindTag(NULL, textPtr, objv[3]);
	if (tagPtr == NULL) {
	    return TCL_OK;
	}
	if (TkTextGetObjIndex(interp, textPtr, objv[4], &index1) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (objc == 5) {
	    TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr, 0, 0,
		    &index2);
	} else if (TkTextGetObjIndex(interp, textPtr, objv[5],
		&index2) != TCL_OK) {
	    return TCL_ERROR;
	}

	/*
	 * The search below is a bit weird. The previous toggle can be either
	 * an on or off toggle. If it is an on toggle, then we need to turn
	 * around and search forward for the end toggle. Otherwise we keep
	 * searching backwards.
	 */

	TkBTreeStartSearchBack(&index1, &index2, tagPtr, &tSearch);

	if (!TkBTreePrevTag(&tSearch)) {
	    /*
	     * Special case, there may be a tag off toggle at index1, and a
	     * tag on toggle before the start of a partial peer widget. In
	     * this case we missed it.
	     */

	    if (textPtr->start != NULL && (textPtr->start == index2.linePtr)
		    && (index2.byteIndex == 0)
		    && TkBTreeCharTagged(&index2, tagPtr)
		    && (TkTextIndexCmp(&index2, &index1) < 0)) {
		/*
		 * The first character is tagged, so just add the range from
		 * the first char to the start of the range.
		 */

		TkTextPrintIndex(textPtr, &index2, position1);
		TkTextPrintIndex(textPtr, &index1, position2);
		goto gotPrevIndexPair;
	    }
	    return TCL_OK;
	}

	if (tSearch.segPtr->typePtr == &tkTextToggleOnType) {
	    TkTextPrintIndex(textPtr, &tSearch.curIndex, position1);
	    if (textPtr->start != NULL) {
		/*
		 * Make sure the first index is not before the first allowed
		 * text index in this widget.
		 */

		TkTextIndex firstIndex;

		firstIndex.linePtr = textPtr->start;
		firstIndex.byteIndex = 0;
		firstIndex.textPtr = NULL;
		if (TkTextIndexCmp(&tSearch.curIndex, &firstIndex) < 0) {
		    if (TkTextIndexCmp(&firstIndex, &index1) >= 0) {
			/*
			 * But now the new first index is actually too far
			 * along in the text, so nothing is returned.
			 */

			return TCL_OK;
		    }
		    TkTextPrintIndex(textPtr, &firstIndex, position1);
		}
	    }
	    TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr,
		    TkBTreeNumLines(textPtr->sharedTextPtr->tree, textPtr),
		    0, &last);
	    TkBTreeStartSearch(&tSearch.curIndex, &last, tagPtr, &tSearch);
	    TkBTreeNextTag(&tSearch);
	    TkTextPrintIndex(textPtr, &tSearch.curIndex, position2);
	} else {
	    TkTextPrintIndex(textPtr, &tSearch.curIndex, position2);
	    TkBTreePrevTag(&tSearch);
	    TkTextPrintIndex(textPtr, &tSearch.curIndex, position1);
	    if (TkTextIndexCmp(&tSearch.curIndex, &index2) < 0) {
		if (textPtr->start != NULL && index2.linePtr == textPtr->start
			&& index2.byteIndex == 0) {
		    /* It's ok */
		    TkTextPrintIndex(textPtr, &index2, position1);
		} else {
		    return TCL_OK;
		}
	    }
	}

    gotPrevIndexPair:
	resultObj = Tcl_NewObj();
	Tcl_ListObjAppendElement(NULL, resultObj,
		Tcl_NewStringObj(position1, -1));
	Tcl_ListObjAppendElement(NULL, resultObj,
		Tcl_NewStringObj(position2, -1));
	Tcl_SetObjResult(interp, resultObj);
	break;
    }
    case TAG_RAISE: {
	TkTextTag *tagPtr2;
	int prio;

	if ((objc != 4) && (objc != 5)) {
	    Tcl_WrongNumArgs(interp, 3, objv, "tagName ?aboveThis?");
	    return TCL_ERROR;
	}
	tagPtr = FindTag(interp, textPtr, objv[3]);
	if (tagPtr == NULL) {
	    return TCL_ERROR;
	}
	if (objc == 5) {
	    tagPtr2 = FindTag(interp, textPtr, objv[4]);
	    if (tagPtr2 == NULL) {
		return TCL_ERROR;
	    }
	    if (tagPtr->priority <= tagPtr2->priority) {
		prio = tagPtr2->priority;
	    } else {
		prio = tagPtr2->priority + 1;
	    }
	} else {
	    prio = textPtr->sharedTextPtr->numTags-1;
	}
	ChangeTagPriority(textPtr, tagPtr, prio);

	/*
	 * If this is the 'sel' tag, then we don't actually need to call this
	 * for all peers.
	 */

	TkTextRedrawTag(textPtr->sharedTextPtr, NULL, NULL, NULL, tagPtr, 1);
	break;
    }
    case TAG_RANGES: {
	TkTextIndex first, last;
	TkTextSearch tSearch;
	Tcl_Obj *listObj = Tcl_NewListObj(0, NULL);
	int count = 0;

	if (objc != 4) {
	    Tcl_WrongNumArgs(interp, 3, objv, "tagName");
	    return TCL_ERROR;
	}
	tagPtr = FindTag(NULL, textPtr, objv[3]);
	if (tagPtr == NULL) {
	    return TCL_OK;
	}
	TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr, 0, 0,
		&first);
	TkTextMakeByteIndex(textPtr->sharedTextPtr->tree, textPtr,
		TkBTreeNumLines(textPtr->sharedTextPtr->tree, textPtr),
		0, &last);
	TkBTreeStartSearch(&first, &last, tagPtr, &tSearch);
	if (TkBTreeCharTagged(&first, tagPtr)) {
	    Tcl_ListObjAppendElement(NULL, listObj,
		    TkTextNewIndexObj(textPtr, &first));
	    count++;
	}
	while (TkBTreeNextTag(&tSearch)) {
	    Tcl_ListObjAppendElement(NULL, listObj,
		    TkTextNewIndexObj(textPtr, &tSearch.curIndex));
	    count++;
	}
	if (count % 2 == 1) {
	    /*
	     * If a text widget uses '-end', it won't necessarily run to the
	     * end of the B-tree, and therefore the tag range might not be
	     * closed. In this case we add the end of the range.
	     */

	    Tcl_ListObjAppendElement(NULL, listObj,
		    TkTextNewIndexObj(textPtr, &last));
	}
	Tcl_SetObjResult(interp, listObj);
	break;
    }
    }
    return TCL_OK;
}
Example #16
0
static int
TestwineventCmd(
    ClientData clientData,	/* Main window for application. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    HWND hwnd = 0;
    HWND child = 0;
    int id;
    char *rest;
    UINT message;
    WPARAM wParam;
    LPARAM lParam;
    static const TkStateMap messageMap[] = {
        {WM_LBUTTONDOWN,	"WM_LBUTTONDOWN"},
        {WM_LBUTTONUP,		"WM_LBUTTONUP"},
        {WM_CHAR,		"WM_CHAR"},
        {WM_GETTEXT,		"WM_GETTEXT"},
        {WM_SETTEXT,		"WM_SETTEXT"},
        {WM_COMMAND,            "WM_COMMAND"},
        {-1,			NULL}
    };

    if ((argc == 3) && (strcmp(argv[1], "debug") == 0)) {
        int b;

        if (Tcl_GetBoolean(interp, argv[2], &b) != TCL_OK) {
            return TCL_ERROR;
        }
        TkWinDialogDebug(b);
        return TCL_OK;
    }

    if (argc < 4) {
        return TCL_ERROR;
    }

#if 0
    TkpScanWindowId(interp, argv[1], &id);
    if (
#ifdef _WIN64
        (sscanf(string, "0x%p", &number) != 1) &&
#endif /* _WIN64 */
        Tcl_GetInt(interp, string, (int *)&number) != TCL_OK) {
        return TCL_ERROR;
    }
#endif
    hwnd = INT2PTR(strtol(argv[1], &rest, 0));
    if (rest == argv[1]) {
        hwnd = FindWindowA(NULL, argv[1]);
        if (hwnd == NULL) {
            Tcl_SetObjResult(interp, Tcl_NewStringObj("no such window", -1));
            return TCL_ERROR;
        }
    }
    UpdateWindow(hwnd);

    id = strtol(argv[2], &rest, 0);
    if (rest == argv[2]) {
        char buf[256];

        child = GetWindow(hwnd, GW_CHILD);
        while (child != NULL) {
            SendMessageA(child, WM_GETTEXT, (WPARAM) sizeof(buf), (LPARAM) buf);
            if (strcasecmp(buf, argv[2]) == 0) {
                id = GetDlgCtrlID(child);
                break;
            }
            child = GetWindow(child, GW_HWNDNEXT);
        }
        if (child == NULL) {
            Tcl_AppendResult(interp, "could not find a control matching \"",
                             argv[2], "\"", NULL);
            return TCL_ERROR;
        }
    }
    message = TkFindStateNum(NULL, NULL, messageMap, argv[3]);
    wParam = 0;
    lParam = 0;

    if (argc > 4) {
        wParam = strtol(argv[4], NULL, 0);
    }
    if (argc > 5) {
        lParam = strtol(argv[5], NULL, 0);
    }

    switch (message) {
    case WM_GETTEXT: {
        Tcl_DString ds;
        char buf[256];

        GetDlgItemTextA(hwnd, id, buf, 256);
        Tcl_ExternalToUtfDString(NULL, buf, -1, &ds);
        Tcl_AppendResult(interp, Tcl_DStringValue(&ds), NULL);
        Tcl_DStringFree(&ds);
        break;
    }
    case WM_SETTEXT: {
        Tcl_DString ds;
        BOOL result;

        Tcl_UtfToExternalDString(NULL, argv[4], -1, &ds);
        result = SetDlgItemTextA(hwnd, id, Tcl_DStringValue(&ds));
        Tcl_DStringFree(&ds);
        if (result == 0) {
            Tcl_SetObjResult(interp, Tcl_NewStringObj("failed to send text to dialog: ", -1));
            AppendSystemError(interp, GetLastError());
            return TCL_ERROR;
        }
        break;
    }
    case WM_COMMAND: {
        char buf[TCL_INTEGER_SPACE];
        if (argc < 5) {
            wParam = MAKEWPARAM(id, 0);
            lParam = (LPARAM)child;
        }
        sprintf(buf, "%d", (int) SendMessageA(hwnd, message, wParam, lParam));
        Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, -1));
        break;
    }
    default: {
        char buf[TCL_INTEGER_SPACE];

        sprintf(buf, "%d",
                (int) SendDlgItemMessageA(hwnd, id, message, wParam, lParam));
        Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, -1));
        break;
    }
    }
    return TCL_OK;
}
Example #17
0
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;
            } else if (strcmp (argv [iarg], "map2texturecoord2") == 0) {
                type = GL_MAP2_TEXTURE_COORD_2;
                nCoords = 2;
            } else if (strcmp (argv [iarg], "map2texturecoord3") == 0) {
                type = GL_MAP2_TEXTURE_COORD_3;
                nCoords = 3;
            } else if (strcmp (argv [iarg], "map2texturecoord4") == 0) {
                type = GL_MAP2_TEXTURE_COORD_4;
                nCoords = 4;
            } else
                ERRMSG2 ("not a valid type:", argv [iarg]);
        }
        else if (strncmp (argv [iarg], "-samplingtolerance", len) == 0) {
            double val;
            iarg++;
            if (iarg >= argc) ERRMSG ("No -samplingtolerance value given");
            if (Tcl_GetDouble (interp, argv [iarg], &val) != TCL_OK)
                ERRMSG ("\nError parsing sampling tolerance");
            samplingTolerance = (GLfloat)val;
        }
        else if (strncmp (argv [iarg], "-displaymode", len) == 0) {
            iarg++;
            if (iarg >= argc) ERRMSG ("No -displaymode value given");
            if (strcmp (argv [iarg], "fill") == 0) {
                displayMode = GLU_FILL;
            } else if (strcmp (argv [iarg], "outlinepolygon") == 0) {
                displayMode = GLU_OUTLINE_POLYGON;
            } else if (strcmp (argv [iarg], "outlinepatch") == 0) {
                displayMode = GLU_OUTLINE_PATCH;
            } else {
                ERRMSG2 ("not a valid display mode:", argv [iarg]);
            }
        }
        else if (strncmp (argv [iarg], "-culling", len) == 0) {
            int val;
            iarg++;
            if (iarg >= argc) ERRMSG ("No -culling value given");
            if (Tcl_GetBoolean (interp, argv [iarg], &val) != TCL_OK)
                ERRMSG ("\nError parsing culling value");
            culling = (GLfloat)val;
        }
        else {
            ERRMSG2 ("invalid option:", argv [iarg]);
        }
    }

    if (vKnot->count == 0 || uKnot->count == 0 || cPoint->count == 0)
        ERRMSG ("All of -uknot, -vknot and -cpoint options must be specified");

    /* Now try to guess the remaining arguments and call gluNurbsSurface */
    {
        GLint uKnotCount = uKnot->count;
        GLint vKnotCount = vKnot->count;
        GLint vStride = nCoords;
        GLint uStride = nCoords * (vKnotCount - vOrder);
        static GLUnurbsObj* obj = NULL;
        if (uStride * (uKnotCount - uOrder) != cPoint->count) {
            char buf [80];
            sprintf (buf, "%d", uStride * (uKnotCount - uOrder));
            ERRMSG2 ("Incorrect number of controlpoint coordinates. Expected ",
                     buf);
        }
        /* Theoretically, a nurbs object could be allocated for each
        invocation of NurbsSurface and then freed after the creation
         of the display list. However, this produces a segmentation
         violation on AIX OpenGL 1.0. Thus, only one nurbs object is
         ever allocated and never freed.
            */
        if (obj == NULL) obj = gluNewNurbsRenderer();
        dlist = glGenLists (1);
        gluNurbsProperty (obj, GLU_SAMPLING_TOLERANCE, samplingTolerance);
        gluNurbsProperty (obj, GLU_DISPLAY_MODE, displayMode);
        gluNurbsProperty (obj, GLU_CULLING, culling);
        glNewList (dlist, GL_COMPILE);
        gluBeginSurface (obj);
        gluNurbsSurface (obj, uKnotCount, uKnot->value,
                         vKnotCount, vKnot->value,
                         uStride, vStride, cPoint->value,
                         uOrder, vOrder, type);
        gluEndSurface (obj);
        /* This is never used because of a bug in AIX OpenGL 1.0.
        gluDeleteNurbsObj (obj);
            */
        glEndList();
        glFlush();
    }

done:

    DestroyFloatArray (uKnot);
    DestroyFloatArray (vKnot);
    DestroyFloatArray (cPoint);

    if (result == TCL_OK) {
        char tmp[128];
        sprintf (tmp, "%d", dlist);
        Tcl_SetResult(interp, tmp, TCL_VOLATILE);
    }

    return result;
}
Example #18
0
int
bn_math_cmd(ClientData clientData, Tcl_Interp *interp, int argc, char **argv)
{
    void (*math_func)();
    struct bu_vls result;

    math_func = (void (*)())clientData; /* object-to-function cast */
    bu_vls_init(&result);

    if (math_func == bn_mat_mul) {
	mat_t o, a, b;
	if (argc < 3 || bn_decode_mat(a, argv[1]) < 16 ||
	    bn_decode_mat(b, argv[2]) < 16) {
	    bu_vls_printf(&result, "usage: %s matA matB", argv[0]);
	    goto error;
	}
	bn_mat_mul(o, a, b);
	bn_encode_mat(&result, o);
    } else if (math_func == bn_mat_inv || math_func == bn_mat_trn) {
	mat_t o, a;

	if (argc < 2 || bn_decode_mat(a, argv[1]) < 16) {
	    bu_vls_printf(&result, "usage: %s mat", argv[0]);
	    goto error;
	}
	(*math_func)(o, a);
	bn_encode_mat(&result, o);
    } else if (math_func == bn_matXvec) {
	mat_t m;
	hvect_t i, o;
	if (argc < 3 || bn_decode_mat(m, argv[1]) < 16 ||
	    bn_decode_hvect(i, argv[2]) < 4) {
	    bu_vls_printf(&result, "usage: %s mat hvect", argv[0]);
	    goto error;
	}
	bn_matXvec(o, m, i);
	bn_encode_hvect(&result, o);
    } else if (math_func == bn_mat4x3pnt) {
	mat_t m;
	point_t i, o;
	if (argc < 3 || bn_decode_mat(m, argv[1]) < 16 ||
	    bn_decode_vect(i, argv[2]) < 3) {
	    bu_vls_printf(&result, "usage: %s mat point", argv[0]);
	    goto error;
	}
	bn_mat4x3pnt(o, m, i);
	bn_encode_vect(&result, o);
    } else if (math_func == bn_mat4x3vec) {
	mat_t m;
	vect_t i, o;
	if (argc < 3 || bn_decode_mat(m, argv[1]) < 16 ||
	    bn_decode_vect(i, argv[2]) < 3) {
	    bu_vls_printf(&result, "usage: %s mat vect", argv[0]);
	    goto error;
	}
	bn_mat4x3vec(o, m, i);
	bn_encode_vect(&result, o);
    } else if (math_func == bn_hdivide) {
	hvect_t i;
	vect_t o;
	if (argc < 2 || bn_decode_hvect(i, argv[1]) < 4) {
	    bu_vls_printf(&result, "usage: %s hvect", argv[0]);
	    goto error;
	}
	bn_hdivide(o, i);
	bn_encode_vect(&result, o);
    } else if (math_func == bn_vjoin1) {
	point_t o;
	point_t b, d;
	fastf_t c;

	if (argc < 4) {
	    bu_vls_printf(&result, "usage: %s pnt scale dir", argv[0]);
	    goto error;
	}
	if ( bn_decode_vect(b, argv[1]) < 3) goto error;
	if (Tcl_GetDouble(interp, argv[2], &c) != TCL_OK) goto error;
	if ( bn_decode_vect(d, argv[3]) < 3) goto error;

	VJOIN1( o, b, c, d );	/* bn_vjoin1( o, b, c, d ) */
	bn_encode_vect(&result, o);

    } else if ( math_func == bn_vblend) {
	point_t a, c, e;
	fastf_t b, d;

	if ( argc < 5 ) {
	    bu_vls_printf(&result, "usage: %s scale pnt scale pnt", argv[0]);
	    goto error;
	}

	if ( Tcl_GetDouble(interp, argv[1], &b) != TCL_OK) goto error;
	if ( bn_decode_vect( c, argv[2] ) < 3) goto error;
	if ( Tcl_GetDouble(interp, argv[3], &d) != TCL_OK) goto error;
	if ( bn_decode_vect( e, argv[4] ) < 3) goto error;

	VBLEND2( a, b, c, d, e )
	    bn_encode_vect( &result, a );

    } else if (math_func == bn_mat_ae) {
	mat_t o;
	double az, el;

	if (argc < 3) {
	    bu_vls_printf(&result, "usage: %s azimuth elevation", argv[0]);
	    goto error;
	}
	if (Tcl_GetDouble(interp, argv[1], &az) != TCL_OK) goto error;
	if (Tcl_GetDouble(interp, argv[2], &el) != TCL_OK) goto error;

	bn_mat_ae(o, (fastf_t)az, (fastf_t)el);
	bn_encode_mat(&result, o);
    } else if (math_func == bn_ae_vec) {
	fastf_t az, el;
	vect_t v;

	if (argc < 2 || bn_decode_vect(v, argv[1]) < 3) {
	    bu_vls_printf(&result, "usage: %s vect", argv[0]);
	    goto error;
	}

	bn_ae_vec(&az, &el, v);
	bu_vls_printf(&result, "%g %g", az, el);
    } else if (math_func == bn_aet_vec) {
	fastf_t az, el, twist, accuracy;
	vect_t vec_ae, vec_twist;

	if (argc < 4 || bn_decode_vect(vec_ae, argv[1]) < 3 ||
	    bn_decode_vect(vec_twist, argv[2]) < 3 ||
	    sscanf(argv[3], "%lf", &accuracy) < 1) {
	    bu_vls_printf(&result, "usage: %s vec_ae vec_twist accuracy",
			  argv[0]);
	    goto error;
	}

	bn_aet_vec(&az, &el, &twist, vec_ae, vec_twist, accuracy);
	bu_vls_printf(&result, "%g %g %g", az, el, twist);
    } else if (math_func == bn_mat_angles) {
	mat_t o;
	double alpha, beta, ggamma;

	if (argc < 4) {
	    bu_vls_printf(&result, "usage: %s alpha beta gamma", argv[0]);
	    goto error;
	}
	if (Tcl_GetDouble(interp, argv[1], &alpha) != TCL_OK)  goto error;
	if (Tcl_GetDouble(interp, argv[2], &beta) != TCL_OK)   goto error;
	if (Tcl_GetDouble(interp, argv[3], &ggamma) != TCL_OK) goto error;

	bn_mat_angles(o, alpha, beta, ggamma);
	bn_encode_mat(&result, o);
    } else if (math_func == bn_eigen2x2) {
	fastf_t val1, val2;
	vect_t vec1, vec2;
	double a, b, c;

	if (argc < 4) {
	    bu_vls_printf(&result, "usage: %s a b c", argv[0]);
	    goto error;
	}
	if (Tcl_GetDouble(interp, argv[1], &a) != TCL_OK) goto error;
	if (Tcl_GetDouble(interp, argv[2], &c) != TCL_OK) goto error;
	if (Tcl_GetDouble(interp, argv[3], &b) != TCL_OK) goto error;

	bn_eigen2x2(&val1, &val2, vec1, vec2, (fastf_t)a, (fastf_t)b,
		    (fastf_t)c);
	bu_vls_printf(&result, "%g %g {%g %g %g} {%g %g %g}", val1, val2,
		      V3ARGS(vec1), V3ARGS(vec2));
    } else if (math_func == bn_mat_fromto) {
	mat_t o;
	vect_t from, to;

	if (argc < 3 || bn_decode_vect(from, argv[1]) < 3 ||
	    bn_decode_vect(to, argv[2]) < 3) {
	    bu_vls_printf(&result, "usage: %s vecFrom vecTo", argv[0]);
	    goto error;
	}
	bn_mat_fromto(o, from, to);
	bn_encode_mat(&result, o);
    } else if (math_func == bn_mat_xrot || math_func == bn_mat_yrot ||
	       math_func == bn_mat_zrot) {
	mat_t o;
	double s, c;
	if (argc < 3) {
	    bu_vls_printf(&result, "usage: %s sinAngle cosAngle", argv[0]);
	    goto error;
	}
	if (Tcl_GetDouble(interp, argv[1], &s) != TCL_OK) goto error;
	if (Tcl_GetDouble(interp, argv[2], &c) != TCL_OK) goto error;

	(*math_func)(o, s, c);
	bn_encode_mat(&result, o);
    } else if (math_func == bn_mat_lookat) {
	mat_t o;
	vect_t dir;
	int yflip;
	if (argc < 3 || bn_decode_vect(dir, argv[1]) < 3) {
	    bu_vls_printf(&result, "usage: %s dir yflip", argv[0]);
	    goto error;
	}
	if (Tcl_GetBoolean(interp, argv[2], &yflip) != TCL_OK) goto error;

	bn_mat_lookat(o, dir, yflip);
	bn_encode_mat(&result, o);
    } else if (math_func == bn_vec_ortho || math_func == bn_vec_perp) {
	vect_t ov, vec;

	if (argc < 2 || bn_decode_vect(vec, argv[1]) < 3) {
	    bu_vls_printf(&result, "usage: %s vec", argv[0]);
	    goto error;
	}

	(*math_func)(ov, vec);
	bn_encode_vect(&result, ov);
    } else if (math_func == bn_mat_scale_about_pt_wrapper) {
	mat_t o;
	vect_t v;
	double scale;
	int status;

	if (argc < 3 || bn_decode_vect(v, argv[1]) < 3) {
	    bu_vls_printf(&result, "usage: %s pt scale", argv[0]);
	    goto error;
	}
	if (Tcl_GetDouble(interp, argv[2], &scale) != TCL_OK) goto error;

	bn_mat_scale_about_pt_wrapper(&status, o, v, scale);
	if (status != 0) {
	    bu_vls_printf(&result, "error performing calculation");
	    goto error;
	}
	bn_encode_mat(&result, o);
    } else if (math_func == bn_mat_xform_about_pt) {
	mat_t o, xform;
	vect_t v;

	if (argc < 3 || bn_decode_mat(xform, argv[1]) < 16 ||
	    bn_decode_vect(v, argv[2]) < 3) {
	    bu_vls_printf(&result, "usage: %s xform pt", argv[0]);
	    goto error;
	}

	bn_mat_xform_about_pt(o, xform, v);
	bn_encode_mat(&result, o);
    } else if (math_func == bn_mat_arb_rot) {
	mat_t o;
	point_t pt;
	vect_t dir;
	double angle;

	if (argc < 4 || bn_decode_vect(pt, argv[1]) < 3 ||
	    bn_decode_vect(dir, argv[2]) < 3) {
	    bu_vls_printf(&result, "usage: %s pt dir angle", argv[0]);
	    goto error;
	}
	if (Tcl_GetDouble(interp, argv[3], &angle) != TCL_OK)
	    return TCL_ERROR;

	bn_mat_arb_rot(o, pt, dir, (fastf_t)angle);
	bn_encode_mat(&result, o);
    } else if (math_func == quat_mat2quat) {
	mat_t mat;
	quat_t quat;

	if (argc < 2 || bn_decode_mat(mat, argv[1]) < 16) {
	    bu_vls_printf(&result, "usage: %s mat", argv[0]);
	    goto error;
	}

	quat_mat2quat(quat, mat);
	bn_encode_quat(&result, quat);
    } else if (math_func == quat_quat2mat) {
	mat_t mat;
	quat_t quat;

	if (argc < 2 || bn_decode_quat(quat, argv[1]) < 4) {
	    bu_vls_printf(&result, "usage: %s quat", argv[0]);
	    goto error;
	}

	quat_quat2mat(mat, quat);
	bn_encode_mat(&result, mat);
    } else if (math_func == bn_quat_distance_wrapper) {
	quat_t q1, q2;
	double d;

	if (argc < 3 || bn_decode_quat(q1, argv[1]) < 4 ||
	    bn_decode_quat(q2, argv[2]) < 4) {
	    bu_vls_printf(&result, "usage: %s quatA quatB", argv[0]);
	    goto error;
	}

	bn_quat_distance_wrapper(&d, q1, q2);
	bu_vls_printf(&result, "%g", d);
    } else if (math_func == quat_double || math_func == quat_bisect ||
	       math_func == quat_make_nearest) {
	quat_t oqot, q1, q2;

	if (argc < 3 || bn_decode_quat(q1, argv[1]) < 4 ||
	    bn_decode_quat(q2, argv[2]) < 4) {
	    bu_vls_printf(&result, "usage: %s quatA quatB", argv[0]);
	    goto error;
	}

	(*math_func)(oqot, q1, q2);
	bn_encode_quat(&result, oqot);
    } else if (math_func == quat_slerp) {
	quat_t oq, q1, q2;
	double d;

	if (argc < 4 || bn_decode_quat(q1, argv[1]) < 4 ||
	    bn_decode_quat(q2, argv[2]) < 4) {
	    bu_vls_printf(&result, "usage: %s quat1 quat2 factor", argv[0]);
	    goto error;
	}
	if (Tcl_GetDouble(interp, argv[3], &d) != TCL_OK) goto error;

	quat_slerp(oq, q1, q2, d);
	bn_encode_quat(&result, oq);
    } else if (math_func == quat_sberp) {
	quat_t oq, q1, qa, qb, q2;
	double d;

	if (argc < 6 || bn_decode_quat(q1, argv[1]) < 4 ||
	    bn_decode_quat(qa, argv[2]) < 4 || bn_decode_quat(qb, argv[3]) < 4 ||
	    bn_decode_quat(q2, argv[4]) < 4) {
	    bu_vls_printf(&result, "usage: %s quat1 quatA quatB quat2 factor",
			  argv[0]);
	    goto error;
	}
	if (Tcl_GetDouble(interp, argv[5], &d) != TCL_OK) goto error;

	quat_sberp(oq, q1, qa, qb, q2, d);
	bn_encode_quat(&result, oq);
    } else if (math_func == quat_exp || math_func == quat_log) {
	quat_t qout, qin;

	if (argc < 2 || bn_decode_quat(qin, argv[1]) < 4) {
	    bu_vls_printf(&result, "usage: %s quat", argv[0]);
	    goto error;
	}

	(*math_func)(qout, qin);
	bn_encode_quat(&result, qout);
    } else if (math_func == (void (*)())bn_isect_line3_line3) {
	double t, u;
	point_t pt, a;
	vect_t dir, c;
	int i;
	static const struct bn_tol tol = {
	    BN_TOL_MAGIC, 0.005, 0.005*0.005, 1e-6, 1-1e-6
	};
	if (argc != 5) {
	    bu_vls_printf(&result,
			  "Usage: bn_isect_line3_line3 pt dir pt dir (%d args specified)",
			  argc-1);
	    goto error;
	}

	if (bn_decode_vect(pt, argv[1]) < 3) {
	    bu_vls_printf(&result, "bn_isect_line3_line3 no pt: %s\n", argv[0]);
	    goto error;
	}
	if (bn_decode_vect(dir, argv[2]) < 3) {
	    bu_vls_printf(&result, "bn_isect_line3_line3 no dir: %s\n", argv[0]);
	    goto error;
	}
	if (bn_decode_vect(a, argv[3]) < 3) {
	    bu_vls_printf(&result, "bn_isect_line3_line3 no a pt: %s\n", argv[0]);
	    goto error;
	}
	if (bn_decode_vect(c, argv[4]) < 3) {
	    bu_vls_printf(&result, "bn_isect_line3_line3 no c dir: %s\n", argv[0]);
	    goto error;
	}
	i = bn_isect_line3_line3(&t, &u, pt, dir, a, c, &tol);
	if (i != 1) {
	    bu_vls_printf(&result, "bn_isect_line3_line3 no intersection: %s\n", argv[0]);
	    goto error;
	}

	VJOIN1(a, pt, t, dir);
	bn_encode_vect(&result, a);

    } else if (math_func == (void (*)())bn_isect_line2_line2) {
	double dist[2];
	point_t pt, a;
	vect_t dir, c;
	int i;
	static const struct bn_tol tol = {
	    BN_TOL_MAGIC, 0.005, 0.005*0.005, 1e-6, 1-1e-6
	};

	if (argc != 5) {
	    bu_vls_printf(&result,
			  "Usage: bn_isect_line2_line2 pt dir pt dir (%d args specified)",
			  argc-1);
	    goto error;
	}

	/* i = bn_isect_line2_line2 {0 0} {1 0} {1 1} {0 -1} */

	VSETALL(pt, 0.0);
	VSETALL(dir, 0.0);
	VSETALL(a, 0.0);
	VSETALL(c, 0.0);

	if (bn_decode_vect(pt, argv[1]) < 2) {
	    bu_vls_printf(&result, "bn_isect_line2_line2 no pt: %s\n", argv[0]);
	    goto error;
	}
	if (bn_decode_vect(dir, argv[2]) < 2) {
	    bu_vls_printf(&result, "bn_isect_line2_line2 no dir: %s\n", argv[0]);
	    goto error;
	}
	if (bn_decode_vect(a, argv[3]) < 2) {
	    bu_vls_printf(&result, "bn_isect_line2_line2 no a pt: %s\n", argv[0]);
	    goto error;
	}
	if (bn_decode_vect(c, argv[4]) < 2) {
	    bu_vls_printf(&result, "bn_isect_line2_line2 no c dir: %s\n", argv[0]);
	    goto error;
	}
	i = bn_isect_line2_line2(dist, pt, dir, a, c, &tol);
	if (i != 1) {
	    bu_vls_printf(&result, "bn_isect_line2_line2 no intersection: %s\n", argv[0]);
	    goto error;
	}

	VJOIN1(a, pt, dist[0], dir);
	bu_vls_printf(&result, "%g %g", a[0], a[1]);

    } else {
	bu_vls_printf(&result, "libbn/bn_tcl.c: math function %s not supported yet\n", argv[0]);
	goto error;
    }

    Tcl_AppendResult(interp, bu_vls_addr(&result), (char *)NULL);
    bu_vls_free(&result);
    return TCL_OK;

 error:
    Tcl_AppendResult(interp, bu_vls_addr(&result), (char *)NULL);
    bu_vls_free(&result);
    return TCL_ERROR;
}
Example #19
0
static int
TestwineventObjCmd(
    ClientData clientData,	/* Main window for application. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])		/* Argument strings. */
{
    HWND hwnd = 0;
    HWND child = 0;
    HWND control;
    int id;
    char *rest;
    UINT message;
    WPARAM wParam;
    LPARAM lParam;
    LRESULT result;
    static const TkStateMap messageMap[] = {
	{WM_LBUTTONDOWN,	"WM_LBUTTONDOWN"},
	{WM_LBUTTONUP,		"WM_LBUTTONUP"},
	{WM_CHAR,		"WM_CHAR"},
	{WM_GETTEXT,		"WM_GETTEXT"},
	{WM_SETTEXT,		"WM_SETTEXT"},
	{WM_COMMAND,            "WM_COMMAND"},
	{-1,			NULL}
    };

    if ((objc == 3) && (strcmp(Tcl_GetString(objv[1]), "debug") == 0)) {
	int b;

	if (Tcl_GetBoolean(interp, Tcl_GetString(objv[2]), &b) != TCL_OK) {
	    return TCL_ERROR;
	}
	TkWinDialogDebug(b);
	return TCL_OK;
    }

    if (objc < 4) {
	return TCL_ERROR;
    }

    hwnd = INT2PTR(strtol(Tcl_GetString(objv[1]), &rest, 0));
    if (rest == Tcl_GetString(objv[1])) {
	hwnd = FindWindowA(NULL, Tcl_GetString(objv[1]));
	if (hwnd == NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj("no such window", -1));
	    return TCL_ERROR;
	}
    }
    UpdateWindow(hwnd);

    id = strtol(Tcl_GetString(objv[2]), &rest, 0);
    if (rest == Tcl_GetString(objv[2])) {
	char buf[256];

	child = GetWindow(hwnd, GW_CHILD);
	while (child != NULL) {
	    SendMessageA(child, WM_GETTEXT, (WPARAM) sizeof(buf), (LPARAM) buf);
	    if (strcasecmp(buf, Tcl_GetString(objv[2])) == 0) {
		id = GetDlgCtrlID(child);
		break;
	    }
	    child = GetWindow(child, GW_HWNDNEXT);
	}
	if (child == NULL) {
	    Tcl_AppendResult(interp, "could not find a control matching \"",
		Tcl_GetString(objv[2]), "\"", NULL);
	    return TCL_ERROR;
	}
    }

    message = TkFindStateNum(NULL, NULL, messageMap, Tcl_GetString(objv[3]));
    wParam = 0;
    lParam = 0;

    if (objc > 4) {
	wParam = strtol(Tcl_GetString(objv[4]), NULL, 0);
    }
    if (objc > 5) {
	lParam = strtol(Tcl_GetString(objv[5]), NULL, 0);
    }

    switch (message) {
    case WM_GETTEXT: {
	Tcl_DString ds;
	char buf[256];

#if 0
	GetDlgItemTextA(hwnd, id, buf, 256);
#else
        control = TestFindControl(hwnd, id);
        if (control == NULL) {
            Tcl_SetObjResult(interp,
                             Tcl_ObjPrintf("Could not find control with id %d", id));
            return TCL_ERROR;
        }
        buf[0] = 0;
        SendMessageA(control, WM_GETTEXT, (WPARAM)sizeof(buf),
                     (LPARAM) buf);
#endif
	Tcl_ExternalToUtfDString(NULL, buf, -1, &ds);
	Tcl_AppendResult(interp, Tcl_DStringValue(&ds), NULL);
	Tcl_DStringFree(&ds);
	break;
    }
    case WM_SETTEXT: {
	Tcl_DString ds;

        control = TestFindControl(hwnd, id);
        if (control == NULL) {
            Tcl_SetObjResult(interp,
                             Tcl_ObjPrintf("Could not find control with id %d", id));
            return TCL_ERROR;
        }
	Tcl_UtfToExternalDString(NULL, Tcl_GetString(objv[4]), -1, &ds);
        result = SendMessageA(control, WM_SETTEXT, 0,
                                  (LPARAM) Tcl_DStringValue(&ds));
	Tcl_DStringFree(&ds);
	if (result == 0) {
            Tcl_SetObjResult(interp, Tcl_NewStringObj("failed to send text to dialog: ", -1));
            AppendSystemError(interp, GetLastError());
            return TCL_ERROR;
	}
	break;
    }
    case WM_COMMAND: {
	char buf[TCL_INTEGER_SPACE];
	if (objc < 5) {
	    wParam = MAKEWPARAM(id, 0);
	    lParam = (LPARAM)child;
	}
	sprintf(buf, "%d", (int) SendMessageA(hwnd, message, wParam, lParam));
	Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, -1));
	break;
    }
    default: {
	char buf[TCL_INTEGER_SPACE];

	sprintf(buf, "%d",
		(int) SendDlgItemMessageA(hwnd, id, message, wParam, lParam));
	Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, -1));
	break;
    }
    }
    return TCL_OK;
}
Example #20
0
/* 
 * Tcl callback to allow setting of game configuration variables from Tcl.
 */
static int set_param_cb ( ClientData cd, Tcl_Interp *ip, 
			  int argc, const char *argv[]) 
{
    int i;
    int tmp_int;
    int num_params;
    struct param *parm;

    if ( argc != 3 ) {
        Tcl_AppendResult(ip, argv[0], ": invalid number of arguments\n", 
			 "Usage: ", argv[0], " <parameter name> <value>",
			 (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;
    }

    /* Set value of parameter */
    switch ( parm->type ) {
    case PARAM_STRING:
	set_param_string( parm, argv[2] ); 
	break;

    case PARAM_CHAR:
	if ( strlen( argv[2] ) > 1 ) {
	    Tcl_AppendResult(ip, "\n", argv[0], ": value for `",
			     argv[1], "' must be a single character", 
			     (char *)0 );
	    return TCL_ERROR;
	}
	set_param_char( parm, argv[2][0] );
	break;

    case PARAM_INT:
	if ( Tcl_GetInt( ip, argv[2], &tmp_int ) != TCL_OK ) {
	    Tcl_AppendResult(ip, "\n", argv[0], ": value for `",
			     argv[1], "' must be an integer", 
			     (char *)0 );
	    return TCL_ERROR;
	}
	set_param_int( parm, tmp_int );
	break;

    case PARAM_BOOL:
	if ( Tcl_GetBoolean( ip, argv[2], &tmp_int ) != TCL_OK ) {
	    Tcl_AppendResult(ip, "\n", argv[0], ": value for `",
			     argv[1], "' must be a boolean", 
			     (char *)0 );
	    return TCL_ERROR;
	}
	check_assertion( tmp_int == 0 || tmp_int == 1, 
			 "invalid boolean value" );
	set_param_bool( parm, (bool_t) tmp_int );
	break;

    default:
	code_not_reached();
    }

    return TCL_OK;
} 
Example #21
0
int
NsTclConfigCmd(ClientData dummy, Tcl_Interp *interp, int argc, char **argv)
{
    char *value;
    int   i;
    int   fHasDefault = NS_FALSE;
    int	  defaultIndex = 0;

    if (argc < 3 || argc > 5) {
        Tcl_AppendResult(interp, "wrong # args:  should be \"",
            argv[0], " ?-exact | -bool | -int? section key ?default?\"", NULL);
        return TCL_ERROR;
    }

    if (argv[1][0] == '-') {
	if (argc == 5) {
	    fHasDefault = NS_TRUE;
	    defaultIndex = 4;
	}
    } else if (argc == 4) {
	fHasDefault = NS_TRUE;
	defaultIndex = 3;
    }
   
    if (STREQ(argv[1], "-exact")) {
        value = Ns_ConfigGetValueExact(argv[2], argv[3]);

	if (value == NULL && fHasDefault) {
	    value = argv[defaultIndex];
	}
    } else if (STREQ(argv[1], "-int")) {
        if (Ns_ConfigGetInt(argv[2], argv[3], &i)) {
            Tcl_SetObjResult(interp, Tcl_NewIntObj(i));
            return TCL_OK;
        } else if (fHasDefault) {
	    if (Tcl_GetInt(interp, argv[defaultIndex], &i) != TCL_OK) {
		return TCL_ERROR;
	    }
            Tcl_SetObjResult(interp, Tcl_NewIntObj(i));
	    return TCL_OK;
	}
        value = NULL;
    } else if (STREQ(argv[1], "-bool")) {
        int             iValue;

        if (Ns_ConfigGetBool(argv[2], argv[3], &iValue) == NS_FALSE) {
	    if (fHasDefault) {
		if (   Tcl_GetBoolean(interp, argv[defaultIndex], &iValue)
		    != TCL_OK) {
		    return TCL_ERROR;
		}

		value = (iValue) ? "1" : "0";
		
	    } else {
		value = NULL;
	    }
        } else {
	    value = (iValue) ? "1" : "0";
        }
    } else if (argc == 3 || argc == 4) {
        value = Ns_ConfigGetValue(argv[1], argv[2]);

	if (value == NULL && fHasDefault) {
	    value = argv[defaultIndex];
	}
    } else {
        Tcl_AppendResult(interp, "wrong # args:  should be \"",
            argv[0], " ?-exact | -bool | -int? section key ?default?\"", NULL);
        return TCL_ERROR;
    }
    if (value != NULL) {
	Tcl_SetResult(interp, value, TCL_STATIC);
    }
    return TCL_OK;
}
Example #22
0
/* ********************************************************
   Nadd_key --

   Hook to add a key frame to the internal keyframe list.
   Here's the function def from Bill:
   The pos value is the relative position in the animation for this
   particular keyframe - used to compare relative distance to neighboring
   keyframes, it can be any floating point value.

   The fmask value can be any of the following or'd together:
   KF_FROMX_MASK
   KF_FROMY_MASK
   KF_FROMZ_MASK
   KF_FROM_MASK (KF_FROMX_MASK | KF_FROMY_MASK | KF_FROMZ_MASK)

   KF_DIRX_MASK
   KF_DIRY_MASK
   KF_DIRZ_MASK
   KF_DIR_MASK (KF_DIRX_MASK | KF_DIRY_MASK | KF_DIRZ_MASK)

   KF_FOV_MASK
   KF_TWIST_MASK

   KF_ALL_MASK (KF_FROM_MASK | KF_DIR_MASK | KF_FOV_MASK | KF_TWIST_MASK)

   Other fields will be added later.
   (Mark - I'm still working on this - just use KF_ALL_MASK for now)

   The value precis and the boolean force_replace are used to determine
   if a keyframe should be considered to be at the same position as a
   pre-existing keyframe. e.g., if anykey.pos - newkey.pos <= precis,
   GK_add_key will fail unless force_replace is TRUE.

   Returns 1 if key is added, otherwise -1.
   Calls GK_update_frames() if key is successfully added.


   Arguments:
   pos    - relative position of keyframe
   fmask  - list, see above, for tcl/tk constants have same names
   force_replace - boolean, see above
   precis - float, see above

   Returns:
   None.

   Side Effects:
   Adds or replaces the given key with the given values.

   ******************************************************** */
int Nadd_key_cmd(Nv_data * data,	/* Local data */
		 Tcl_Interp * interp,	/* Current interpreter */
		 int argc,	/* Number of arguments */
		 char **argv	/* Argument strings */
    )
{
    /* Parse arguments */
    double pos, precis;
    unsigned long fmask;
    int force_replace;
    const char **listels;
    int numels, i;
    char tmp[128];

    if (argc != 5) {
	Tcl_SetResult(interp,
	    "Error: should be Nadd_key pos fmask_list force_replace precis", TCL_VOLATILE);
	return (TCL_ERROR);
    }

    if (Tcl_GetDouble(interp, argv[1], &pos) != TCL_OK)
	return TCL_ERROR;
    if (Tcl_GetDouble(interp, argv[4], &precis) != TCL_OK)
	return TCL_ERROR;
    if (Tcl_GetBoolean(interp, argv[3], &force_replace) != TCL_OK)
	return TCL_ERROR;
    if (Tcl_SplitList(interp, argv[2], &numels, &listels) != TCL_OK)
	return TCL_ERROR;

    fmask = 0;
    for (i = 0; i < numels; i++) {
	if (!strncmp(listels[i], "KF_FROMX_MASK", 13)) {
	    fmask |= KF_FROMX_MASK;
	}
	else if (!strncmp(listels[i], "KF_FROMY_MASK", 13)) {
	    fmask |= KF_FROMY_MASK;
	}
	else if (!strncmp(listels[i], "KF_FROMZ_MASK", 13)) {
	    fmask |= KF_FROMZ_MASK;
	}
	else if (!strncmp(listels[i], "KF_FROM_MASK", 12)) {
	    fmask |= KF_FROM_MASK;
	}
	else if (!strncmp(listels[i], "KF_DIRX_MASK", 12)) {
	    fmask |= KF_DIRX_MASK;
	}
	else if (!strncmp(listels[i], "KF_DIRY_MASK", 12)) {
	    fmask |= KF_DIRY_MASK;
	}
	else if (!strncmp(listels[i], "KF_DIRZ_MASK", 12)) {
	    fmask |= KF_DIRZ_MASK;
	}
	else if (!strncmp(listels[i], "KF_DIR_MASK", 11)) {
	    fmask |= KF_DIR_MASK;
	}
	else if (!strncmp(listels[i], "KF_FOV_MASK", 11)) {
	    fmask |= KF_FOV_MASK;
	}
	else if (!strncmp(listels[i], "KF_TWIST_MASK", 13)) {
	    fmask |= KF_TWIST_MASK;
	}
	else if (!strncmp(listels[i], "KF_ALL_MASK", 11)) {
	    fmask |= KF_ALL_MASK;
	}
	else {
	    sprintf(tmp, "Error: mask constant %s not understood",
		    listels[i]);
	    Tcl_SetResult(interp, tmp, TCL_VOLATILE);
	    Tcl_Free((char *)listels);
	    return (TCL_ERROR);
	}
    }

    Tcl_Free((char *)listels);

    /* Call the function */
    GK_add_key((float)pos, fmask, force_replace, (float)precis);

    return (TCL_OK);

}