Esempio n. 1
0
TclTextInterp::TclTextInterp(VMDApp *vmdapp, int guienabled, int mpienabled)
: app(vmdapp) {
  
  interp = Tcl_CreateInterp();
#if 0
  Tcl_InitMemory(interp); // enable Tcl memory debugging features
                          // when compiled with TCL_MEM_DEBUG
#endif

  commandPtr = Tcl_NewObj();
  Tcl_IncrRefCount(commandPtr);
  consoleisatty = vmd_isatty(0); // whether we're interactive or not
  ignorestdin = 0;
  gotPartial = 0;
  needPrompt = 1;
  callLevel = 0;
  starttime = delay = 0;

#if defined(VMDMPI)
  //
  // MPI builds of VMD cannot try to read any command input from the 
  // console because it creates shutdown problems, at least with MPICH.
  // File-based command input is fine however.
  //
  // don't check for interactive console input if running in parallel
  if (mpienabled)
    ignorestdin = 1;
#endif

#if defined(ANDROIDARMV7A)
  //
  // For the time being, the Android builds won't attempt to get any
  // console input.  Any input we're going to get is going to come via
  // some means other than stdin, such as a network socket, text box, etc.
  //
  // Don't check for interactive console input if compiled for Android
  ignorestdin = 1;
#endif

  // set tcl_interactive, lets us run unix commands as from a shell
#if !defined(VMD_NANOHUB)
  Tcl_SetVar(interp, "tcl_interactive", "1", 0);
#else
  Tcl_SetVar(interp, "tcl_interactive", "0", 0);

  Tcl_Channel channel;
#define CLIENT_READ	(3)
#define CLIENT_WRITE	(4)
  channel = Tcl_MakeFileChannel((ClientData)CLIENT_READ, TCL_READABLE);
  if (channel != NULL) {
      const char *result;

      Tcl_RegisterChannel(interp, channel);
      result = Tcl_SetVar2(interp, "vmd_client", "read", 
		Tcl_GetChannelName(channel), 
		TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG);
      if (result == NULL) {
	  fprintf(stderr, "can't create variable for client read channel\n");
      }
  }
  channel = Tcl_MakeFileChannel((ClientData)CLIENT_WRITE, TCL_WRITABLE);
  if (channel != NULL) {
      const char *result;

      Tcl_RegisterChannel(interp, channel);
      result = Tcl_SetVar2(interp, "vmd_client", "write", 
		Tcl_GetChannelName(channel), 
		TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG);
      if (result == NULL) {
	  fprintf(stderr, "can't create variable for client write channel\n");
      }
  }
  write(CLIENT_WRITE, "vmd 1.0\n", 8);
#endif


  // pass our instance of VMDApp to a hash table assoc. with the interpreter 
  Tcl_SetAssocData(interp, "VMDApp", NULL, app);
 
  // Set up argc, argv0, and argv variables
  {
    char argcbuf[20];
    sprintf(argcbuf, "%d", app->argc_m);
    Tcl_SetVar(interp, "argc", argcbuf, TCL_GLOBAL_ONLY);
    // it might be better to use the same thing that was passed to
    // Tcl_FindExecutable, but this is now
    Tcl_SetVar(interp, "argv0", app->argv_m[0], TCL_GLOBAL_ONLY);
    char *args = Tcl_Merge(app->argc_m-1, app->argv_m+1);
    Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);
    Tcl_Free(args);
  }

#if defined(_MSC_VER) && TCL_MINOR_VERSION >= 4
  // The Windows versions of Tcl 8.5.x have trouble finding
  // the Tcl library subdirectory for unknown reasons.
  // We force the appropriate env variables to be set in Tcl, 
  // despite Windows.
  {
    char vmdinitscript[4096];
    char * tcl_library = getenv("TCL_LIBRARY");
    char * tk_library = getenv("TK_LIBRARY");

    if (tcl_library) {
      sprintf(vmdinitscript, "set env(TCL_LIBRARY) {%s}", tcl_library);
      if (Tcl_Eval(interp, vmdinitscript) != TCL_OK) {
        msgErr << Tcl_GetStringResult(interp) << sendmsg;
      }
    }
    if (tk_library) {
      sprintf(vmdinitscript, "set env(TK_LIBRARY) {%s}", tk_library);
      if (Tcl_Eval(interp, vmdinitscript) != TCL_OK) {
        msgErr << Tcl_GetStringResult(interp) << sendmsg;
      }
    }
  }
#endif

  if (Tcl_Init(interp) == TCL_ERROR) {  // new with 7.6
    msgErr << "Tcl startup error: " << Tcl_GetStringResult(interp) << sendmsg;
  }

#ifdef VMDTK
  // and the Tk commands (but only if a GUI is available!)
  if (guienabled) {
    if (Tk_Init(interp) == TCL_ERROR) {
      msgErr << "Tk startup error: " << Tcl_GetStringResult(interp) << sendmsg;
    } else {
      Tcl_StaticPackage(interp,  "Tk",
                        (Tcl_PackageInitProc *) Tk_Init,
                        (Tcl_PackageInitProc *) NULL);
    }
  } // end of check that GUI is allowed
#endif
  add_commands();
}
Esempio n. 2
0
int
common_dm(int argc, const char *argv[])
{
    int status;
    struct bu_vls vls = BU_VLS_INIT_ZERO;

    if (dbip == DBI_NULL)
	return TCL_OK;

    if (BU_STR_EQUAL(argv[0], "idle")) {

	/* redraw after scaling */
	if (gedp && gedp->ged_gvp &&
	    gedp->ged_gvp->gv_adaptive_plot &&
	    gedp->ged_gvp->gv_redraw_on_zoom &&
	    (am_mode == AMM_SCALE ||
	     am_mode == AMM_CON_SCALE_X ||
	     am_mode == AMM_CON_SCALE_Y ||
	     am_mode == AMM_CON_SCALE_Z))
	{
	    if (redraw_visible_objects() == TCL_ERROR) {
		return TCL_ERROR;
	    }
	}

	am_mode = AMM_IDLE;
	scroll_active = 0;
	if (rubber_band->rb_active) {
	    rubber_band->rb_active = 0;

	    if (mged_variables->mv_mouse_behavior == 'p')
		rb_set_dirty_flag();
	    else if (mged_variables->mv_mouse_behavior == 'r')
		rt_rect_area();
	    else if (mged_variables->mv_mouse_behavior == 'z')
		zoom_rect_area();
	}

	return TCL_OK;
    }

    if (BU_STR_EQUAL(argv[0], "m")) {
	int x;
	int y;
	int old_orig_gui;
	int stolen = 0;
	fastf_t fx, fy;

	if (argc < 3) {
	    Tcl_AppendResult(INTERP, "dm m: need more parameters\n",
			     "dm m xpos ypos\n", (char *)NULL);
	    return TCL_ERROR;
	}

	old_orig_gui = mged_variables->mv_orig_gui;

	fx = dm_Xx2Normal(dmp, atoi(argv[1]));
	fy = dm_Xy2Normal(dmp, atoi(argv[2]), 0);
	x = fx * GED_MAX;
	y = fy * GED_MAX;

	if (mged_variables->mv_faceplate &&
	    mged_variables->mv_orig_gui) {
#define MENUXLIM (-1250)

	    if (x >= MENUXLIM && scroll_select(x, y, 0)) {
		stolen = 1;
		goto end;
	    }

	    if (x < MENUXLIM && mmenu_select(y, 0)) {
		stolen = 1;
		goto end;
	    }
	}

	mged_variables->mv_orig_gui = 0;
	fy = dm_Xy2Normal(dmp, atoi(argv[2]), 1);
	y = fy * GED_MAX;

    end:
	if (mged_variables->mv_mouse_behavior == 'q' && !stolen) {
	    point_t view_pt;
	    point_t model_pt;

	    if (grid_state->gr_snap)
		snap_to_grid(&fx, &fy);

	    if (mged_variables->mv_perspective_mode)
		VSET(view_pt, fx, fy, 0.0);
	    else
		VSET(view_pt, fx, fy, 1.0);

	    MAT4X3PNT(model_pt, view_state->vs_gvp->gv_view2model, view_pt);
	    VSCALE(model_pt, model_pt, base2local);
	    if (dmp->dm_zclip)
		bu_vls_printf(&vls, "qray_nirt %lf %lf %lf",
			      model_pt[X], model_pt[Y], model_pt[Z]);
	    else
		bu_vls_printf(&vls, "qray_nirt -b %lf %lf %lf",
			      model_pt[X], model_pt[Y], model_pt[Z]);
	} else if ((mged_variables->mv_mouse_behavior == 'p' ||
		    mged_variables->mv_mouse_behavior == 'r' ||
		    mged_variables->mv_mouse_behavior == 'z') && !stolen) {

	    if (grid_state->gr_snap)
		snap_to_grid(&fx, &fy);

	    rubber_band->rb_active = 1;
	    rubber_band->rb_x = fx;
	    rubber_band->rb_y = fy;
	    rubber_band->rb_width = 0.0;
	    rubber_band->rb_height = 0.0;
	    rect_view2image();
	    rb_set_dirty_flag();
	} else if (mged_variables->mv_mouse_behavior == 's' && !stolen) {
#if 0
	    if (grid_state->gr_snap) {
		snap_to_grid(&fx, &fy);
		x = fx * GED_MAX;
		y = fy * GED_MAX;
	    }
#endif
	    bu_vls_printf(&vls, "mouse_solid_edit_select %d %d", x, y);
	} else if (mged_variables->mv_mouse_behavior == 'm' && !stolen) {
#if 0
	    if (grid_state->gr_snap) {
		snap_to_grid(&fx, &fy);
		x = fx * GED_MAX;
		y = fy * GED_MAX;
	    }
#endif
	    bu_vls_printf(&vls, "mouse_matrix_edit_select %d %d", x, y);
	} else if (mged_variables->mv_mouse_behavior == 'c' && !stolen) {
#if 0
	    if (grid_state->gr_snap) {
		snap_to_grid(&fx, &fy);
		x = fx * GED_MAX;
		y = fy * GED_MAX;
	    }
#endif
	    bu_vls_printf(&vls, "mouse_comb_edit_select %d %d", x, y);
	} else if (mged_variables->mv_mouse_behavior == 'o' && !stolen) {
#if 0
	    if (grid_state->gr_snap) {
		snap_to_grid(&fx, &fy);
		x = fx * GED_MAX;
		y = fy * GED_MAX;
	    }
#endif
	    bu_vls_printf(&vls, "mouse_rt_obj_select %d %d", x, y);
	} else if (adc_state->adc_draw && mged_variables->mv_transform == 'a' && !stolen) {
	    point_t model_pt;
	    point_t view_pt;

	    if (grid_state->gr_snap)
		snap_to_grid(&fx, &fy);

	    VSET(view_pt, fx, fy, 1.0);
	    MAT4X3PNT(model_pt, view_state->vs_gvp->gv_view2model, view_pt);
	    VSCALE(model_pt, model_pt, base2local);
	    bu_vls_printf(&vls, "adc xyz %lf %lf %lf\n", model_pt[X], model_pt[Y], model_pt[Z]);
	} else if (grid_state->gr_snap && !stolen &&
		   SEDIT_TRAN && mged_variables->mv_transform == 'e') {
	    point_t view_pt;
	    point_t model_pt;

	    snap_to_grid(&fx, &fy);
	    MAT4X3PNT(view_pt, view_state->vs_gvp->gv_model2view, curr_e_axes_pos);
	    view_pt[X] = fx;
	    view_pt[Y] = fy;
	    MAT4X3PNT(model_pt, view_state->vs_gvp->gv_view2model, view_pt);
	    VSCALE(model_pt, model_pt, base2local);
	    bu_vls_printf(&vls, "p %lf %lf %lf", model_pt[X], model_pt[Y], model_pt[Z]);
	} else if (grid_state->gr_snap && !stolen &&
		   OEDIT_TRAN && mged_variables->mv_transform == 'e') {
	    point_t view_pt;
	    point_t model_pt;

	    snap_to_grid(&fx, &fy);
	    MAT4X3PNT(view_pt, view_state->vs_gvp->gv_model2view, curr_e_axes_pos);
	    view_pt[X] = fx;
	    view_pt[Y] = fy;
	    MAT4X3PNT(model_pt, view_state->vs_gvp->gv_view2model, view_pt);
	    VSCALE(model_pt, model_pt, base2local);
	    bu_vls_printf(&vls, "translate %lf %lf %lf", model_pt[X], model_pt[Y], model_pt[Z]);
	} else if (grid_state->gr_snap && !stolen &&
		   STATE != ST_S_PICK && STATE != ST_O_PICK &&
		   STATE != ST_O_PATH && !SEDIT_PICK && !EDIT_SCALE) {
	    point_t view_pt;
	    point_t model_pt;
	    point_t vcenter;

	    snap_to_grid(&fx, &fy);
	    MAT_DELTAS_GET_NEG(vcenter, view_state->vs_gvp->gv_center);
	    MAT4X3PNT(view_pt, view_state->vs_gvp->gv_model2view, vcenter);
	    view_pt[X] = fx;
	    view_pt[Y] = fy;
	    MAT4X3PNT(model_pt, view_state->vs_gvp->gv_view2model, view_pt);
	    VSCALE(model_pt, model_pt, base2local);
	    bu_vls_printf(&vls, "center %lf %lf %lf", model_pt[X], model_pt[Y], model_pt[Z]);
	} else
	    bu_vls_printf(&vls, "M 1 %d %d\n", x, y);

	status = Tcl_Eval(INTERP, bu_vls_addr(&vls));
	mged_variables->mv_orig_gui = old_orig_gui;
	bu_vls_free(&vls);

	return status;
    }

    if (BU_STR_EQUAL(argv[0], "am")) {
	if (argc < 4) {
	    Tcl_AppendResult(INTERP, "dm am: need more parameters\n",
			     "dm am <r|t|s> xpos ypos\n", (char *)NULL);
	    return TCL_ERROR;
	}

	dml_omx = atoi(argv[2]);
	dml_omy = atoi(argv[3]);

	switch (*argv[1]) {
	    case 'r':
		am_mode = AMM_ROT;
		break;
	    case 't':
		am_mode = AMM_TRAN;

		if (grid_state->gr_snap) {
		    int save_edflag;

		    if ((STATE == ST_S_EDIT || STATE == ST_O_EDIT) &&
			mged_variables->mv_transform == 'e') {
			if (STATE == ST_S_EDIT) {
			    save_edflag = es_edflag;
			    if (!SEDIT_TRAN)
				es_edflag = STRANS;
			} else {
			    save_edflag = edobj;
			    edobj = BE_O_XY;
			}

			snap_keypoint_to_grid();

			if (STATE == ST_S_EDIT)
			    es_edflag = save_edflag;
			else
			    edobj = save_edflag;
		    } else
			snap_view_center_to_grid();
		}

		break;
	    case 's':
		if (STATE == ST_S_EDIT && mged_variables->mv_transform == 'e' &&
		    ZERO(acc_sc_sol))
		    acc_sc_sol = 1.0;
		else if (STATE == ST_O_EDIT && mged_variables->mv_transform == 'e') {
		    edit_absolute_scale = acc_sc_obj - 1.0;
		    if (edit_absolute_scale > 0.0)
			edit_absolute_scale /= 3.0;
		}

		am_mode = AMM_SCALE;
		break;
	    default:
		Tcl_AppendResult(INTERP, "dm am: need more parameters\n",
				 "dm am <r|t|s> xpos ypos\n", (char *)NULL);
		return TCL_ERROR;
	}

	return TCL_OK;
    }

    if (BU_STR_EQUAL(argv[0], "adc")) {
	fastf_t fx, fy;
	fastf_t td; /* tick distance */

	if (argc < 4) {
	    Tcl_AppendResult(INTERP, "dm adc: need more parameters\n",
			     "dm adc 1|2|t|d xpos ypos\n", (char *)NULL);
	    return TCL_ERROR;
	}

	dml_omx = atoi(argv[2]);
	dml_omy = atoi(argv[3]);

	switch (*argv[1]) {
	    case '1':
		fx = dm_Xx2Normal(dmp, dml_omx) * GED_MAX - adc_state->adc_dv_x;
		fy = dm_Xy2Normal(dmp, dml_omy, 1) * GED_MAX - adc_state->adc_dv_y;

		bu_vls_printf(&vls, "adc a1 %lf\n", RAD2DEG*atan2(fy, fx));
		Tcl_Eval(INTERP, bu_vls_addr(&vls));
		bu_vls_free(&vls);

		am_mode = AMM_ADC_ANG1;
		break;
	    case '2':
		fx = dm_Xx2Normal(dmp, dml_omx) * GED_MAX - adc_state->adc_dv_x;
		fy = dm_Xy2Normal(dmp, dml_omy, 1) * GED_MAX - adc_state->adc_dv_y;

		bu_vls_printf(&vls, "adc a2 %lf\n", RAD2DEG*atan2(fy, fx));
		Tcl_Eval(INTERP, bu_vls_addr(&vls));
		bu_vls_free(&vls);

		am_mode = AMM_ADC_ANG2;
		break;
	    case 't':
		{
		    point_t model_pt;
		    point_t view_pt;

		    VSET(view_pt, dm_Xx2Normal(dmp, dml_omx), dm_Xy2Normal(dmp, dml_omy, 1), 0.0);

		    if (grid_state->gr_snap)
			snap_to_grid(&view_pt[X], &view_pt[Y]);

		    MAT4X3PNT(model_pt, view_state->vs_gvp->gv_view2model, view_pt);
		    VSCALE(model_pt, model_pt, base2local);

		    bu_vls_printf(&vls, "adc xyz %lf %lf %lf\n", model_pt[X], model_pt[Y], model_pt[Z]);
		    Tcl_Eval(INTERP, bu_vls_addr(&vls));

		    bu_vls_free(&vls);
		    am_mode = AMM_ADC_TRAN;
		}

		break;
	    case 'd':
		fx = (dm_Xx2Normal(dmp, dml_omx) * GED_MAX -
		      adc_state->adc_dv_x) * view_state->vs_gvp->gv_scale * base2local * INV_GED;
		fy = (dm_Xy2Normal(dmp, dml_omy, 1) * GED_MAX -
		      adc_state->adc_dv_y) * view_state->vs_gvp->gv_scale * base2local * INV_GED;

		td = sqrt(fx * fx + fy * fy);

		bu_vls_printf(&vls, "adc dst %lf\n", td);
		Tcl_Eval(INTERP, bu_vls_addr(&vls));
		bu_vls_free(&vls);

		am_mode = AMM_ADC_DIST;
		break;
	    default:
		Tcl_AppendResult(INTERP, "dm adc: unrecognized parameter - ", argv[1],
				 "\ndm adc 1|2|t|d xpos ypos\n", (char *)NULL);
		return TCL_ERROR;
	}

	return TCL_OK;
    }

    if (BU_STR_EQUAL(argv[0], "con")) {
	if (argc < 5) {
	    Tcl_AppendResult(INTERP, "dm con: need more parameters\n",
			     "dm con r|t|s x|y|z xpos ypos\n",
			     "dm con a x|y|1|2|d xpos ypos\n", (char *)NULL);
	    return TCL_ERROR;
	}

	dml_omx = atoi(argv[3]);
	dml_omy = atoi(argv[4]);

	switch (*argv[1]) {
	    case 'a':
		switch (*argv[2]) {
		    case 'x':
			am_mode = AMM_CON_XADC;
			break;
		    case 'y':
			am_mode = AMM_CON_YADC;
			break;
		    case '1':
			am_mode = AMM_CON_ANG1;
			break;
		    case '2':
			am_mode = AMM_CON_ANG2;
			break;
		    case 'd':
			am_mode = AMM_CON_DIST;
			break;
		    default:
			Tcl_AppendResult(INTERP, "dm con: unrecognized parameter - ", argv[2],
					 "\ndm con a x|y|1|2|d xpos ypos\n", (char *)NULL);
		}
		break;
	    case 'r':
		switch (*argv[2]) {
		    case 'x':
			am_mode = AMM_CON_ROT_X;
			break;
		    case 'y':
			am_mode = AMM_CON_ROT_Y;
			break;
		    case 'z':
			am_mode = AMM_CON_ROT_Z;
			break;
		    default:
			Tcl_AppendResult(INTERP, "dm con: unrecognized parameter - ", argv[2],
					 "\ndm con r|t|s x|y|z xpos ypos\n", (char *)NULL);
			return TCL_ERROR;
		}
		break;
	    case 't':
		switch (*argv[2]) {
		    case 'x':
			am_mode = AMM_CON_TRAN_X;
			break;
		    case 'y':
			am_mode = AMM_CON_TRAN_Y;
			break;
		    case 'z':
			am_mode = AMM_CON_TRAN_Z;
			break;
		    default:
			Tcl_AppendResult(INTERP, "dm con: unrecognized parameter - ", argv[2],
					 "\ndm con r|t|s x|y|z xpos ypos\n", (char *)NULL);
			return TCL_ERROR;
		}
		break;
	    case 's':
		switch (*argv[2]) {
		    case 'x':
			if (STATE == ST_S_EDIT && mged_variables->mv_transform == 'e' &&
			    ZERO(acc_sc_sol))
			    acc_sc_sol = 1.0;
			else if (STATE == ST_O_EDIT && mged_variables->mv_transform == 'e') {
			    edit_absolute_scale = acc_sc[0] - 1.0;
			    if (edit_absolute_scale > 0.0)
				edit_absolute_scale /= 3.0;
			}

			am_mode = AMM_CON_SCALE_X;
			break;
		    case 'y':
			if (STATE == ST_S_EDIT && mged_variables->mv_transform == 'e' &&
			    ZERO(acc_sc_sol))
			    acc_sc_sol = 1.0;
			else if (STATE == ST_O_EDIT && mged_variables->mv_transform == 'e') {
			    edit_absolute_scale = acc_sc[1] - 1.0;
			    if (edit_absolute_scale > 0.0)
				edit_absolute_scale /= 3.0;
			}

			am_mode = AMM_CON_SCALE_Y;
			break;
		    case 'z':
			if (STATE == ST_S_EDIT && mged_variables->mv_transform == 'e' &&
			    ZERO(acc_sc_sol))
			    acc_sc_sol = 1.0;
			else if (STATE == ST_O_EDIT && mged_variables->mv_transform == 'e') {
			    edit_absolute_scale = acc_sc[2] - 1.0;
			    if (edit_absolute_scale > 0.0)
				edit_absolute_scale /= 3.0;
			}

			am_mode = AMM_CON_SCALE_Z;
			break;
		    default:
			Tcl_AppendResult(INTERP, "dm con: unrecognized parameter - ", argv[2],
					 "\ndm con r|t|s x|y|z xpos ypos\n", (char *)NULL);
			return TCL_ERROR;
		}
		break;
	    default:
		Tcl_AppendResult(INTERP, "dm con: unrecognized parameter - ", argv[1],
				 "\ndm con r|t|s x|y|z xpos ypos\n", (char *)NULL);
		return TCL_ERROR;
	}

	return TCL_OK;
    }

    if (BU_STR_EQUAL(argv[0], "size")) {
	int width, height;

	/* get the window size */
	if (argc == 1) {
	    bu_vls_printf(&vls, "%d %d", dmp->dm_width, dmp->dm_height);
	    Tcl_AppendResult(INTERP, bu_vls_addr(&vls), (char *)NULL);
	    bu_vls_free(&vls);

	    return TCL_OK;
	}

	/* set the window size */
	if (argc == 3) {
	    width = atoi(argv[1]);
	    height = atoi(argv[2]);

	    dmp->dm_width = width;
	    dmp->dm_height = height;

#if defined(DM_X) || defined(DM_TK) || defined(DM_OGL) || defined(DM_WGL)
#  if 0
	    Tk_ResizeWindow(((struct dm_xvars *)dmp->dm_vars.pub_vars)->xtkwin, width, height);
#  else
#if defined(HAVE_TK)
	    Tk_GeometryRequest(((struct dm_xvars *)dmp->dm_vars.pub_vars)->xtkwin, width, height);
#endif
#  endif
#endif

	    return TCL_OK;
	}

	Tcl_AppendResult(INTERP, "Usage: dm size [width height]\n", (char *)NULL);
	return TCL_ERROR;
    }

#if defined(DM_X) || defined(DM_TK) || defined(DM_OGL) || defined(DM_WGL)
    if (BU_STR_EQUAL(argv[0], "getx")) {
	if (argc == 1) {
	    struct bu_vls tmp_vls = BU_VLS_INIT_ZERO;

	    /* Bare set command, print out current settings */
	    bu_vls_struct_print2(&tmp_vls, "dm internal X variables", dm_xvars_vparse,
				 (const char *)dmp->dm_vars.pub_vars);
	    Tcl_AppendResult(INTERP, bu_vls_addr(&tmp_vls), (char *)NULL);
	    bu_vls_free(&tmp_vls);
	} else if (argc == 2) {
	    bu_vls_struct_item_named(&vls, dm_xvars_vparse, argv[1], (const char *)dmp->dm_vars.pub_vars, COMMA);
	    Tcl_AppendResult(INTERP, bu_vls_addr(&vls), (char *)NULL);
	    bu_vls_free(&vls);
	}

	return TCL_OK;
    }
#endif

    if (BU_STR_EQUAL(argv[0], "bg")) {
	int r, g, b;

	if (argc != 1 && argc != 4) {
	    bu_vls_printf(&vls, "Usage: dm bg [r g b]");
	    Tcl_AppendResult(INTERP, bu_vls_addr(&vls), (char *)NULL);
	    bu_vls_free(&vls);

	    return TCL_ERROR;
	}

	/* return background color of current display manager */
	if (argc == 1) {
	    bu_vls_printf(&vls, "%d %d %d",
			  dmp->dm_bg[0],
			  dmp->dm_bg[1],
			  dmp->dm_bg[2]);
	    Tcl_AppendResult(INTERP, bu_vls_addr(&vls), (char *)NULL);
	    bu_vls_free(&vls);

	    return TCL_OK;
	}

	if (sscanf(argv[1], "%d", &r) != 1 ||
	    sscanf(argv[2], "%d", &g) != 1 ||
	    sscanf(argv[3], "%d", &b) != 1) {
	    bu_vls_printf(&vls, "Usage: dm bg r g b");
	    Tcl_AppendResult(INTERP, bu_vls_addr(&vls), (char *)NULL);
	    bu_vls_free(&vls);

	    return TCL_ERROR;
	}

	dirty = 1;
	return DM_SET_BGCOLOR(dmp, r, g, b);
    }

    Tcl_AppendResult(INTERP, "dm: bad command - ", argv[0], "\n", (char *)NULL);
    return TCL_ERROR;
}
Esempio n. 3
0
	virtual void OnPostRehash() {
		if (interp) {
			Tcl_Eval(interp,"rehash");
			Tcl_Eval(interp,"Binds::ProcessEvnt rehash");
		}
	}
Esempio n. 4
0
int
run_main (int, ACE_TCHAR *[])
{
  ACE_START_TEST (ACE_TEXT ("TkReactor_Test"));

  tcl_interp   = Tcl_CreateInterp ();

  if (init (tcl_interp) != TCL_OK) {
    ACE_OS::exit (1);
  }

  Tk_Window tk = 0;
  tk = Tk_MainWindow(tcl_interp);
  if (tk == 0)
    {
      ACE_ERROR_RETURN ((LM_ERROR, "Tk_Reactor_Test: %s\n", tcl_interp->result),1);
    }

  char tcl_cmd[] = "source TkReactor_Test.tcl";
  if (Tcl_Eval (tcl_interp, tcl_cmd) != TCL_OK) {
    ACE_OS::exit (1);
  }
  // set up callback
  char label_var_name[] = "label_var";
  char pressme[] = "pressme";
  Tcl_CreateCommand (tcl_interp,
                     pressme,
                     inc_count,
                     label_var_name,
                     0);

  // Register callback for X Timer
  (void) Tk_CreateTimerHandler (1000,
                                inc_tmo,
                                label_var_name);

  // It will perform Tk Main Loop
  ACE_TkReactor reactor;
  ACE_Reactor r (&reactor);

  //Event Handler for ACE Timer.
  EV_handler evh;

  ACE_Acceptor <Connection_Handler, ACE_SOCK_ACCEPTOR> acceptor;

  if (acceptor.open (ACE_INET_Addr ((u_short) SERV_TCP_PORT),
                     &r) == -1)
    ACE_ERROR_RETURN ((LM_ERROR,
                       "%p\n",
                       "open"),
                      -1);

  if (reactor.schedule_timer (&evh,
                              (const void *) "label_var",
                              ACE_Time_Value (2),
                              ACE_Time_Value (2))==-1)
    ACE_ERROR_RETURN ((LM_ERROR,
                       " (%P|%t) can't register with reactor\n"),
                      -1);

  ACE_Thread_Manager::instance ()->spawn ((ACE_THR_FUNC) client,
                                          0,
                                          THR_NEW_LWP | THR_DETACHED);

  while (!quit)
    {
      int result = reactor.handle_events ();
      switch (result)
        {
        case 0:
          //          ACE_DEBUG ((LM_DEBUG,"handle_events timed out\n"));
          break;
        case -1:
          ACE_DEBUG ((LM_DEBUG,"handle_events returned -1\n"));
          quit = 1;
          break;
        }
    }

  ACE_END_TEST;
  return 0;
}
Esempio n. 5
0
/********************************************************************************************
 * InitTcl
 * purpose : Initialize the TCL part of the test application
 * input   : executable     - Program executable
 *           versionString  - Stack version string
 * output  : reason         - Reason of failure on failure
 * return  : Tcl_Interp interpreter for tcl commands
 *           NULL on failure
 ********************************************************************************************/
Tcl_Interp* InitTcl(const char* executable, char* versionString, char** reason)
{
    static char strBuf[1024];
    int retCode;

    /* Find TCL executable and create an interpreter */
    Tcl_FindExecutable(executable);
    interp = Tcl_CreateInterp();

    if (interp == NULL)
    {
        *reason = (char*)"Failed to create Tcl interpreter";
        return NULL;
    }

    /* Overload file and source commands */
    TclExecute("rename file fileOverloaded");
    CREATE_COMMAND("file", test_File);
    CREATE_COMMAND("source", test_Source);

    /* Reroute tcl libraries - we'll need this one later */
    /*TclSetVariable("tcl_library", TCL_LIBPATH);
    TclSetVariable("env(TCL_LIBRARY)", TCL_LIBPATH);
    TclSetVariable("tk_library", TK_LIBPATH);
    TclSetVariable("env(TK_LIBRARY)", TK_LIBPATH);*/

    /* Initialize TCL */
    retCode = Tcl_Init(interp);
    if (retCode != TCL_OK)
    {
        sprintf(strBuf, "Error in Tcl_Init: %s", Tcl_GetStringResult(interp));
        *reason = strBuf;
        Tcl_DeleteInterp(interp);
        return NULL;
    }

    /* Initialize TK */
    retCode = Tk_Init(interp);
    if (retCode != TCL_OK)
    {
        sprintf(strBuf, "Error in Tk_Init: %s", Tcl_GetStringResult(interp));
        *reason = strBuf;
        Tcl_DeleteInterp(interp);
        return NULL;
    }

    /* Set argc and argv parameters for the script.
       This allows us to work with C in the scripts. */
    retCode = TclExecute("set tmp(version) {Test Application: %s }", versionString);
    if (retCode != TCL_OK)
    {
        *reason = (char*)"Error setting stack's version for test application";
        return interp;
    }

    /* Create new commands that are used in the tcl script */
    CreateTclCommands(interp);

    Tcl_LinkVar(interp, (char *)"scriptLogs", (char *)&LogWrappers, TCL_LINK_BOOLEAN);

    /* Evaluate the Tcl script of the test application */
    retCode = Tcl_Eval(interp, (char*)"source " TCL_FILENAME);
    if (retCode != TCL_OK)
    {
        sprintf(strBuf, "Error reading testapp script (line %d): %s\n", interp->errorLine, Tcl_GetStringResult(interp));
        *reason = strBuf;
        return NULL;
    }

    /* Return the created interpreter */
    *reason = NULL;
    return interp;
}
Esempio n. 6
0
void
cs_callback(GapIO *io, int contig, void *fdata, reg_data *jdata) {
    char cmd[1024];
    obj_cs *cs = (obj_cs *)fdata;

    switch(jdata->job) {
    case REG_BUFFER_START:
	{
#ifdef DEBUG
	    printf("REG_BUFFER_START count %d \n", cs->buffer_count);
#endif
	    cs->buffer_count++;
	    cs->do_update = REG_BUFFER_START;
	    return;
	}
    case REG_BUFFER_END:
	{
#ifdef DEBUG
	    printf("REG_BUFFER_END count %d \n", cs->buffer_count);
#endif
	    cs->buffer_count--;
	    if (cs->buffer_count <= 0) {
		cs->buffer_count = 0;
		if (cs->do_update & REG_LENGTH) {

		} else if (cs->do_update & REG_ANNO) {
		    Tcl_VarEval(GetInterp(), cs->hori, " delete tag", NULL);
		    display_cs_tags(GetInterp(), io, cs);
		    scaleSingleCanvas(GetInterp(), cs->world, cs->canvas,
				      cs->hori, 'x', "tag");
		} else if (cs->do_update & REG_ORDER) {
		    update_contig_selector(GetInterp(), io, cs);
		    if (cs->vert[0] != '\0') {
			update_contig_comparator(GetInterp(), io, cs);
		    }
		}
		cs->do_update = 0;
	    }
	    return;
	}
    case REG_QUERY_NAME:
	{
	    sprintf(jdata->name.line, "Contig selector");
	    return;
	}

    case REG_GET_OPS:
	{
	    /* jdata->get_ops.ops = "Information\0Configure\0"; */
	    return;
	}
    case REG_ANNO:
	{
#ifdef DEBUG
	    printf("contig selector REG_ANNO\n");
#endif
	    if (!cs->do_update) {
		Tcl_VarEval(GetInterp(), cs->hori, " delete tag", NULL);
		display_cs_tags(GetInterp(), io, cs);
		scaleSingleCanvas(GetInterp(), cs->world, cs->canvas,
				  cs->hori, 'x', "tag");
	    } else {
		cs->do_update |= REG_ANNO;
	    }
	    return;
	}
    case REG_ORDER:
	{

#ifdef DEBUG
	    printf("contig selector REG_ORDER %d\n", cs->buffer_count);
#endif
	    if (!cs->do_update) {

		update_contig_selector(GetInterp(), io, cs);
		if (cs->vert[0] != '\0') {
		    update_contig_comparator(GetInterp(), io, cs);
		}
	    } else {
		cs->do_update |= REG_ORDER;
	    }
	    break;
	}
    case REG_QUIT:
	{
	    cs_shutdown(io, cs);
	    return;
	}

    case REG_GENERIC:
	switch(jdata->generic.task) {

	case TASK_WINDOW_ADD:
	    {
		win *winfo = (win *)jdata->generic.data;

		addWindow(cs->win_list, &cs->num_wins, winfo->window,
			  winfo->scroll, winfo->id);
		break;
	    }
	case TASK_WINDOW_DELETE:
	    {
		char *window = (char *)jdata->generic.data;

		deleteWindow(cs->win_list, &cs->num_wins, window);
		break;
	    }
	case TASK_CANVAS_SCROLLX:
	    {
		char *scroll = (char *)jdata->generic.data;

		canvasScrollX(GetInterp(), cs->window, cs->win_list,
			      cs->num_wins, cs->world->visible, cs->canvas,
			      scroll);
		break;
	    }
	case TASK_CANVAS_SCROLLY:
	    {
		char *scroll = (char *)jdata->generic.data;

		canvasScrollY(GetInterp(), cs->window, cs->win_list,
			      cs->num_wins, cs->world->visible, cs->canvas,
			      scroll);

		break;
	    }
	case TASK_CANVAS_RESIZE:
	    {
		char scroll_args[20];
		/* resize template display window */
		resizeCanvas(GetInterp(), cs->window, cs->win_list,
			     cs->num_wins, cs->world->visible,
			     cs->world->total, cs->canvas);
		sprintf(scroll_args, "scroll 0 units");
		canvasScrollX(GetInterp(), cs->window, cs->win_list,
			      cs->num_wins, cs->world->visible, cs->canvas,
			      scroll_args);

		break;
	    }
	case TASK_CANVAS_ZOOMBACK:
	    {

		if (lengthZoom(cs->zoom) <= 2) {
		    freeZoom(&cs->zoom);
		    pushZoom(&cs->zoom, cs->world->total);
		}

		canvasZoomback(GetInterp(), cs->canvas, cs->window, cs->world,
			       cs->win_list, cs->num_wins, &cs->zoom);

		break;
		}
	case TASK_CANVAS_ZOOM:
	    {
		s_zoom *szoom = (s_zoom *)jdata->generic.data;
		canvasZoom(GetInterp(), cs->canvas, cs->window, cs->world,
			   cs->win_list, cs->num_wins, &cs->zoom, szoom->zoom,
			   szoom->scroll);

		break;
	    }
	case TASK_CANVAS_CURSOR_X:
	    {
		char *label;
		int *cx = (int *)jdata->generic.data;
		double local_pos;
		double wx, wy;

		CanvasToWorld(cs->canvas, *cx, 0, &wx, &wy);

		label = get_default_string(GetInterp(), gap_defs,
					   "CONTIG_SEL.CURSOR1_X");

		canvasCursorX(GetInterp(), cs->canvas, cs->frame, label,
			      cs->cursor.colour, cs->cursor.width, *cx, wx,
			      cs->win_list, cs->num_wins);

		/* fill in local position of cursor in label box */
		local_pos = CSLocalCursor(io, wx);

		label = get_default_string(GetInterp(), gap_defs,
					   "CONTIG_SEL.CURSOR2_X");

		sprintf(cmd, "%s%s configure -text %d\n", cs->frame, label,
			(int)local_pos);
		Tcl_Eval(GetInterp(), cmd);

		break;
	    }
	case TASK_CANVAS_CURSOR_Y:
	    {
		char *label;
		int *cy = (int *)jdata->generic.data;
		double local_pos;
		double wx, wy;
		char cmd[1024];
		double cx1, cy1;

		CanvasToWorld(cs->canvas, 0, *cy, &wx, &wy);
		WorldToCanvas(cs->canvas, wy, 0, &cx1, &cy1);

		label = get_default_string(GetInterp(), gap_defs,
					   "CONTIG_SEL.CURSOR1_Y");

		canvasCursorY(GetInterp(), cs->canvas, cs->frame, label,
			      cs->cursor.colour, cs->cursor.width, *cy, wy,
			      cs->win_list, cs->num_wins);

		sprintf(cmd, "DrawCanvasCursorX1 %s %s %.20f %s %d\n",
			cs->frame, cs->hori, cx1, cs->cursor.colour,
			cs->cursor.width);
		if (TCL_ERROR == Tcl_Eval(GetInterp(), cmd))
		    printf("%s\n", GetInterpResult());

		/* fill in local position of cursor in label box */
		local_pos = CSLocalCursor(io, wy);

		label = get_default_string(GetInterp(), gap_defs,
					   "CONTIG_SEL.CURSOR2_Y");

		sprintf(cmd, "%s%s configure -text %d\n", cs->frame, label,
			(int)local_pos);
		Tcl_Eval(GetInterp(), cmd);

		break;
	    }
	case TASK_CANVAS_CURSOR_DELETE:
	    {
		int i;
		for (i = 0; i < cs->num_wins; i++) {
		    Tcl_VarEval(GetInterp(), cs->win_list[i]->window,
				" delete cursor_x cursor_x1 cursor_y", NULL);
		}
		break;
	    }
	case TASK_CS_REDRAW:
	    {
		/* HACK - never used */
		int i, id = register_id();

		for (i = 1; i <= NumContigs(io); i++) {
		    contig_deregister(io, i, cs_callback, fdata);
		    contig_register(io, i, cs_callback, fdata, id,
				    REG_REQUIRED |
				    REG_DATA_CHANGE |
				    REG_OPS |
				    REG_NUMBER_CHANGE |
				    REG_ANNO |
				    REG_GENERIC |
				    REG_FLAG_INVIS |
				    REG_BUFFER,
				    REG_TYPE_CONTIGSEL);
		}
		break;
	    }
	    break;
	}
	break;
    case REG_JOIN_TO:
    case REG_LENGTH:
    case REG_DELETE:
    case REG_COMPLEMENT:
    case REG_NUMBER_CHANGE:
#ifdef DEBUG
	printf("contig selector REG_REDRAW %d\n", cs->buffer_count);
#endif
	update_contig_selector(GetInterp(), io, cs);
	if (cs->vert[0] != '\0') {
	    update_contig_comparator(GetInterp(), io, cs);
	}
	/* update tcl globals, CurContig, LREG and RREG */
	sprintf(cmd, "ContigParams %d", *handle_io(io));
	Tcl_Eval(GetInterp(), cmd);


#ifdef HACK
	printf("COM %s \n", cs->com);
	if (cs->buffer_count) {
	    cs->do_update = 1;
	} else {
	    Tcl_Eval(cs->interp, cs->com);
	}
#endif
	break;
    }
}
Esempio n. 7
0
/** The main function.

    The function implementing the algorithm described in

    arXiv:hep-lat/0306017 v1 13 Jun 2003 \em Wolff, U. \em Monte Carlo errors with less errors.
*/
int UWerr_f(Tcl_Interp *interp, Tcl_CmdInfo * cmdInfo, int argc, char ** argv,
	    double ** data, int rows, int cols,
	    int * n_rep, int len, double s_tau, int plot)
{
  struct UWerr_t ret;
  int a, k, i, sum = 0, W_opt = 0, W_max = 0;
  double Fbb = 0, bF = 0, Fb = 0, * abb = 0L, tau = 0, tmp;
  double ** abr = 0L, * Fbr = 0L, * fgrad = 0L, * delpro = 0L;
  double * gFbb = 0L, CFbb_opt = 0, G_int = 0, std_a;
  char flag = 0;
  char * str = 0L;
  char * tcl_vector = 0L;
  char ** my_argv;

  FILE * plotDataf, * plotScriptf;

  ret.Q_val = 0;

  if (!data) {
    Tcl_AppendElement(interp, "No data matrix given.");
    return TCL_ERROR;
  }
  if (rows < 1) {
    Tcl_AppendElement(interp, "Data matrix has no rows.");
    return TCL_ERROR;
  }
  if (cols < 1) {
    Tcl_AppendElement(interp, "Data matrix has no columns.");
    return TCL_ERROR;
  }
  if(!cmdInfo && !cmdInfo->proc) {
    Tcl_AppendElement(interp, "No function to call given.");
    return TCL_ERROR;
  }
  if (!n_rep) {
    Tcl_AppendElement(interp, "No representations vector given.");
    return TCL_ERROR;
  }
  if (len < 1) {
    Tcl_AppendElement(interp, "Representations vector is empty.");
    return TCL_ERROR;
  }
  
  /* \sum_{i=1}^{len} n_rep[i-1] = rows */

  k = rows; /* for now k is going to be min(n_rep) */
  for (i = 0; i < len; ++i) {
    sum += n_rep[i];
    if (n_rep[i] < k)
      k = n_rep[i];
  }

  if (sum != rows || k <= 0) {
    Tcl_AppendElement(interp, "Representations vector is invalid.");
    return TCL_ERROR;
  }

  if (s_tau > 0) {
    W_max = (int)rint(k/2.); /* until here: k = min(n_rep) */
    flag = 1;
    if (W_max < 1) W_max = 1;
  }

  /* string for output of numbers */
  str = (char *)malloc((TCL_INTEGER_SPACE + TCL_DOUBLE_SPACE)*sizeof(char));

  if (!(delpro = (double*)malloc(rows*sizeof(double)))) {
    Tcl_AppendResult(interp, "Out of Memory.", __LINE__, (char *) NULL);
    free(str);
    return TCL_ERROR;
  }

  if (!(Fbr = (double*)malloc(len*sizeof(double)))) {
    free(delpro);
    free(str);
    Tcl_AppendResult(interp, "Out of Memory.", __LINE__, (char *) NULL);
    return TCL_ERROR;
  }

  if (!(fgrad = (double*)malloc(cols*sizeof(double)))) {
    free(delpro);
    free(Fbr);
    free(str);
    Tcl_AppendResult(interp, "Out of Memory.", __LINE__, (char *) NULL);
    return TCL_ERROR;
  }

  if (!(abb = (double*)malloc(cols*sizeof(double)))) {
    free(delpro);
    free(Fbr);
    free(fgrad);
    free(str);
    Tcl_AppendResult(interp, "Out of Memory.", __LINE__, (char *) NULL);
    return TCL_ERROR;
  }

  /* abr \in (\Real)_{len, cols} */
  if (!(abr = (double**)malloc(len*sizeof(double*)))) {
    free(delpro);
    free(Fbr);
    free(fgrad);
    free(abb);
    free(str);
    Tcl_AppendResult(interp, "Out of Memory.", __LINE__, (char *) NULL);
    return TCL_ERROR;
  }
  for (i = 0; i < len; ++i)
    if (!(abr[i] = (double*)malloc(cols*sizeof(double)))) {
      for (k = 0; k < i; ++k)
	free(abr[k]);

      free(abr);
      free(delpro);
      free(Fbr);
      free(fgrad);
      free(abb);
      free(str);
    
      Tcl_AppendResult(interp, "Out of Memory.", __LINE__, (char *) NULL);
      return TCL_ERROR;
    }

  
  if (W_max > 0) {
    if (!(gFbb = (double*)malloc((W_max+1)*sizeof(double)))) {
      free(delpro);
      free(Fbr);
      free(fgrad);
      free(abb);
      for (k = 0; k < len; ++k)
	free(abr[k]);
      free(abr);

      free(str);
      Tcl_AppendResult(interp, "Out of Memory.", __LINE__, (char *) NULL);
      return TCL_ERROR;
    }
  }
  
  if (uwerr_create_tcl_vector(&tcl_vector, cols)) {
      free(delpro);
      free(Fbr);
      free(fgrad);
      free(abb);
      for (k = 0; k < len; ++k)
	free(abr[k]);
      free(abr);
      free(gFbb);

      free(str);
      Tcl_AppendResult(interp, "Out of Memory.", __LINE__, (char *) NULL);
      return TCL_ERROR;
  }

  if (!(my_argv=(char**)malloc((argc+1)*sizeof(char*)))) {
      free(delpro);
      free(Fbr);
      free(fgrad);
      free(abb);
      for (k = 0; k < len; ++k)
	free(abr[k]);
      free(abr);
      free(gFbb);

      free(str);
      uwerr_free_tcl_vector(tcl_vector);
      Tcl_AppendResult(interp, "Out of Memory.", __LINE__, (char *) NULL);
      return TCL_ERROR;
  }

  my_argv[0] = argv[0];
  my_argv[1] = tcl_vector;
  for (i = 1; i < argc; ++i)
    my_argv[i+1] = argv[i];


  /* first we calculate N_r\bar{a}_\alpha^r \forall r, alpha */
  
  sum = 0;
  for (k = 0; k < len; ++k) {
    for (i = 0; i < n_rep[k]; ++i) {
      for (a = 0; a < cols; ++a) {
	if (i > 0)
	  abr[k][a] += data[sum + i][a];
	else
	  abr[k][a] = data[sum][a];
      }
    }
    sum += n_rep[k];
  }

  /* now we calculate \bar{\bar{a}}_\alpha \forall \alpha */

  for (k = 0; k < len; ++k) {
    for (a = 0; a < cols; ++a) {
      if (k > 0)
	abb[a] += abr[k][a];
      else
	abb[a] = abr[k][a];
    }
  }
  for (a =0; a < cols; ++a)
    abb[a] /= rows;

  /* now we calculate \bar{a}_\alpha^r with \forall \alpha */
  for (k = 0; k < len; ++k)
    for (a = 0; a < cols; ++a)
      abr[k][a] /= n_rep[k];

  uwerr_write_tcl_vector(interp, abb, cols, tcl_vector);
  Tcl_ResetResult(interp);

  if (cmdInfo->proc(cmdInfo->clientData, interp, argc+1, my_argv) != TCL_OK)
    goto err_exit;

  Fbb = strtod(Tcl_GetStringResult(interp),0);
  for (k = 0; k < len; ++k) {
    uwerr_write_tcl_vector(interp, abr[k], cols, tcl_vector);
    Tcl_ResetResult(interp);

    if (cmdInfo->proc(cmdInfo->clientData, interp, argc+1, my_argv) != TCL_OK)
      goto err_exit;
    Fbr[k] = strtod(Tcl_GetStringResult(interp),0);
  }

  Fb  = UWerr_dsum_int(n_rep, Fbr, len);
  Fb /= rows;

  for (a = 0; a < cols; ++a) {
    std_a = 0;
    for (k = 0; k < rows; ++k)
      std_a += (data[k][a]-abb[a])*(data[k][a]-abb[a]);
    std_a = sqrt(std_a)/rows;

    
    /* calc the gradient of f using df/da ~ (f(a+h)-f(a-h))/2*h 
       where h is the standard deviation divided by the sqrt of the 
       number of samples (= rows).
       Remember: abb[a] is the average for column a of data */

    if (std_a == 0)
      fgrad[a] = 0;
    else {
      tmp = abb[a];
      abb[a] += std_a;

      uwerr_write_tcl_vector(interp, abb, cols, tcl_vector);
      Tcl_ResetResult(interp);
      if (cmdInfo->proc(cmdInfo->clientData, interp, argc+1, my_argv) != TCL_OK)
	goto err_exit;
      fgrad[a] = strtod(Tcl_GetStringResult(interp),0);

      abb[a] = tmp - std_a;

      uwerr_write_tcl_vector(interp, abb, cols, tcl_vector);
      Tcl_ResetResult(interp);
      if (cmdInfo->proc(cmdInfo->clientData, interp, argc+1, my_argv) != TCL_OK)
	goto err_exit;
      fgrad[a] -= strtod(Tcl_GetStringResult(interp),0);

      abb[a] = tmp;
      fgrad[a] /= 2*std_a;
    }
  }

  /* calc delpro = data*fgrad - abb.*fgrad and
     the mean of delpro.^2 = gFbb[0] */

  tmp = UWerr_dsum_double(abb, fgrad, cols);
  gFbb[0] = 0;
  for (i = 0; i < rows; ++i) {
    delpro[i] = 0;

    for (a = 0; a < cols; a++) {
      delpro[i] += data[i][a]*fgrad[a];
    }
    delpro[i] -= tmp;

    gFbb[0] += delpro[i]*delpro[i];
  }
  gFbb[0] /= rows;

  i = 0;
  while(i < W_max) {
    gFbb[i+1] = 0;
    sum = 0;
    for (k = 0; k < len; ++k) {
      gFbb[i+1] += UWerr_dsum_double(delpro + sum, delpro + sum + i + 1, n_rep[k]-i-1);
      sum += n_rep[k];
    }
    gFbb[i+1] /= rows-(i+1)*len;

    if (flag) {
      G_int += gFbb[i+1]/gFbb[0];
      if (G_int <= 0)
	tau = UW_EPS;
      else
	tau = s_tau/log((G_int+1)/G_int);
      if (exp(-(i+1)/tau)-tau/sqrt((i+1)*rows) < 0) {
	W_opt = i+1;
	W_max = (W_max < 2*W_opt) ? W_max : 2*W_opt;
	flag = 0;
      }
    }
    ++i;
  }
  --i;

  if (flag) {
    W_opt = W_max;
    sprintf(str, "%d", W_max);
    Tcl_AppendResult(interp, "Windowing condition failed up to W = ", str, ".\n", (char *)NULL);
  }
  ret.W = W_opt;

  CFbb_opt = (gFbb[0] + 2*UWerr_sum(gFbb+1, W_opt))/rows;
  for (k = 0; k < i; ++k)
    gFbb[k] += CFbb_opt;
  CFbb_opt = (gFbb[0] + 2*UWerr_sum(gFbb+1, W_opt));

  ret.dvalue = sqrt(CFbb_opt/rows); /* sigmaF */
  
  if (len >= 2) {
    bF = (Fb-Fbb)/(len-1);
    Fbb -= bF;
    if (fabs(bF) > ret.dvalue/4) {
      Tcl_PrintDouble(interp, bF/ret.dvalue, str);
      Tcl_AppendResult(interp, "A ", str, " sigma bias of the mean has been cancelled./n", (char *)NULL);
    }
    for (i = 0; i < len; ++i)
      Fbr[i] -= bF*rows/n_rep[i];
    Fb -= bF*len;
    
    ret.bias = bF/ret.dvalue;
  }

  ret.tau_int = 0;
  for (i = 0; i <= W_opt; ++i)
    ret.tau_int += gFbb[i];
      
  ret.tau_int /= gFbb[0];
  ret.tau_int -= .5;

  ret.value  = Fbb;
  ret.ddvalue = ret.dvalue*sqrt((W_opt + .5)/rows);
  ret.dtau_int = 2 * ret.tau_int * sqrt((W_opt + .5 - ret.tau_int)/rows);

  if (len > 1) {
    for (i = 0; i < len; ++i)
      Fbr[i] = (Fbr[i] - Fb)*(Fbr[i] - Fb)*n_rep[i];
    
    ret.Q_val = UWerr_sum(Fbr, len);
    ret.Q_val /= CFbb_opt;
    ret.Q_val = gammaq((len-1)/2., ret.Q_val/2.);
  }

  if (plot) {
    plotScriptf = fopen("uwerr_plot_script", "w");

    fprintf(plotScriptf, "set ylabel \"Gamma\"; set xlabel \"W\"; set label \"W_opt=%d\" at %d,0 center; plot f(x) = 0, f(x) notitle, 'uwerr_plot_data' using 1:2 title \"normalized autocorrelation\" with lines; show label; pause -1\n", W_opt, W_opt);
    fprintf(plotScriptf, "set ylabel \"tau_int\"; plot f(x) = %.3f, 'uwerr_plot_data' using 1:3 title \"tau_int with statistical errors\" with lines,", ret.tau_int);
    fprintf(plotScriptf, " 'uwerr_plot_data' using 1:3:4 notitle with errorbars, f(x) title \"estimate\"; pause -1\n");

    fclose(plotScriptf);

    plotDataf = fopen("uwerr_plot_data", "w");
    tmp = 0;
    for (i = 0; i < W_max; ++i) {
      tmp += gFbb[i];
      /* print values for x-Axis, Gamma/Gamma[0], tau_int, and its errors */
      fprintf(plotDataf, "%d %.3f %.3f %.3f\n", i, gFbb[i]/gFbb[0],
	      tmp/gFbb[0]-.5, 2*sqrt((i+tmp/gFbb[0])/rows));
    }
    fclose(plotDataf);

    puts("Press Return to continue ...");
    Tcl_Eval(interp, "[exec gnuplot uwerr_plot_script]");
  }

  Tcl_ResetResult(interp);
  Tcl_PrintDouble(interp, ret.value, str);
  Tcl_AppendResult(interp, str, " ", (char *)NULL);
  Tcl_PrintDouble(interp, ret.dvalue, str);
  Tcl_AppendResult(interp, str, " ", (char *)NULL);
  Tcl_PrintDouble(interp, ret.ddvalue, str);
  Tcl_AppendResult(interp, str, " ", (char *)NULL);
  Tcl_PrintDouble(interp, ret.tau_int, str);
  Tcl_AppendResult(interp, str, " ", (char *)NULL);
  Tcl_PrintDouble(interp, ret.dtau_int, str);
  Tcl_AppendResult(interp, str, (char *)NULL);
  if (len > 1) {
    Tcl_PrintDouble(interp, ret.Q_val, str);
    Tcl_AppendResult(interp, " ", str, (char *)NULL);
  }

 err_exit:
  free(abb);
  for (k = 0; k < len; ++k)
    free(abr[k]);
  free(abr);
  free(delpro);
  free(gFbb);
  free(Fbr);
  free(fgrad);
  free(str);
  free(my_argv);
  uwerr_free_tcl_vector(tcl_vector);

  return TCL_OK;
}
Esempio n. 8
0
void
main(int argc, char *argv[])
{
  int c, i;
  int statistics = 0;
  int draw = 0;
  char initialize = 'p';

  extern char *optarg;

#ifndef NOTIMES
  srand48((long)time(NULL));
#else
  srand48(0);
#endif //NOTIMES

  if (readgraph())
    exit(1);

  if (nvertices == 0) {
    fprintf(stderr, "Empty graph\n");
    exit(1);
  }

  if (nvertices < 200)
    iter[1] = 200;
  else
    iter[1] = nvertices;

  iter[0] = iter[1] / 20;
  iter[2] = iter[1] / 10;

  height = 0.65 * sqrt((double)nvertices);

  while ((c = getopt(argc, argv, "fg:i:n:osv:w:B:D:E:H:NOW:")) != EOF)
  {
    switch (c) {
    case 'f':
      flat = 1;
      break;
    case 'g':
      sscanf( optarg, "%d,%d,%d", &(gstep[0]), &(gstep[1]), &(gstep[2]) );
      draw = 1;
      break;
    case 'i':
      initialize = optarg[0];
      break;
      break;
    case 'n':
      sscanf( optarg, "%d,%d,%d", &(iter[0]), &(iter[1]), &(iter[2]) );
      break;
    case 'o':
      fprintf(stdout,"%d\n",getpid());  fflush(stdout);
      break;
    case 's':
      statistics = 1;
      break;
    case 'v':
      sscanf( optarg, "%d,%d,%d", &(vstep[0]), &(vstep[1]), &(vstep[2]) );
      break;
    case 'w':
      bestangle = atof( optarg ) / 180.0 * M_PI;
      break;
    case 'B':
      frames_begin = atoi( optarg );
      break;
    case 'D':
      maxdist = atof( optarg );
      break;
    case 'E':
      frames_end = atoi( optarg );
      break;
    case 'H':
      height = atof( optarg );
      break;
    case 'N':
      print_frame_count = 1;
      break;
    case 'O':
      count_only = print_frame_count = 1;
      break;
    case 'W':
      sleep_ms = atoi(optarg);
      break;
    case '?':
      fprintf(stderr, "%s: unknown option -%c\n", argv[0], c);
      exit(1);
    }
  }

  switch(initialize) {
  case 'r':
    random_positions();
    break;
  case 's':
    initial_positions_planar(1);
    break;
  case 'z':
    zero_out_positions();
    break;
  case 'p':
    initial_positions_planar(0);
    break;
  default:
    break;
  }

  for (i = 1; i <= nvertices; i++) {
    vertices[i].saved_pos.x = vertices[i].pos.x;
    vertices[i].saved_pos.y = vertices[i].pos.y;
    vertices[i].saved_pos.z = vertices[i].pos.z;
  }

  maxstep = iter[0] + iter[1] + iter[2];

#if USE_TCL
  if (draw > 0) {
    init_tk();
    draw_graph(0);
    sprintf(tcl_command_buffer, "stop_go");
    c = Tcl_Eval(interp, tcl_command_buffer);
    if (c != TCL_OK) {
      fprintf(stderr, "in Tcl_Eval: %s\n", interp->result);
      exit(c);
    }
  }
#endif /*USE_TCL*/

  if (position())
    exit(1);

  if (writegraph())
    exit(1);

  if (statistics)
    show_statistics();

#if USE_TCL
  if (draw > 0)
    exit_tk();
#endif /*USE_TCL*/
}
Esempio n. 9
0
int tcl::eval(char *cmd)
{
	return Tcl_Eval(tcl_int, cmd) == TCL_OK;
}
Esempio n. 10
0
void 
TkMacHandleMenuSelect(
    long mResult,
    int optionKeyPressed)
{
    short theItem = LoWord(mResult);
    short theMenu = HiWord(mResult);
    Str255 name;
    Tk_Window tkwin;
    Window window;
    TkDisplay *dispPtr;

    if (mResult == 0) {
    	TkMacHandleTearoffMenu();
	TkMacClearMenubarActive();
	return;
    }

    switch (theMenu) {
	
	case kAppleMenu:
	    switch (theItem) {
		case kAppleAboutItem:
		    {
			Tcl_CmdInfo dummy;
			
			if (optionKeyPressed || gInterp == NULL ||
			    Tcl_GetCommandInfo(gInterp,
				    "tkAboutDialog", &dummy) == 0) {
			    TkAboutDlg();
			} else {
			    Tcl_Eval(gInterp, "tkAboutDialog");
			}
			break;
		    }
		default:
		    GetMenuItemText(tkAppleMenu, theItem, name);
		    HiliteMenu(0);
		    OpenDeskAcc(name);
		    return;
	    }
	    break;
	case kFileMenu:
	    switch (theItem) {
		case kSourceItem:
		    /* TODO: source script */
		    SourceDialog();
		    break;
		case kCloseItem:
		    /* Send close event */
		    if (TkMacHaveAppearance() >= 0x110) {
		        window = TkMacGetXWindow(FrontNonFloatingWindow());
		    } else {
		        window = TkMacGetXWindow(FrontWindow());
		    }
		    dispPtr = TkGetDisplayList();
		    tkwin = Tk_IdToWindow(dispPtr->display, window);
		    TkGenWMDestroyEvent(tkwin);
		    break;
		case kQuitItem:
		    /* Exit */
		    if (optionKeyPressed || gInterp == NULL) {
			Tcl_Exit(0);
		    } else {
			Tcl_Eval(gInterp, "exit");
		    }
		    break;
	    }
	    break;
	case kEditMenu:
	    /*
	     * This implementation just send keysyms
	     * the Tk thinks are associated with function keys that
	     * do Cut, Copy & Paste on a Sun keyboard.
	     */
	    GenerateEditEvent(theItem);
	    break;
	default:
	    TkMacDispatchMenuEvent(theMenu, theItem);
	    TkMacClearMenubarActive();
	    break;
    }

    /*
     * Finally we unhighlight the menu.
     */
    HiliteMenu(0);
} /* TkMacHandleMenuSelect */
Esempio n. 11
0
int
  draw_graph(int step)
{
  int code;
  double display_width, display_height;
  double xscale, yscale;
  double xoff, yoff;

  struct vertex *v, *w;
  struct point t;
  int n, i, j;
  static int angle = 90;
  static int count = 0;
  int steps;
  double s, c;
  double xc, yc, zc;
  double d, dmax, avglen;
  double f1, f2;
  double xmin, xmax, ymin, ymax, zmin, zmax;
  double elevation;

  struct edge *edges;
  int e;

  edges = (struct edge *) malloc( sizeof(struct edge) * nedges );
  if (edges == NULL) {
    fprintf(stderr, "Not enough memory");
    return;
  }

  /* --- determine number of interpolation steps  --- */

  dmax = 0.0;
  avglen = 0.0;

  for (i = 1; i <= nvertices; i++) {
    v = &(vertices[i]);
    d = norm( difference( v->pos, v->saved_pos ) );
    if (d > dmax)
      dmax = d;
    for (j = 0; j < v->valency; j++) {
      if (v->adj[j] > i) {
	w = &(vertices[v->adj[j]]);
	avglen += norm( difference( v->saved_pos, w->saved_pos ) );
      }
    }
  }

  avglen /= nedges;
  steps = (int) ( dmax / maxdist ) + 1;


  /* --- interpolate and display --- */

  if (count_only)
    count += steps;
  else {
    for (n = 1; n <= steps; n++) {
      /* --- initialize Tk stuff --- */

      if (Tk_GetNumMainWindows() <= 0) {
	free(edges);
	return TCL_RETURN;
      }

      sprintf(tcl_command_buffer, "update; set step %d", step);
      code = Tcl_Eval(interp, tcl_command_buffer);
      if (code != TCL_OK) {
	fprintf(stderr, "in Tcl_Eval: %s\n", interp->result);
	free(edges);
	return code;
      }

      if (Tk_GetNumMainWindows() <= 0) {
	free(edges);
	return TCL_RETURN;
      }

      sprintf(tcl_command_buffer, "get_canvas_size");
      code = Tcl_Eval(interp, tcl_command_buffer);
      if (code != TCL_OK) {
	fprintf(stderr, "in Tcl_Eval: %s\n", interp->result);
	free(edges);
	return code;
      }
      sscanf(interp->result, "%lf %lf", &display_width, &display_height);

      xscale = (display_width  / 2.0 - 10.0) / height;
      yscale = (display_height / 2.0 - 10.0) / height;

      if (xscale <= yscale)
	yscale = xscale;
      else
	xscale = yscale;

      yscale *= -1;

      xoff = display_width / 2.0;
      yoff = display_height - 10.0;

      sprintf(tcl_command_buffer, "clear_canvas");
      code = Tcl_Eval(interp, tcl_command_buffer);
      if (code != TCL_OK) {
	fprintf(stderr, "in Tcl_Eval: %s\n", interp->result);
	free(edges);
	return code;
      }


      /* --- compute current transformation parameters --- */

      f2 = (double)n / (double)steps;
      f1 = 1.0 - f2;

      s = sin( angle * M_PI / 180.0);
      c = cos( angle * M_PI / 180.0);
      angle = ( angle - 1 ) % 360;

      /* --- compute center of gravity to rotate about --- */

      xc = yc = zc = 0.0;

      for (i = 1; i <= nvertices; i++) {
	v = &(vertices[i]);
	xc += f1 * v->saved_pos.x + f2 * v->pos.x;
	yc += f1 * v->saved_pos.y + f2 * v->pos.y;
	zc += f1 * v->saved_pos.z + f2 * v->pos.z;
      }
      xc /= nvertices;
      yc /= nvertices;
      zc /= nvertices;


      /* --- compute endpoints of all the edges --- */

      e = 0;
      for (i = 1; i <= nvertices; i++) {
	v = &(vertices[i]);

	for (j = 0; j < v->valency; j++) {
	  if (v->adj[j] > i) {
	    w = &(vertices[v->adj[j]]);

	    t.x = f1 * w->saved_pos.x + f2 * w->pos.x - xc;
	    t.y = f1 * w->saved_pos.y + f2 * w->pos.y - yc;
	    t.z = f1 * w->saved_pos.z + f2 * w->pos.z - zc;

	    edges[e].p.x = t.x * c - t.z * s;
	    edges[e].p.y = t.y;
	    edges[e].p.z = t.x * s + t.z * c;

	    t.x = f1 * v->saved_pos.x + f2 * v->pos.x - xc;
	    t.y = f1 * v->saved_pos.y + f2 * v->pos.y - yc;
	    t.z = f1 * v->saved_pos.z + f2 * v->pos.z - zc;

	    edges[e].q.x = t.x * c - t.z * s;
	    edges[e].q.y = t.y;
	    edges[e].q.z = t.x * s + t.z * c;

	    ++e;
	  }
	}
      }

      nedges = e;

      /* --- compute bounding box --- */

      for (e = 0; e < nedges; e++) {
	if (e == 0) {
	  xmin = xmax = edges[e].p.x;
	  ymin = ymax = edges[e].p.y;
	  zmin = zmax = edges[e].p.z;
	}

	if (edges[e].p.x < xmin) xmin = edges[e].p.x;
	if (edges[e].p.x > xmax) xmax = edges[e].p.x;
	if (edges[e].p.y < ymin) ymin = edges[e].p.y;
	if (edges[e].p.y > ymax) ymax = edges[e].p.y;
	if (edges[e].p.z < zmin) zmin = edges[e].p.z;
	if (edges[e].p.z > zmax) zmax = edges[e].p.z;

	if (edges[e].q.x < xmin) xmin = edges[e].q.x;
	if (edges[e].q.x > xmax) xmax = edges[e].q.x;
	if (edges[e].q.y < ymin) ymin = edges[e].q.y;
	if (edges[e].q.y > ymax) ymax = edges[e].q.y;
	if (edges[e].q.z < zmin) zmin = edges[e].q.z;
	if (edges[e].q.z > zmax) zmax = edges[e].q.z;
      }


      /* --- compute elevation --- */

      if ( - ymin > 0.9 * height)
	elevation = - ymin + 0.1 * height;
      else
	elevation = height;

      for (e = 0; e < nedges; e++) {
	edges[e].p.y += elevation;
	edges[e].q.y += elevation;
      }

      /* --- now do the drawing --- */

      qsort((void *)edges, nedges, sizeof(struct edge), cmp_edges);

      for (e = 0; e < nedges; e++) {
	edges[e].shade = 
	  (int) (0.5 + 14.0 * ((zmax - (edges[e].p.z + edges[e].q.z) / 2.0)
			       / (zmax - zmin)));

	sprintf(tcl_command_buffer,
		"add_closer_line %lf %lf %lf %lf #%x%xf",
		edges[e].p.x * xscale + xoff,
		edges[e].p.y * yscale + yoff,
		edges[e].q.x * xscale + xoff,
		edges[e].q.y * yscale + yoff,
		edges[e].shade, edges[e].shade
		);
	code = Tcl_Eval(interp, tcl_command_buffer);
	if (code != TCL_OK) {
	  fprintf(stderr, "in Tcl_VarEval: %s\n", interp->result);
	  free(edges);
	  return code;
	}
      }

      /* --- update screen and pause if requested --- */

      sprintf(tcl_command_buffer, "update idletasks");
      code = Tcl_Eval(interp, tcl_command_buffer);
      if (code != TCL_OK) {
	fprintf(stderr, "in Tcl_Eval: %s\n", interp->result);
	free(edges);
	return code;
      }

      Tcl_Sleep(sleep_ms);
    }
  }

  for (i = 1; i <= nvertices; i++) {
    v = &vertices[i];
    v->saved_pos.x = v->pos.x;
    v->saved_pos.y = v->pos.y;
    v->saved_pos.z = v->pos.z;
  }

  free(edges);
  return count;
}
Esempio n. 12
0
int
Iaxc_Init (Tcl_Interp *interp)
{
	iaxcCmd *cmdPtr;
	Tcl_Obj *codec_val, *codec_name, *evt_val, *evt_name;

	if (Tcl_InitStubs(interp, "8.3", 0) == NULL)
		return TCL_ERROR;

	MUTEXINIT(&head_mutex);
	evt_list = Tcl_NewListObj(0, NULL);

	/* iaxc package commands */
	
	for (cmdPtr = commands; cmdPtr->name != NULL; cmdPtr++) {

		Tcl_CreateObjCommand(interp, cmdPtr->name, cmdPtr->objProc, (ClientData) "::",(Tcl_CmdDeleteProc *)NULL);
		Tcl_CreateObjCommand(interp, cmdPtr->name2, cmdPtr->objProc, (ClientData) "::iaxc::",(Tcl_CmdDeleteProc *)NULL);
	}
	
	
	if (Tcl_Eval(interp, "namespace eval ::iaxc namespace export *") == TCL_ERROR)
		return TCL_ERROR;

	/*
	 * set available codecs on ::iaxc namespace
	 */

	codec_val = Tcl_NewIntObj(1 << 1);
	codec_name = Tcl_NewStringObj("::iaxc::IAXC_FORMAT_GSM", -1);
	Tcl_ObjSetVar2(interp, codec_name, NULL, codec_val, 0);
	
	codec_val = Tcl_NewIntObj(1 << 2);
	codec_name = Tcl_NewStringObj("::iaxc::IAXC_FORMAT_ULAW", -1);
	Tcl_ObjSetVar2(interp, codec_name, NULL, codec_val, 0);
	
	codec_val = Tcl_NewIntObj(1 << 3);
	codec_name = Tcl_NewStringObj("::iaxc::IAXC_FORMAT_ALAW", -1);
	Tcl_ObjSetVar2(interp, codec_name, NULL, codec_val, 0);
	
	codec_val = Tcl_NewIntObj(1 << 9);
	codec_name = Tcl_NewStringObj("::iaxc::IAXC_FORMAT_SPEEX", -1);
	Tcl_ObjSetVar2(interp, codec_name, NULL, codec_val, 0);
	
	codec_val = Tcl_NewIntObj(1 << 10);
	codec_name = Tcl_NewStringObj("::iaxc::IAXC_FORMAT_ILBC", -1);
	Tcl_ObjSetVar2(interp, codec_name, NULL, codec_val, 0);

	/*
	 * set available event types
	 */
	
	evt_val = Tcl_NewStringObj("text", -1);
	evt_name = Tcl_NewStringObj("::iaxc::IAXC_EVENT_TEXT", -1);
	Tcl_ObjSetVar2(interp, evt_name, NULL, evt_val, 0);
	
	evt_val = Tcl_NewStringObj("levels", -1);
	evt_name = Tcl_NewStringObj("::iaxc::IAXC_EVENT_LEVELS", -1);
	Tcl_ObjSetVar2(interp, evt_name, NULL, evt_val, 0);
	
	evt_val = Tcl_NewStringObj("state", -1);
	evt_name = Tcl_NewStringObj("::iaxc::IAXC_EVENT_STATE", -1);
	Tcl_ObjSetVar2(interp, evt_name, NULL, evt_val, 0);
	
	evt_val = Tcl_NewStringObj("netstat", -1);
	evt_name = Tcl_NewStringObj("::iaxc::IAXC_EVENT_NETSTAT", -1);
	Tcl_ObjSetVar2(interp, evt_name, NULL, evt_val, 0);
	
	evt_val = Tcl_NewStringObj("url", -1);
	evt_name = Tcl_NewStringObj("::iaxc::IAXC_EVENT_URL", -1);
	Tcl_ObjSetVar2(interp, evt_name, NULL, evt_val, 0);
	
	evt_val = Tcl_NewStringObj("video", -1);
	evt_name = Tcl_NewStringObj("::iaxc::IAXC_EVENT_VIDEO", -1);
	Tcl_ObjSetVar2(interp, evt_name, NULL, evt_val, 0);
	
	evt_val = Tcl_NewStringObj("registration", -1);
	evt_name = Tcl_NewStringObj("::iaxc::IAXC_EVENT_REGISTRATION", -1);
	Tcl_ObjSetVar2(interp, evt_name, NULL, evt_val, 0);

	/*
	 * available states for a call (contained in an state event)
	 */
	
	evt_val = Tcl_NewIntObj(IAXC_CALL_STATE_FREE);
	evt_name = Tcl_NewStringObj("::iaxc::IAXC_CALL_STATE_FREE", -1);
	Tcl_ObjSetVar2(interp, evt_name, NULL, evt_val, 0);

	evt_val = Tcl_NewIntObj(IAXC_CALL_STATE_ACTIVE);
	evt_name = Tcl_NewStringObj("::iaxc::IAXC_CALL_STATE_ACTIVE", -1);
	Tcl_ObjSetVar2(interp, evt_name, NULL, evt_val, 0);

	evt_val = Tcl_NewIntObj(IAXC_CALL_STATE_OUTGOING);
	evt_name = Tcl_NewStringObj("::iaxc::IAXC_CALL_STATE_OUTGOING", -1);
	Tcl_ObjSetVar2(interp, evt_name, NULL, evt_val, 0);

	evt_val = Tcl_NewIntObj(IAXC_CALL_STATE_RINGING);
	evt_name = Tcl_NewStringObj("::iaxc::IAXC_CALL_STATE_RINGING", -1);
	Tcl_ObjSetVar2(interp, evt_name, NULL, evt_val, 0);

	evt_val = Tcl_NewIntObj(IAXC_CALL_STATE_COMPLETE);
	evt_name = Tcl_NewStringObj("::iaxc::IAXC_CALL_STATE_COMPLETE", -1);
	Tcl_ObjSetVar2(interp, evt_name, NULL, evt_val, 0);

	evt_val = Tcl_NewIntObj(IAXC_CALL_STATE_SELECTED);
	evt_name = Tcl_NewStringObj("::iaxc::IAXC_CALL_STATE_SELECTED", -1);
	Tcl_ObjSetVar2(interp, evt_name, NULL, evt_val, 0);

	evt_val = Tcl_NewIntObj(IAXC_CALL_STATE_BUSY);
	evt_name = Tcl_NewStringObj("::iaxc::IAXC_CALL_STATE_BUSY", -1);
	Tcl_ObjSetVar2(interp, evt_name, NULL, evt_val, 0);

	evt_val = Tcl_NewIntObj(IAXC_CALL_STATE_TRANSFER);
	evt_name = Tcl_NewStringObj("::iaxc::IAXC_CALL_STATE_TRANSFER", -1);
	Tcl_ObjSetVar2(interp, evt_name, NULL, evt_val, 0);

	Tcl_PkgProvide(interp, "iaxc", "0.1");
	return TCL_OK;
}
Esempio n. 13
0
/* Implement ide_winprint print_text.  */
static int
winprint_print_command (ClientData cd, Tcl_Interp *interp, int argc,
			     CONST84 char **argv)
{
  struct winprint_data *wd = (struct winprint_data *) cd;
  const char *queryproc;
  const char *textproc;
  struct print_text_options pto;
  PRINTDLG pd;
  int cancelled;
  int top, bottom, left;
  TEXTMETRIC tm;
  POINT pt;
  int lineheight;
  int pageno;
  int error=0, done, needquery;
  struct {
	 short len; /* Defined to be 16 bits.... */
	 char buffer[PRINT_BUFSIZE+1];
  } indata;

  queryproc = argv[2];
  textproc = argv[3];

  if (winprint_print_text_options (wd, interp, argc, argv, &pto) != TCL_OK)
    return TCL_ERROR;

  if (winprint_print_text_dialog (wd, interp, &pto, &pd, &cancelled) != TCL_OK)
    return TCL_ERROR;
  if (cancelled)
    return TCL_OK;

  if (pto.postscript)
  {
	int eps_printing = 33;
	int result;
	short bresult = 1; /* EPS printing download suppressed */
	result = Escape (pd.hDC, eps_printing, sizeof (BOOL), (LPCSTR)&bresult, NULL);
	if ( result < 0 )
	{
		/* The EPSPRINTING escape failed! */
		Tcl_AppendElement(interp,
                   "ide_winprint: EPSPRINTING escape implemented but failed");
		DeleteDC (pd.hDC);
		return TCL_ERROR;
	  }
  }
  else
  {
	winprint_get_margins(wd, &pd, &top, &left, &bottom);
  }

  if (winprint_start (wd, interp, &pd, &pto, &cancelled) != TCL_OK)
    {
      DeleteDC (pd.hDC);
      return TCL_ERROR;
    }
  if (cancelled)
    {
      DeleteDC (pd.hDC);
      return TCL_OK;
    }

  /* init and start init-procedure if available */
  if (pto.initproc != NULL)
  {
    	Tcl_DString initStr;
	char buf[64];
	Tcl_DStringInit (&initStr);
	Tcl_DStringAppend (&initStr, pto.initproc, -1);

	/* Here we must pass the customer selection from the PrintDialog
	 * as parameters for the init command, */
	/* From page */
	Tcl_DStringAppendElement (&initStr, "-frompage");
	sprintf (buf, "%i", pd.nFromPage);
	Tcl_DStringAppendElement (&initStr, buf);
	/* To Page */
	Tcl_DStringAppendElement (&initStr, "-topage");
	sprintf (buf, "%i", pd.nToPage);
	Tcl_DStringAppendElement (&initStr, buf);
	/* # Copies */
	Tcl_DStringAppendElement (&initStr, "-copies");
	sprintf (buf, "%i", pd.nCopies);
	Tcl_DStringAppendElement (&initStr, buf);
	/* Print Selection? */
	Tcl_DStringAppendElement (&initStr, "-selection");
	Tcl_DStringAppendElement (&initStr, (pd.Flags&PD_SELECTION) ? "1" : "0");

	/* Execute tcl/command */
	if (Tcl_Eval (interp, Tcl_DStringValue(&initStr)) != TCL_OK)
	{
	      Tcl_DStringFree (&initStr);
	      return TCL_ERROR;
	}
	Tcl_DStringFree (&initStr);
  }

  if (pto.postscript)
  {
    Tcl_DString pageStr;
    int status, retval, len, i;
    char *l, msgbuf[128];
    enum winprint_query q = 0;

    /* Note: NT 4.0 seems to leave the default CTM quite tiny! */
    strcpy (indata.buffer, "\r\nsave\r\ninitmatrix\r\n");
    indata.len = strlen(indata.buffer);
    Escape(pd.hDC, PASSTHROUGH, 0, (LPCSTR)&indata, NULL);

    /* Init command for page-procedure */
    if (pto.pageproc != NULL)
      {
	Tcl_DStringInit (&pageStr);
	Tcl_DStringAppend (&pageStr, pto.pageproc, -1);
	Tcl_DStringAppendElement (&pageStr, "-1");
      }

    /* Start printing */
    while (1)
      {
    	/* Run page-procedure to update the display */
	status = winprint_print_text_invoke (interp, Tcl_DStringValue(&pageStr), "page", &q);
	if (status != TCL_OK || q == Q_DONE)
	  {
	    error = 1;
	    break;
	  }

	/* query next characters to send to printer */
	if (winprint_print_text_invoke (interp, queryproc, "query", &q) != TCL_OK)
	  {
	    error = 1;
	    break;
	  }
	if (q != Q_CONTINUE)
	  {
	    done = 1;
	    break;
	  }
	if (Tcl_Eval (interp, textproc) == TCL_ERROR)
	  {
	    error = 1;
	    break;
	  }
	l = Tcl_GetStringFromObj (Tcl_GetObjResult (interp), &len);
	for (i=0; i<len; i+=PRINT_BUFSIZE)
	  {
	    int lpos = min (PRINT_BUFSIZE, len-i);
	    strncpy (indata.buffer, l+i, lpos);
	    indata.buffer[lpos] = 0;
	    indata.len = lpos;

	    retval = Escape (pd.hDC, PASSTHROUGH, 0, (LPCSTR)&indata, NULL);
	    if (retval < 0)
	      {
		Tcl_AppendElement(interp, "ide_winprint: PASSTHROUGH Escape failed");
		error = 1;
		break;
	      }
	    else if (retval != indata.len)
	      {
		sprintf(msgbuf, "ide_winprint: Short write (%d vs. %d)", retval, indata.len);
		Tcl_AppendElement(interp, msgbuf);
		error = 1;
		break;
	      }
	  }
      }

    strcpy (indata.buffer, "\r\nrestore\r\n");
    indata.len = strlen(indata.buffer);
    Escape(pd.hDC, PASSTHROUGH, 0, (LPCSTR)&indata, NULL);
  }
  else
    {
      GetTextMetrics (pd.hDC, &tm);
      pt.x = 0;
      pt.y = tm.tmHeight + tm.tmExternalLeading;
      LPtoDP (pd.hDC, &pt, 1);
      lineheight = pt.y;

      pageno = 1;

      /* The main print loop.  */
      done = 0;
      error = 0;
      needquery = 1;
      while (1)
	{
	  int y;

	  if (wd->aborted)
	    break;

	  /* Start a new page.  */
	  if (pto.pageproc != NULL)
	    {
	      Tcl_DString ds;
	      char buf[20];
	      enum winprint_query q;
	      int status;

	      Tcl_DStringInit (&ds);
	      Tcl_DStringAppend (&ds, pto.pageproc, -1);
	      sprintf (buf, "%d", pageno);
	      Tcl_DStringAppendElement (&ds, buf);

	      status = winprint_print_text_invoke (interp, Tcl_DStringValue (&ds),
						   "page", &q);

	      Tcl_DStringFree (&ds);

	      if (status != TCL_OK)
		{
		  error = 1;
		  break;
		}

	      if (q == Q_DONE)
		{
		  done = 1;
		  break;
		}
	    }

	  if (needquery)
	    {
	      enum winprint_query q;

	      if (winprint_print_text_invoke (interp, queryproc, "query", &q)
		  != TCL_OK)
		{
		  error = 1;
		  break;
		}

	      if (q == Q_DONE)
		{
		  done = 1;
		  break;
		}

	      /* Ignore Q_NEWPAGE, since we're about to start a new page
		 anyhow.  */

	      needquery = 0;
	    }

	  if (StartPage (pd.hDC) <= 0)
	    {
	      windows_error (interp, "StartPage");
	      error = 1;
	      break;
	    }

	  y = top;

	  /* Print a page.  */

	  while (1)
	    {
	      char *l;
	      int len;
	      enum winprint_query q;

	      if (Tcl_Eval (interp, textproc) == TCL_ERROR)
		{
		  error = 1;
		  break;
		}

	      l = Tcl_GetStringFromObj (Tcl_GetObjResult (interp), &len);

	      TextOutA (pd.hDC, left, y, l, len);
	      y += lineheight;

	      if (y >= bottom)
		{
		  needquery = 1;
		  break;
		}

	      if (winprint_print_text_invoke (interp, queryproc, "query", &q)
		  != TCL_OK)
		{
		  error = 1;
		  break;
		}

	      if (q == Q_DONE)
		{
		  done = 1;
		  break;
		}
	      else if (q == Q_NEWPAGE)
		break;
	    }

	  if (error)
	    break;

	  if (EndPage (pd.hDC) <= 0)
	    {
	      /* It's OK for EndPage to return an error if the print job
		 was cancelled.  */
	      if (! wd->aborted)
		{
		  windows_error (interp, "EndPage");
		  error = 1;
		}
	      break;
	    }

	  if (done)
	    break;

	  ++pageno;
	}
    }

  if (winprint_finish (wd, interp, &pd, error) != TCL_OK)
    error = 1;

  if (error)
    return TCL_ERROR;

  Tcl_ResetResult (interp);
  return TCL_OK;
}
Esempio n. 14
0
int TclTextInterp::evalString(const char *s) {
#if defined(VMD_NANOHUB)
  if (Tcl_Eval(interp, s) != TCL_OK) {
#else
  if (Tcl_RecordAndEval(interp, s, 0) != TCL_OK) {
#endif
    // Don't print error message if there's nothing to show.
    if (strlen(Tcl_GetStringResult(interp))) 
      msgErr << Tcl_GetStringResult(interp) << sendmsg;
    return FALSE;
  }
  return TRUE;
}

void TclTextInterp::setString(const char *name, const char *val) {
  if (interp)
    Tcl_SetVar(interp, name, val, 
      TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG);
}

void TclTextInterp::setMap(const char *name, const char *key, 
                           const char *val) { 
  if (interp)
    Tcl_SetVar2(interp, name, key, val, 
      TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG);
    
}

// There's a fair amount of code duplication between doEvent and evalFile,
// maybe these could be combined somehow, say by having TclTextInterp keep 
// track of its Tcl_Channel objects.
// 
// Side note: Reading line-by-line gives different Tcl semantics than 
// just calling Tcl_EvalFile. Shell commands (e.g., stty) are properly
// parsed when read line-by-line and passed to Tcl_RecordAndEval, but are
// unrecognized when contained in a file read by Tcl_EvalFile.  I would 
// consider this a bug.  

int TclTextInterp::evalFile(const char *fname) {
  Tcl_Channel inchannel = Tcl_OpenFileChannel(interp, fname, "r", 0644);
  Tcl_Channel outchannel = Tcl_GetStdChannel(TCL_STDOUT);
  if (inchannel == NULL) {
    msgErr << "Error opening file " << fname << sendmsg;
    msgErr << Tcl_GetStringResult(interp) << sendmsg;
    return 1;
  }

  Tcl_Obj *cmdPtr = Tcl_NewObj();
  Tcl_IncrRefCount(cmdPtr);
  int length = 0;
  while ((length = Tcl_GetsObj(inchannel, cmdPtr)) >= 0) {
    Tcl_AppendToObj(cmdPtr, "\n", 1);
    char *stringrep = Tcl_GetStringFromObj(cmdPtr, NULL);
    if (!Tcl_CommandComplete(stringrep)) {
      continue;
    }

    // check if "exit" was called
    if (app->exitFlag) break;

#if defined(VMD_NANOHUB)
    Tcl_EvalObjEx(interp, cmdPtr, 0);
#else
    Tcl_RecordAndEvalObj(interp, cmdPtr, 0);
#endif

#if TCL_MINOR_VERSION >= 4
    Tcl_DecrRefCount(cmdPtr);
    cmdPtr = Tcl_NewObj();
    Tcl_IncrRefCount(cmdPtr);
#else
    // XXX this crashes Tcl 8.5.[46] with an internal panic
    Tcl_SetObjLength(cmdPtr, 0);
#endif

    // XXX this makes sure the display is updated 
    // after each line read from the file or pipe
    // So, this is also where we'd optimise reading multiple
    // lines at once
    //
    // In VR modes (CAVE, FreeVR, VR Juggler) the draw method will 
    // not be called from app->display_update(), so multiple lines
    // of input could be combined in one frame, if possible
    app->display_update();

    Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
    char *bytes = Tcl_GetStringFromObj(resultPtr, &length);
#if defined(VMDTKCON)
    if (length > 0) {
      vmdcon_append(VMDCON_ALWAYS, bytes,length);
      vmdcon_append(VMDCON_ALWAYS, "\n", 1);
    }
    vmdcon_purge();
#else
    if (length > 0) {
#if TCL_MINOR_VERSION >= 4
      Tcl_WriteChars(outchannel, bytes, length);
      Tcl_WriteChars(outchannel, "\n", 1);
#else
      Tcl_Write(outchannel, bytes, length);
      Tcl_Write(outchannel, "\n", 1);
#endif
    }
    Tcl_Flush(outchannel);
#endif
  }
  Tcl_Close(interp, inchannel);
  Tcl_DecrRefCount(cmdPtr);
  return 0;
}
Esempio n. 15
0
void
update_contig_order(Tcl_Interp *interp,
		    GapIO *io,
		    int cs_id,
		    int *contig_array,
		    int num_contigs,
		    int cx)
{
    GCardinal *order = ArrayBase(GCardinal, io->contig_order);
    obj_cs *cs;
    int i, j;
    double wx, wy;
    int left_position;
    char cmd[1024];
    int orig_pos = 0;
    reg_buffer_start rs;
    reg_buffer_end re;
    reg_order ro;

    cs = result_data(io, cs_id, 0);

    CanvasToWorld(cs->canvas, cx, 0, &wx, &wy);

    /*
     * returns the nth contig to the left of the wx, NOT the contig number.
     * If this is to the left of the first contig, returns 0.
     */
    left_position = find_left_position(io, order, wx);

    for (i = 0; i < NumContigs(io); i++) {
	if (order[i] == contig_array[0]) {
	    orig_pos = i+1;
	    break;
	}
    }

    /* convert index on order to index on contig num */
    for (i = 0; i < num_contigs; i++) {

	for (j = 0; j < NumContigs(io); j++) {
	    if (order[j] == contig_array[i])
		break;
	}
	ReOrder(io, order, j, left_position);

	if (j > left_position) {
	    left_position++;
	    orig_pos++;
	}
    }

    ro.job = REG_ORDER;
    ro.pos = left_position;

#ifdef HACK
    /* HACK is there a better way of representing this - only need to
     * replot once
     */
    contig_notify(io, 1, (reg_data *)&ro);
#endif

    /* Notify of the start of the flurry of updates */
    rs.job = REG_BUFFER_START;
    for (i = 0; i < num_contigs; i++) {
	contig_notify(io, contig_array[i], (reg_data *)&rs);
    }

    ro.job = REG_ORDER;
    ro.pos = left_position;

    for (i = 0; i< num_contigs; i++)
	contig_notify(io, contig_array[i], (reg_data *)&ro);

    /* Notify the end of our updates */
    re.job = REG_BUFFER_END;
    for (i = 0; i < num_contigs; i++) {
	contig_notify(io, contig_array[i], (reg_data *)&re);
    }

    /* draw larger separator tick to show where contig was moved from */
    sprintf(cmd, "HighlightSeparator %s %d", cs->hori, orig_pos);
    Tcl_Eval(interp, cmd);
}
Esempio n. 16
0
int vrmldetections_c(ClientData clientData, Tcl_Interp* interp, int argc, const char** argv)
{
	int    i, anz1, j, dumy;
	FILE   *fp1, *fp2;
	char   val[256];
	vector *line1;
	double color, ymin=0, ymax=0, cubes;

	/* open file for line elements */
	fp2 = fopen ("detections.wrl", "w");

	fprintf(fp2, "#VRML V1.0 ascii\n\n");
	/* create header and coordsys for vrml-file */
  
	/* create boundaries from object volume */
	volumedimension(&X_lay[1], &X_lay[0], &ymax, &ymin, &Zmax_lay[1], &Zmin_lay[0]);
	cubes=(Zmax_lay[1]-Zmin_lay[0])/500;
  
	/* create viewpoint */
	fprintf(fp2, "  PerspectiveCamera {\n");
	fprintf(fp2, "   position   %7.3f %7.3f %7.3f\n",
		(X_lay[0]+X_lay[1])/2,(ymax+ymin)/2, Zmax_lay[1]);
	fprintf(fp2, "   orientation   1 0 0 0\n");
	fprintf(fp2, "   focalDistance 5\n");
	fprintf(fp2, "   heightAngle   0.785398 }\n\n\n");
  
	/* create cameras */
	/*
	fprintf(fp2, "#create cameras\n\n");
	for (i=0; i<n_img; i++)
	{
		fprintf(fp2, "  DEF group0 Separator { Label { label \"camera %d\" }\n", i+1);
		fprintf(fp2, "   Transform {\n");
		fprintf(fp2, "    translation %7.3f %7.3f %7.3f\n", Ex[i].x0, Ex[i].y0, Ex[i].z0);      
		fprintf(fp2, "    rotation 0 0 1 3.1416 }\n");
		fprintf(fp2, "   MatrixTransform { matrix\n");
		for (k=0; k<3; k++) 
			{ fprintf(fp2, "    %7.3f %7.3f %7.3f 0\n", Ex[i].dm[k][0], Ex[i].dm[k][1], Ex[i].dm[k][2]); }
		fprintf(fp2, "       0 0 0 1 }\n");
		fprintf(fp2, "   Material {\n");
		fprintf(fp2, "    ambientColor 0.25 0.25 0.25\n");
		fprintf(fp2, "    diffuseColor 1.00 0.%d 0.00 }\n", 2*(i+1));
		fprintf(fp2, "   Cube { width %4.2f height %4.2f depth 2 } }\n\n", imx*pix_x, imy*pix_y);
	}
	*/
	/* create coordinate axis */  
	/*
	fprintf(fp2, "#create coordinate axis\n\n");

	fprintf(fp2, "  DEF group0 Separator { Label { label \"x-axis\" }\n");
	fprintf(fp2, "   Material {\n");
	fprintf(fp2, "    ambientColor 0.25 0.25 0.25\n");
	fprintf(fp2, "    diffuseColor 1.00 0.00 0.00 }\n");
	fprintf(fp2, "   Separator {\n");
	fprintf(fp2, "   Coordinate3 { point [\n");
	fprintf(fp2, "    %5.1f 0.000 0.000,\n",X_lay[1]);
	fprintf(fp2, "    0.000 0.000 0.000, ] }\n");
	fprintf(fp2, "   IndexedLineSet { coordIndex  [ 0, 1, -1 ] } } }\n\n");
  
	fprintf(fp2, "  DEF group0 Separator { Label { label \"y-axis\" }\n");
	fprintf(fp2, "   Material {\n");
	fprintf(fp2, "    ambientColor 0.25 0.25 0.25\n");
	fprintf(fp2, "    diffuseColor 0.00 1.00 0.00 }\n");
	fprintf(fp2, "   Separator {\n");
	fprintf(fp2, "   Coordinate3 { point [\n");
	fprintf(fp2, "    0.000 %5.1f 0.000,\n", ymax);
	fprintf(fp2, "    0.000   0.000 0.000, ] }\n");
	fprintf(fp2, "   IndexedLineSet { coordIndex [ 0, 1, -1 ] } } }\n\n");

	fprintf(fp2, "  DEF group0 Separator { Label { label \"z-axis\" }\n");
	fprintf(fp2, "   Material {\n");
	fprintf(fp2, "    ambientColor 0.25 0.25 0.25\n");
	fprintf(fp2, "    diffuseColor 0.00 0.00 1.00 }\n");
	fprintf(fp2, "   Separator {\n");
	fprintf(fp2, "   Coordinate3 { point  [\n");
	fprintf(fp2, "    0.000 0.000 %5.1f,\n",-Zmin_lay[0]);
	fprintf(fp2, "    0.000 0.000   0.000, ] }\n");
	fprintf(fp2, "   IndexedLineSet { coordIndex [ 0, 1, -1 ] } } }\n\n");
	*/

	fprintf(fp2, "  DEF group0 Separator { Label { label \"object volume\" }\n");
	fprintf(fp2, "   Material {\n");
	fprintf(fp2, "    ambientColor 0.25 0.25 0.25\n");
	fprintf(fp2, "    diffuseColor 0.00 0.00 0.00 }\n");
	fprintf(fp2, "   Separator {\n");
	fprintf(fp2, "   Coordinate3 { point  [\n");
	fprintf(fp2, "    %7.3f %7.3f %7.3f,\n", X_lay[0],ymin, Zmin_lay[0]);
	fprintf(fp2, "    %7.3f %7.3f %7.3f,\n", X_lay[0], ymax, Zmin_lay[0]);
	fprintf(fp2, "    %7.3f %7.3f %7.3f,\n", X_lay[1], ymax, Zmin_lay[0]);
	fprintf(fp2, "    %7.3f %7.3f %7.3f,\n", X_lay[1], ymin,Zmin_lay[0]);
	fprintf(fp2, "    %7.3f %7.3f %7.3f,\n", X_lay[0], ymin, Zmax_lay[1]);
	fprintf(fp2, "    %7.3f %7.3f %7.3f,\n", X_lay[0], ymax, Zmax_lay[1]);
	fprintf(fp2, "    %7.3f %7.3f %7.3f,\n", X_lay[1], ymax,Zmax_lay[1]);
	fprintf(fp2, "    %7.3f %7.3f %7.3f, ] }\n", X_lay[1], ymin, Zmax_lay[1]);
	fprintf(fp2, "   IndexedLineSet { coordIndex [ \n");
	fprintf(fp2, "    0, 1, 2, 3, 0, -1,\n");
	fprintf(fp2, "    0, 4, -1,\n");
	fprintf(fp2, "    1, 5, -1,\n");
	fprintf(fp2, "    2, 6, -1,\n");
	fprintf(fp2, "    3, 7, -1,\n");
	fprintf(fp2, "    4, 5, 6, 7, 4, -1 ] } } }\n\n\n");
	fprintf(fp2, "# start trajectories\n\n");

	line1 = NULL;	// added, ad holten 2012

	/* read trackfile from ptv and create vectorfield */
	for (i=seq_first; i<=seq_last ;i++)
	{
		// replaced next lines. ad holten 12-2012
		//	if      (i < 10)  sprintf (val, "res/rt_is.00%1d", i);
		//	else if (i < 100) sprintf (val, "res/rt_is.0%2d",  i);
		//	else              sprintf (val, "res/rt_is.%3d",  i);
		sprintf (val, "res/rt_is.%03d", i);
		printf("Create VRML, read file: %s\n", val);         
		
		fp1 = fopen_rp (val);	// replaced fopen(), ad holten 12-2-2012
		if (!fp1) break;

		color = ((double)(i-seq_first))/((double)(seq_last+1-seq_first));
      
		fscanf (fp1,"%d\n", &anz1);
		line1 = (vector *) calloc (anz1, sizeof (vector));
		for (j=0;j<anz1;j++) {
			fscanf (fp1, "%d %lf %lf %lf %d %d %d %d\n",
				&line1[j].p, &line1[j].x1, &line1[j].y1,
				&line1[j].z1, &dumy, &dumy, &line1[j].type, &dumy);
		}

		fclose (fp1);

	fprintf(fp2, "  DEF group0 Separator { Label { label  \"time step %d\" }\n", i);
	fprintf(fp2, "   Material {\n");
	fprintf(fp2, "    ambientColor 0.25 0.25 0.25\n");
	fprintf(fp2, "    diffuseColor 1 %.4f 0 }\n\n", color);

		for(j=0;j<anz1;j++) {
			fprintf(fp2, "    Separator {\n");
			fprintf(fp2, "     Transform {translation %7.3f %7.3f %7.3f}\n",
				line1[j].x1, line1[j].y1, line1[j].z1);
			fprintf(fp2, "     Cube { width %3.2f height %3.2f depth %3.2f } }\n\n",
				cubes, cubes, cubes );
		}
		fprintf(fp2, "   }\n\n");
		fprintf(fp2, "# end of time step %d\n\n", i);   
		strcpy(val, "");
		free(line1);
		line1 = NULL;
	}  /* end of sequence loop */
	
	if (line1) free(line1);
	fprintf(fp2, "# detections finished\n");

	fclose(fp2); 
	Tcl_Eval(interp, ".text delete 2");
	Tcl_Eval(interp, ".text insert 2 \"Detections written to VRML-File: detections.wrl\"");
	Tcl_Eval(interp, "update idletasks");

	sprintf(val, "...done");
	Tcl_SetVar(interp, "tbuf", val, TCL_GLOBAL_ONLY);
	Tcl_Eval(interp, ".text delete 3");
	Tcl_Eval(interp, ".text insert 3 $tbuf");

	return TCL_OK;
}
Esempio n. 17
0
/*
 * plots the results of a search on the plot window of the contig selector
 */
void
PlotRepeats(GapIO *io,
	    mobj_repeat *repeat) {
    int i;
    char cmd[1024];
    int pos1, pos2;
    int x1, y1, x2, y2;
    /* int max_x = 0; */
    int sense1 = 1;
    int sense2 = 1;
    int inum;
    char *colour = repeat->colour;
    int width = repeat->linewidth;
    char *tag_id = repeat->tagname;
    obj_match new_match;
    int cs_id;
    obj_cs *cs;

    cs_id = type_to_result(io, REG_TYPE_CONTIGSEL, 0);
    cs = result_data(io, cs_id, 0);

    for (i = 0; i < repeat->num_match; i++){
	obj_match *match = (obj_match *)&repeat->match[i];

	/* Check if shown */
	if (match->flags & OBJ_FLAG_HIDDEN)
	    continue;

	/* clip length of match if necessary */
	new_match = *match;
	DoClipping(io, &new_match);
	/*
	* printf("new pos1 %d pos2 %d length %d\n",
	* new_match.pos1,  new_match.pos2, new_match.length);

	* printf("match pos1 %d pos2 %d length %d \n",
	* match->pos1, match->pos2, match->length);
	*/
	pos1 = find_position_in_DB(io, abs(new_match.c1), new_match.pos1);
	pos2 = find_position_in_DB(io, abs(new_match.c2), new_match.pos2);

	/* convert contig code back to sense ie -ve contig number means
	 * match on opposite strand
	 */
	if (new_match.c1 < 0) {
	    sense1 = -1;
	} else {
	    sense1 = 1;
	}
	if (new_match.c2 < 0) {
	    sense2 = -1;
	} else {
	    sense2 = 1;
	}

	/*
	 * draw matches of same sense (+:+ or -:-) as p1,p2
	 *                                              \
	 *                                         p1+len, p2+len
	 * draw matches of different sense (+:- or -:+) as p1+len, p2
	 *                                                     /
	 *                                                 p1, p2+len
	 */
	x1 = pos1;
	x2 = pos1 + new_match.length;
	if (sense1 == sense2) {
	    y1 = pos2;
	    y2 = pos2 + new_match.length;
	} else {
	    y1 = pos2 + new_match.length;
	    y2 = pos2;

	}

	/* need to plot in top half of screen therefore 'x' contig should be
	 * larger than the corresponding 'y' contig
	 */
	/*
	   printf("R:%d@%d,%d@%d(%d) C:%d@%d,%d@%d(%d)\n",
	   match->pos1, match->c1, match->pos2, match->c2, match->length,
	   new_match.pos1, new_match.c1,
	   new_match.pos2, new_match.c2, new_match.length);

	   printf("tag_id %s \n", tag_id);
	*/
	if (pos1 > pos2){
	    sprintf(cmd,"%s create line %d %d %d %d -width %d -capstyle round "
		    "-tags {num_%d num_%d %s S} -fill %s",
		    cs->window, x1, y1, x2, y2, width, abs(new_match.c1),
		    abs(new_match.c2), tag_id, colour);
	} else {
	    sprintf(cmd,"%s create line %d %d %d %d -width %d -capstyle round "
		    "-tags \"num_%d num_%d %s S\" -fill %s",
		    cs->window, y1, x1, y2, x2, width, abs(new_match.c1),
		    abs(new_match.c2), tag_id, colour);
	}
	/* printf("cmd %s \n", cmd); */
	if (TCL_ERROR == Tcl_Eval(GetInterp(), cmd))
	    printf("%s \n", GetInterpResult());

	inum = atoi(GetInterpResult());
	match->inum = inum;
	HashInsert(csplot_hash, inum, match);
    }

    /* scale new matches */
    scaleSingleCanvas(GetInterp(), cs->world, cs->canvas, cs->window, 'b',
		      tag_id);
}
Esempio n. 18
0
int vrmldettracks_c(ClientData clientData, Tcl_Interp* interp, int argc, const char** argv)
{
	int    i, anz1, anz2, m, j;
	FILE   *fp1, *fp2;
	char    val[256];
	vector *line1, *line2;
	double  color, ymin=0, ymax=0, cubes;
  
	/* open file for line elements */
	fp2 = fopen ("dt.wrl", "w");
  
	fprintf(fp2, "#VRML V1.0 ascii\n\n");
	/* create header and coordsys for vrml-file */
  
	/* create boundaries from object volume */
	volumedimension(&X_lay[1], &X_lay[0], &ymax, &ymin, &Zmax_lay[1], &Zmin_lay[0]);
	cubes=(Zmax_lay[1]-Zmin_lay[0])/500;
	cubes=(ymax-ymin)/800;
  
	/* create viewpoint */
	fprintf(fp2, "  PerspectiveCamera {\n");
	fprintf(fp2, "   position   %7.3f %7.3f %7.3f\n",
		(X_lay[0]+X_lay[1])/2,(ymax+ymin)/2, Zmax_lay[1]);
	fprintf(fp2, "   orientation   1 0 0 0\n");
	fprintf(fp2, "   focalDistance 5\n");
	fprintf(fp2, "   heightAngle   0.785398 }\n\n\n");
  
	/*
	fprintf(fp2, "#create coordinate axis\n\n");
	fprintf(fp2, "  DEF group0 Separator { Label { label \"x-axis\" }\n");
	fprintf(fp2, "   Material {\n");
	fprintf(fp2, "    ambientColor 0.25 0.25 0.25\n");
	fprintf(fp2, "    diffuseColor 1.00 0.00 0.00 }\n");
	fprintf(fp2, "   Separator {\n");
	fprintf(fp2, "   Coordinate3 { point [\n");
	fprintf(fp2, "    %5.1f 0.000 0.000,\n",X_lay[1]);
	fprintf(fp2, "    0.000 0.000 0.000, ] }\n");
	fprintf(fp2, "   IndexedLineSet { coordIndex  [ 0, 1, -1 ] } } }\n\n");
  
	fprintf(fp2, "  DEF group0 Separator { Label { label \"y-axis\" }\n");
	fprintf(fp2, "   Material {\n");
	fprintf(fp2, "    ambientColor 0.25 0.25 0.25\n");
	fprintf(fp2, "    diffuseColor 0.00 1.00 0.00 }\n");
	fprintf(fp2, "   Separator {\n");
	fprintf(fp2, "   Coordinate3 { point [\n");
	fprintf(fp2, "    0.000 %5.1f 0.000,\n", ymax);
	fprintf(fp2, "    0.000   0.000 0.000, ] }\n");
	fprintf(fp2, "   IndexedLineSet { coordIndex [ 0, 1, -1 ] } } }\n\n");

	fprintf(fp2, "  DEF group0 Separator { Label { label \"z-axis\" }\n");
	fprintf(fp2, "   Material {\n");
	fprintf(fp2, "    ambientColor 0.25 0.25 0.25\n");
	fprintf(fp2, "    diffuseColor 0.00 0.00 1.00 }\n");
	fprintf(fp2, "   Separator {\n");
	fprintf(fp2, "   Coordinate3 { point  [\n");
	fprintf(fp2, "    0.000 0.000 %5.1f,\n",-Zmin_lay[0]);
	fprintf(fp2, "    0.000 0.000   0.000, ] }\n");
	fprintf(fp2, "   IndexedLineSet { coordIndex [ 0, 1, -1 ] } } }\n\n");
	*/
	fprintf(fp2, "  DEF group0 Separator { Label { label \"object volume\" }\n");
	fprintf(fp2, "   Material {\n");
	fprintf(fp2, "    ambientColor 0.25 0.25 0.25\n");
	fprintf(fp2, "    diffuseColor 0.00 0.00 0.00 }\n");
	fprintf(fp2, "   Separator {\n");
	fprintf(fp2, "   Coordinate3 { point  [\n");
	fprintf(fp2, "    %5.2f %5.2f %5.2f,\n", X_lay[0],ymin, Zmin_lay[0]);
	fprintf(fp2, "    %5.2f %5.2f %5.2f,\n", X_lay[0], ymax, Zmin_lay[0]);
	fprintf(fp2, "    %5.2f %5.2f %5.2f,\n", X_lay[1], ymax, Zmin_lay[0]);
	fprintf(fp2, "    %5.2f %5.2f %5.2f,\n", X_lay[1], ymin,Zmin_lay[0]);
	fprintf(fp2, "    %5.2f %5.2f %5.2f,\n", X_lay[0], ymin, Zmax_lay[1]);
	fprintf(fp2, "    %5.2f %5.2f %5.2f,\n", X_lay[0], ymax, Zmax_lay[1]);
	fprintf(fp2, "    %5.2f %5.2f %5.2f,\n", X_lay[1], ymax,Zmax_lay[1]);
	fprintf(fp2, "    %5.2f %5.2f %5.2f, ] }\n", X_lay[1], ymin, Zmax_lay[1]);
	fprintf(fp2, "   IndexedLineSet { coordIndex [ \n");
	fprintf(fp2, "    0, 1, 2, 3, 0, -1,\n");
	fprintf(fp2, "    0, 4, -1,\n");
	fprintf(fp2, "    1, 5, -1,\n");
	fprintf(fp2, "    2, 6, -1,\n");
	fprintf(fp2, "    3, 7, -1,\n");
	fprintf(fp2, "    4, 5, 6, 7, 4, -1 ] } } }\n");

	fprintf(fp2, "\n\n# start trajectories\n\n");
	/* read trackfile from ptv and create vectorfield */

	line1 = line2 = NULL;					// added, ad holten 2012

	for (i=seq_first; i<=seq_last;i++)
	{
		// replaced next lines. ad holten 12-2012
		//	if      (i < 10)  sprintf (val, "res/ptv_is.00%1d", i);
		//	else if (i < 100) sprintf (val, "res/ptv_is.0%2d",  i);
		//	else              sprintf (val, "res/ptv_is.%3d",  i);
		sprintf (val, "res/ptv_is.%03d",  i);
		printf("Create VRML, read file: %s\n", val);     
		fp1 = fopen (val, "r");

		color = ((double)(i-seq_first))/((double)(seq_last-1-seq_first));

		fscanf (fp1,"%d\n", &anz1);

		line1 = (vector *) calloc (anz1, sizeof (vector));
		for (j=0;j<anz1;j++) {
			fscanf (fp1, "%d\n", &line1[j].p);
			fscanf (fp1, "%d\n", &line1[j].n);
			fscanf (fp1, "%lf\n", &line1[j].x1);
			fscanf (fp1, "%lf\n", &line1[j].y1);
			fscanf (fp1, "%lf\n", &line1[j].z1);
		}

		strcpy(val, "");     
		fclose (fp1);

		if (i<seq_last) {
			/* read next time step */     
			// replaced next lines. ad holten 12-2012
			//	if      (i+1 < 10)  sprintf (val, "res/ptv_is.00%1d", i+1);
			//	else if (i+1 < 100) sprintf (val, "res/ptv_is.0%2d",  i+1);
			//	else                sprintf (val, "res/ptv_is.%3d",  i+1);
			sprintf (val, "res/ptv_is.%03d",  i+1);

			fp1 = fopen_rp (val);		// replaced fopen(), ad holten 12-2012    
			if (!fp1) break;

			fscanf (fp1,"%d\n", &anz2);
			line2 = (vector *) malloc (anz2 * sizeof (vector));

			for (j=0;j<anz2;j++) {
				fscanf (fp1, "%d\n", &line2[j].p);
				fscanf (fp1, "%d\n", &line2[j].n);
				fscanf (fp1, "%lf\n", &line2[j].x1);
				fscanf (fp1, "%lf\n", &line2[j].y1);
				fscanf (fp1, "%lf\n", &line2[j].z1);
			}
			fclose (fp1);
		}


		fprintf(fp2, "  DEF group0 Separator { Label { label \"time step %d\" }\n", i);
		fprintf(fp2, "   Material {\n");
		fprintf(fp2, "    ambientColor 0.5 0.5 0.5\n");
		fprintf(fp2, "    diffuseColor 1.0 %.4f 0 }\n\n", color);

		for(j=0;j<anz1;j++) /* if( line1[j].z1 > -22) */ {

	
			fprintf(fp2, "    Separator {\n");
			fprintf(fp2, "    Transform {translation %7.3f %7.3f %7.3f}\n",
			line1[j].x1, line1[j].y1, line1[j].z1);
			/*
			fprintf(fp2, "    Sphere { radius %3.2f } }\n", cubes );
			*/
			fprintf(fp2, "    Cube {width %3.2f height %3.2f depth %3.2f } }\n\n",cubes,cubes,cubes);
	

			if (i<seq_last) {
				m = line1[j].n;
				if (m >= 0) {

					fprintf(fp2, "    Separator {\n");
					fprintf(fp2, "     Coordinate3 { point [\n");
					fprintf(fp2, "      %7.3f %7.3f %7.3f,\n",line1[j].x1, line1[j].y1, line1[j].z1);
					fprintf(fp2, "      %7.3f %7.3f %7.3f, ] }\n", line2[m].x1, line2[m].y1, line2[m].z1);
					fprintf(fp2, "     IndexedLineSet { coordIndex [ 0, 1, -1] } }\n\n");	  

					/* cylinder/cube to mark link */
					/*
					mx=(line1[j].x1+line2[m].x1)/2;
					my=(line1[j].y1+line2[m].y1)/2; 
					mz=(line1[j].z1+line2[m].z1)/2; 
					dx=line1[j].x1-line2[m].x1;
					dy=line1[j].y1-line2[m].y1;
					dz=line1[j].z1-line2[m].z1;
					du=sqrt(dx*dx+dy*dy);
					dl=sqrt(dx*dx+dy*dy+dz*dz);

					rotz=0;
					if(dy == 0.0) {rotz=-M_PI/2;} else {rotz = -atan(dx/dy);}

					rotx=0;
					if(du == 0.0) {rotx=M_PI/2;}

					if(du != 0.0) {
						if(dx>=0.0 && dy>=0.0 && dz> 0.0) {rotx =  atan(dz/du);}
						if(dx>=0.0 && dy< 0.0 && dz> 0.0) {rotx = -atan(dz/du);}
						if(dx< 0.0 && dy> 0.0 && dz> 0.0) {rotx =  atan(dz/du);}
						if(dx< 0.0 && dy<=0.0 && dz> 0.0) {rotx = -atan(dz/du);}
						if(dx>=0.0 && dy>=0.0 && dz< 0.0) {rotx =  atan(dz/du);}
						if(dx>=0.0 && dy< 0.0 && dz< 0.0) {rotx = -atan(dz/du);}
						if(dx< 0.0 && dy> 0.0 && dz< 0.0) {rotx =  atan(dz/du);}
						if(dx< 0.0 && dy<=0.0 && dz< 0.0) {rotx = -atan(dz/du);}
					}

					fprintf(fp2, "    Separator {\n");
					fprintf(fp2, "    Transform {translation %7.3f %7.3f %7.3f}\n",mx, my, mz);
					fprintf(fp2, "    Transform {rotation 0 0 1 %7.5f}\n",rotz);
					fprintf(fp2, "    Transform {rotation 1 0 0 %7.5f}\n",rotx);

					fprintf(fp2, "    Cylinder { radius %3.2f height %3.2f } }\n\n",cubes/2, dl);

					fprintf(fp2, "    Cube {width %3.2f height %3.2f depth %3.2f } }\n\n",cubes/1.5, dl,cubes/1.5);  
					*/
					/* end of cylinder */ 
				}
			}
		}
		fprintf(fp2, "   }\n\n");     
		fprintf(fp2, "# end of time step %d\n\n", i);     
		strcpy(val, "");
		free(line1); free(line2);
		line1 = line2 = NULL;			// added, ad holten 12-2012
	}  /* end of sequence loop */

	if (line1) free(line1);		// added, ad holten 12-2012
	if (line1) free(line1);

	fprintf(fp2, "# trajectories finished\n");

	fclose(fp2); 
	Tcl_Eval(interp, ".text delete 2");
	Tcl_Eval(interp, ".text insert 2 \"Tracks/Detections written to VRML-File: dt.wrl\"");
	Tcl_Eval(interp, "update idletasks");  

	sprintf(val, "...done");
	Tcl_SetVar(interp, "tbuf", val, TCL_GLOBAL_ONLY);
	Tcl_Eval(interp, ".text delete 3");
	Tcl_Eval(interp, ".text insert 3 $tbuf");
  
	return TCL_OK;
}
Esempio n. 19
0
void sim_callback(int seq_num, void *obj, seq_reg_data *jdata)
{
    seq_result *result = (seq_result *) obj;
    in_sim *input = result->input;
    out_raster *output = result->output;
    d_plot *data = result->data;
    int id = result->id;
    char cmd[1024];
    int seq1_num, seq2_num;

    seq1_num = GetSeqNum(result->seq_id[HORIZONTAL]);
    seq2_num = GetSeqNum(result->seq_id[VERTICAL]);

    switch(jdata->job) {
    case SEQ_QUERY_NAME:
	sprintf(jdata->name.line, "Local alignment");
	break;
    case SEQ_KEY_NAME:
	sprintf(jdata->name.line, "local #%d", result->id);
	break;

    case SEQ_GET_BRIEF:
	sprintf(jdata->name.line, "local alignment: hori=%s vert=%s", 
		GetSeqBaseName(GetSeqNum(result->seq_id[HORIZONTAL])),
		GetSeqBaseName(GetSeqNum(result->seq_id[VERTICAL])));
	break;
    case SEQ_GET_OPS:
	if (output->hidden) {
	    jdata->get_ops.ops = "Information\0List results\0PLACEHOLDER\0"
		"PLACEHOLDER\0PLACEHOLDER\0Reveal\0SEPARATOR\0Remove\0";
	} else {
	    jdata->get_ops.ops = "Information\0List results\0Configure\0"
	       "Display sequences\0Hide\0PLACEHOLDER\0SEPARATOR\0Remove\0";
	}
	break;
    case SEQ_INVOKE_OP:
	switch (jdata->invoke_op.op) {
	case 0: /* information */
	    vfuncheader("input parameters");
	    vmessage("%s\n", input->params);
	    break;
	case 1: /* results */
	    Tcl_Eval(output->interp, "SetBusy");
	    vfuncheader("results");
	    /* result->txt_func(result); */
	    Tcl_Eval(output->interp, "ClearBusy");
	    break;
	case 2: /* configure */
	    sprintf(cmd, "RasterConfig %d", id);
	    if (TCL_OK != Tcl_Eval(output->interp, cmd)){
		puts(Tcl_GetStringResult(output->interp));
	    }
	    break;
	case 3: /* display sequences */
	    SequencePairDisplay(output->interp, output->raster_win, id, 
				result->seq_id[HORIZONTAL], 
				result->seq_id[VERTICAL]);
	    break;
	case 4: /* hide all */
	    output->hidden = 1;
	    ReplotAllCurrentZoom(output->interp, output->raster_win);
	    break;
	case 5: /* reveal all */
	    output->hidden = 0;
	    ReplotAllCurrentZoom(output->interp, output->raster_win);
	    break;
	case 6: /* remove */ 
	    {
	      Tcl_Interp *interp = output->interp;
	      sim_shutdown(interp, seq_num, result, output->raster_win, id);
	      break;
	    }
	}
	break;
    case SEQ_PLOT:
	result->pr_func(result, NULL);
	break;
    case SEQ_RESULT_INFO:
	switch (jdata->info.op) {
	case OUTPUT:
	    jdata->info.result = (void *)output;
	    break;
	case INPUT: 
	    jdata->info.result = (void *)input;
	    break;
	case DIMENSIONS: 
	    jdata->info.result = (void *)&data->dim;
	    break;
	case INDEX: 
	    jdata->info.result = (void *)id;
	    break;
	case RESULT:
	    jdata->info.result = (void *)result;
	    break;
	case WIN_NAME:
	    {
		char *r_win = output->raster_win;
		jdata->info.result = (void *)r_win;
		break;
	    }
	case WIN_SIZE:
	    {
		static d_point pt;
		Tcl_Interp *interp = output->interp;
		pt.x = get_default_int(interp, sip_defs, 
					w("RASTER.PLOT_WIDTH"));
		pt.y = get_default_double(interp, sip_defs,
					   w("RASTER.PLOT_HEIGHT"));

		jdata->info.result = (void *)&pt;
		break;
	    } /* WIN_SIZE */
	}
	break;
    case SEQ_HIDE: 
	output->hidden = 1;
	break;
    case SEQ_REVEAL: 
	output->hidden = 0;
	break;
    case SEQ_QUIT:
    case SEQ_DELETE: {
	Tcl_Interp *interp = output->interp;
	sim_shutdown(interp, seq_num, result, output->raster_win, id);
    }
    }

}
Esempio n. 20
0
int
wdb_comb_std_cmd(struct rt_wdb *wdbp,
		 Tcl_Interp *interp,
		 int argc,
		 char *argv[])
{
    char *comb_name;
    int ch;
    int region_flag = -1;
    struct directory *dp;
    struct rt_db_internal intern;
    struct rt_comb_internal *comb = NULL;
    struct tokens tok_hd;
    short last_tok;
    int i;
    union tree *final_tree;

    if (wdbp->dbip->dbi_read_only) {
	Tcl_AppendResult(interp, "Database is read-only!\n", (char *)NULL);
	return TCL_ERROR;
    }

    if (argc < 3) {
	struct bu_vls vls = BU_VLS_INIT_ZERO;

	bu_vls_printf(&vls, "helplib_alias wdb_comb_std %s", argv[0]);
	Tcl_Eval(interp, bu_vls_addr(&vls));
	bu_vls_free(&vls);

	return TCL_ERROR;
    }

    /* Parse options */
    bu_optind = 1;	/* re-init bu_getopt() */
    while ((ch = bu_getopt(argc, argv, "cgr?")) != -1) {
	switch (ch) {
	    case 'c':
	    case 'g':
		region_flag = 0;
		break;
	    case 'r':
		region_flag = 1;
		break;
		/* XXX How about -p and -v for FASTGEN? */
	    case '?':
	    default:
		PRINT_USAGE;
		return TCL_OK;
	}
    }
    argc -= (bu_optind + 1);
    argv += bu_optind;

    comb_name = *argv++;
    if (argc == -1) {
	PRINT_USAGE;
	return TCL_OK;
    }

    if ((region_flag != -1) && (argc == 0)) {
	/*
	 * Set/Reset the REGION flag of an existing combination
	 */
	if ((dp = db_lookup(wdbp->dbip, comb_name, LOOKUP_NOISY)) == RT_DIR_NULL)
	    return TCL_ERROR;

	if (!(dp->d_flags & RT_DIR_COMB)) {
	    Tcl_AppendResult(interp, comb_name, " is not a combination\n", (char *)0);
	    return TCL_ERROR;
	}

	if (rt_db_get_internal(&intern, dp, wdbp->dbip, (fastf_t *)NULL, &rt_uniresource) < 0) {
	    Tcl_AppendResult(interp, "Database read error, aborting\n", (char *)NULL);
	    return TCL_ERROR;
	}
	comb = (struct rt_comb_internal *)intern.idb_ptr;
	RT_CK_COMB(comb);

	if (region_flag) {
	    if (!comb->region_flag) {
		/* assign values from the defaults */
		comb->region_id = wdbp->wdb_item_default++;
		comb->aircode = wdbp->wdb_air_default;
		comb->GIFTmater = wdbp->wdb_mat_default;
		comb->los = wdbp->wdb_los_default;
	    }
	    comb->region_flag = 1;
	} else
	    comb->region_flag = 0;

	if (rt_db_put_internal(dp, wdbp->dbip, &intern, &rt_uniresource) < 0) {
	    rt_db_free_internal(&intern);
	    Tcl_AppendResult(interp, "Database write error, aborting\n", (char *)NULL);
	    return TCL_ERROR;
	}

	return TCL_OK;
    }
    /*
     * At this point, we know we have a Boolean expression.
     * If the combination already existed and region_flag is -1,
     * then leave its region_flag alone.
     * If the combination didn't exist yet,
     * then pretend region_flag was 0.
     * Otherwise, make sure to set its c_flags according to region_flag.
     */

    dp = db_lookup(wdbp->dbip, comb_name, LOOKUP_QUIET);
    if (dp != RT_DIR_NULL) {
	Tcl_AppendResult(interp, "ERROR: ", comb_name, " already exists\n", (char *)0);
	return TCL_ERROR;
    }

    /* parse Boolean expression */
    BU_LIST_INIT(&tok_hd.l);
    tok_hd.type = WDB_TOK_NULL;

    last_tok = WDB_TOK_LPAREN;
    for (i = 0; i < argc; i++) {
	char *ptr;

	ptr = argv[i];
	while (*ptr) {
	    while (*ptr == '(' || *ptr == ')') {
		switch (*ptr) {
		    case '(':
			wdb_append_lparen(&tok_hd.l);
			last_tok = WDB_TOK_LPAREN;
			break;
		    case ')':
			wdb_append_rparen(&tok_hd.l);
			last_tok = WDB_TOK_RPAREN;
			break;
		}
		ptr++;
	    }

	    if (*ptr == '\0')
		continue;

	    if (last_tok == WDB_TOK_RPAREN) {
		/* next token MUST be an operator */
		if (wdb_add_operator(interp, &tok_hd.l, *ptr, &last_tok) == TCL_ERROR) {
		    wdb_free_tokens(&tok_hd.l);
		    return TCL_ERROR;
		}
		ptr++;
	    } else if (last_tok == WDB_TOK_LPAREN) {
		/* next token MUST be an operand */
		int name_len;

		name_len = wdb_add_operand(interp, &tok_hd.l, ptr);
		if (name_len < 1) {
		    wdb_free_tokens(&tok_hd.l);
		    return TCL_ERROR;
		}
		last_tok = WDB_TOK_TREE;
		ptr += name_len;
	    } else if (last_tok == WDB_TOK_TREE) {
		/* must be an operator */
		if (wdb_add_operator(interp, &tok_hd.l, *ptr, &last_tok) == TCL_ERROR) {
		    wdb_free_tokens(&tok_hd.l);
		    return TCL_ERROR;
		}
		ptr++;
	    } else if (last_tok == WDB_TOK_UNION ||
		       last_tok == WDB_TOK_INTER ||
		       last_tok == WDB_TOK_SUBTR) {
		/* must be an operand */
		int name_len;

		name_len = wdb_add_operand(interp, &tok_hd.l, ptr);
		if (name_len < 1) {
		    wdb_free_tokens(&tok_hd.l);
		    return TCL_ERROR;
		}
		last_tok = WDB_TOK_TREE;
		ptr += name_len;
	    }
	}
    }

    if (wdb_check_syntax(interp, wdbp->dbip, &tok_hd.l, comb_name, dp)) {
	wdb_free_tokens(&tok_hd.l);
	return TCL_ERROR;
    }

    final_tree = wdb_eval_bool(&tok_hd.l);

    {
	int flags;

	flags = RT_DIR_COMB;
	BU_ALLOC(comb, struct rt_comb_internal);
	RT_COMB_INTERNAL_INIT(comb);

	comb->tree = final_tree;

	comb->region_id = -1;
	if (region_flag == (-1))
	    comb->region_flag = 0;
	else
	    comb->region_flag = region_flag;

	if (comb->region_flag) {
	    struct bu_vls tmp_vls = BU_VLS_INIT_ZERO;

	    comb->region_flag = 1;
	    comb->region_id = wdbp->wdb_item_default++;;
	    comb->aircode = wdbp->wdb_air_default;
	    comb->los = wdbp->wdb_los_default;
	    comb->GIFTmater = wdbp->wdb_mat_default;

	    bu_vls_printf(&tmp_vls,
			  "Creating region id=%ld, air=%ld, los=%ld, GIFTmaterial=%ld\n",
			  comb->region_id, comb->aircode, comb->los, comb->GIFTmater);
	    Tcl_AppendResult(interp, bu_vls_addr(&tmp_vls), (char *)NULL);
	    bu_vls_free(&tmp_vls);

	    flags |= RT_DIR_REGION;
	}

	RT_DB_INTERNAL_INIT(&intern);
	intern.idb_major_type = DB5_MAJORTYPE_BRLCAD;
	intern.idb_type = ID_COMBINATION;
	intern.idb_meth = &rt_functab[ID_COMBINATION];
	intern.idb_ptr = (genptr_t)comb;

	dp=db_diradd(wdbp->dbip, comb_name, RT_DIR_PHONY_ADDR, 0, flags, (genptr_t)&intern.idb_type);
	if (dp == RT_DIR_NULL) {
	    Tcl_AppendResult(interp, "Failed to add ", comb_name,
			     " to directory, aborting\n", (char *)NULL);
	    return TCL_ERROR;
	}

	if (rt_db_put_internal(dp, wdbp->dbip, &intern, &rt_uniresource) < 0) {
	    Tcl_AppendResult(interp, "Failed to write ", dp->d_namep, (char *)NULL);
	    return TCL_ERROR;
	}
    }

    return TCL_OK;
}
Esempio n. 21
0
/*
 *
 *	F _ A M T R A C K ( ) :	adds track given "wheel" info
 *
 */
int
f_amtrack(ClientData clientData, Tcl_Interp *interp, int argc, char **argv)
{

    fastf_t fw[3], lw[3], iw[3], dw[3], tr[3];
    char solname[12], regname[12], grpname[9], oper[3];
    int i, j, memb[4];
    char temp[4];
    vect_t	temp1, temp2;
    int item, mat, los;
    int arg;
    int edit_result;
    struct bu_list head;

    CHECK_DBI_NULL;
    CHECK_READ_ONLY;

    BU_LIST_INIT(&head);

    if (argc < 1 || 27 < argc) {
	struct bu_vls vls;

	bu_vls_init(&vls);
	bu_vls_printf(&vls, "help track");
	Tcl_Eval(interp, bu_vls_addr(&vls));
	bu_vls_free(&vls);
	return TCL_ERROR;
    }

    /* interupts */
    if ( setjmp( jmp_env ) == 0 )
	(void)signal( SIGINT, sig3);  /* allow interupts */
    else
	return TCL_OK;

    oper[0] = oper[2] = WMOP_INTERSECT;
    oper[1] = WMOP_SUBTRACT;

    arg = 1;

    /* get the roadwheel info */
    if ( argc < arg+1 ) {
	Tcl_AppendResult(interp, MORE_ARGS_STR, "Enter X of the FIRST roadwheel: ",
			 (char *)NULL);
	edit_result = TCL_ERROR;
	goto end;
    }
    fw[0] = atof( argv[arg] ) * local2base;
    ++arg;

    if ( argc < arg+1 ) {
	Tcl_AppendResult(interp, MORE_ARGS_STR, "Enter X of the LAST roadwheel: ",
			 (char *)NULL);
	edit_result = TCL_ERROR;
	goto end;
    }
    lw[0] = atof( argv[arg] ) * local2base;
    ++arg;

    if ( fw[0] <= lw[0] ) {
	Tcl_AppendResult(interp, "First wheel after last wheel - STOP\n", (char *)NULL);
	edit_result = TCL_ERROR;
	goto end;
    }

    if ( argc < arg+1 ) {
	Tcl_AppendResult(interp, MORE_ARGS_STR, "Enter Z of the roadwheels: ",
			 (char *)NULL);
	edit_result = TCL_ERROR;
	goto end;
    }
    fw[1] = lw[1] = atof( argv[arg] ) * local2base;
    ++arg;

    if ( argc < arg+1 ) {
	Tcl_AppendResult(interp, MORE_ARGS_STR, "Enter radius of the roadwheels: ",
			 (char *)NULL);
	edit_result = TCL_ERROR;
	goto end;
    }
    fw[2] = lw[2] = atof( argv[arg] ) * local2base;
    ++arg;
    if ( fw[2] <= 0 ) {
	Tcl_AppendResult(interp, "Radius <= 0 - STOP\n", (char *)NULL);
	edit_result = TCL_ERROR;
	goto end;
    }

    if ( argc < arg+1 ) {
	/* get the drive wheel info */
	Tcl_AppendResult(interp, MORE_ARGS_STR, "Enter X of the drive (REAR) wheel: ",
			 (char *)NULL);
	edit_result = TCL_ERROR;
	goto end;
    }
    dw[0] = atof( argv[arg] ) * local2base;
    ++arg;
    if ( dw[0] >= lw[0] ) {
	Tcl_AppendResult(interp, "DRIVE wheel not in the rear - STOP \n", (char *)NULL);
	edit_result = TCL_ERROR;
	goto end;
    }

    if ( argc < arg+1 ) {
	Tcl_AppendResult(interp, MORE_ARGS_STR, "Enter Z of the drive (REAR) wheel: ",
			 (char *)NULL);
	edit_result = TCL_ERROR;
	goto end;
    }
    dw[1] = atof( argv[arg] ) * local2base;
    ++arg;

    if ( argc < arg+1 ) {
	Tcl_AppendResult(interp, MORE_ARGS_STR, "Enter radius of the drive (REAR) wheel: ",
			 (char *)NULL);
	edit_result = TCL_ERROR;
	goto end;
    }
    dw[2] = atof( argv[arg] ) * local2base;
    ++arg;
    if ( dw[2] <= 0 ) {
	Tcl_AppendResult(interp, "Radius <= 0 - STOP\n", (char *)NULL);
	edit_result = TCL_ERROR;
	goto end;
    }

    /* get the idler wheel info */
    if ( argc < arg+1 ) {
	Tcl_AppendResult(interp, MORE_ARGS_STR, "Enter X of the idler (FRONT) wheel: ",
			 (char *)NULL);
	edit_result = TCL_ERROR;
	goto end;
    }
    iw[0] = atof( argv[arg] ) * local2base;
    ++arg;
    if ( iw[0] <= fw[0] ) {
	Tcl_AppendResult(interp, "IDLER wheel not in the front - STOP \n", (char *)NULL);
	edit_result = TCL_ERROR;
	goto end;
    }

    if ( argc < arg+1 ) {
	Tcl_AppendResult(interp, MORE_ARGS_STR, "Enter Z of the idler (FRONT) wheel: ",
			 (char *)NULL);
	edit_result = TCL_ERROR;
	goto end;
    }
    iw[1] = atof( argv[arg] ) * local2base;
    ++arg;

    if ( argc < arg+1 ) {
	Tcl_AppendResult(interp, MORE_ARGS_STR, "Enter radius of the idler (FRONT) wheel: ",
			 (char *)NULL);
	edit_result = TCL_ERROR;
	goto end;
    }
    iw[2] = atof( argv[arg] ) * local2base;
    ++arg;
    if ( iw[2] <= 0 ) {
	Tcl_AppendResult(interp, "Radius <= 0 - STOP\n", (char *)NULL);
	edit_result = TCL_ERROR;
	goto end;
    }

    /* get track info */
    if ( argc < arg+1 ) {
	Tcl_AppendResult(interp, MORE_ARGS_STR, "Enter Y-MIN of the track: ",
			 (char *)NULL);
	edit_result = TCL_ERROR;
	goto end;
    }
    tr[2] = tr[0] = atof( argv[arg] ) * local2base;
    ++arg;

    if ( argc < arg+1 ) {
	Tcl_AppendResult(interp, MORE_ARGS_STR, "Enter Y-MAX of the track: ",
			 (char *)NULL);
	edit_result = TCL_ERROR;
	goto end;
    }
    tr[1] = atof( argv[arg] ) * local2base;
    ++arg;
    if ( tr[0] == tr[1] ) {
	Tcl_AppendResult(interp, "MIN == MAX ... STOP\n", (char *)NULL);
	edit_result = TCL_ERROR;
	goto end;
    }
    if ( tr[0] > tr[1] ) {
	Tcl_AppendResult(interp, "MIN > MAX .... will switch\n", (char *)NULL);
	tr[1] = tr[0];
	tr[0] = tr[2];
    }

    if ( argc < arg+1 ) {
	Tcl_AppendResult(interp, MORE_ARGS_STR, "Enter track thickness: ",
			 (char *)NULL);
	edit_result = TCL_ERROR;
	goto end;
    }
    tr[2] = atof( argv[arg] ) * local2base;
    ++arg;
    if ( tr[2] <= 0 ) {
	Tcl_AppendResult(interp, "Track thickness <= 0 - STOP\n", (char *)NULL);
	edit_result = TCL_ERROR;
	goto end;
    }

    solname[0] = regname[0] = grpname[0] = 't';
    solname[1] = regname[1] = grpname[1] = 'r';
    solname[2] = regname[2] = grpname[2] = 'a';
    solname[3] = regname[3] = grpname[3] = 'c';
    solname[4] = regname[4] = grpname[4] = 'k';
    solname[5] = regname[5] = '.';
    solname[6] = 's';
    regname[6] = 'r';
    solname[7] = regname[7] = '.';
    grpname[5] = solname[8] = regname[8] = '\0';
    grpname[8] = solname[11] = regname[11] = '\0';
/*
  bu_log("\nX of first road wheel  %10.4f\n", fw[0]);
  bu_log("X of last road wheel   %10.4f\n", lw[0]);
  bu_log("Z of road wheels       %10.4f\n", fw[1]);
  bu_log("radius of road wheels  %10.4f\n", fw[2]);
  bu_log("\nX of drive wheel       %10.4f\n", dw[0]);
  bu_log("Z of drive wheel       %10.4f\n", dw[1]);
  bu_log("radius of drive wheel  %10.4f\n", dw[2]);
  bu_log("\nX of idler wheel       %10.4f\n", iw[0]);
  bu_log("Z of idler wheel       %10.4f\n", iw[1]);
  bu_log("radius of idler wheel  %10.4f\n", iw[2]);
  bu_log("\nY MIN of track         %10.4f\n", tr[0]);
  bu_log("Y MAX of track         %10.4f\n", tr[1]);
  bu_log("thickness of track     %10.4f\n", tr[2]);
*/

/* Check for names to use:
 *	1.  start with track.s.1->10 and track.r.1->10
 *	2.  if bad, increment count by 10 and try again
 */

 tryagain:	/* sent here to try next set of names */

    for (i=0; i<11; i++) {
	crname(solname, i, sizeof(solname));
	crname(regname, i, sizeof(regname));
	if (	(db_lookup( dbip, solname, LOOKUP_QUIET) != DIR_NULL)	||
		(db_lookup( dbip, regname, LOOKUP_QUIET) != DIR_NULL)	) {
	    /* name already exists */
	    solname[8] = regname[8] = '\0';
	    if ( (Trackpos += 10) > 500 ) {
		Tcl_AppendResult(interp, "Track: naming error -- STOP\n",
				 (char *)NULL);
		edit_result = TCL_ERROR;
		goto end;
	    }
	    goto tryagain;
	}
	solname[8] = regname[8] = '\0';
    }

    /* no interupts */
    (void)signal( SIGINT, SIG_IGN );

    /* find the front track slope to the idler */
    for (i=0; i<24; i++)
	sol.s_values[i] = 0.0;

    slope(fw, iw, tr);
    VMOVE(temp2, &sol.s_values[0]);
    crname(solname, 1, sizeof(solname));
    bu_strlcpy(sol.s_name, solname, NAMESIZE+1);
    sol.s_type = ID_ARB8;
    if ( wrobj(solname, DIR_SOLID) )
	return TCL_ERROR;

    solname[8] = '\0';

    /* find track around idler */
    for (i=0; i<24; i++)
	sol.s_values[i] = 0.0;
    sol.s_type = ID_TGC;
    trcurve(iw, tr);
    crname(solname, 2, sizeof(solname));
    bu_strlcpy(sol.s_name, solname, NAMESIZE+1);
    if ( wrobj( solname, DIR_SOLID ) )
	return TCL_ERROR;
    solname[8] = '\0';
    /* idler dummy rcc */
    sol.s_values[6] = iw[2];
    sol.s_values[11] = iw[2];
    VMOVE(&sol.s_values[12], &sol.s_values[6]);
    VMOVE(&sol.s_values[15], &sol.s_values[9]);
    crname(solname, 3, sizeof(solname));
    bu_strlcpy(sol.s_name, solname, NAMESIZE+1);
    if ( wrobj( solname, DIR_SOLID ) )
	return TCL_ERROR;
    solname[8] = '\0';

    /* find idler track dummy arb8 */
    for (i=0; i<24; i++)
	sol.s_values[i] = 0.0;
    crname(solname, 4, sizeof(solname));
    bu_strlcpy(sol.s_name, solname, NAMESIZE+1);
    sol.s_type = ID_ARB8;
    crdummy(iw, tr, 1);
    if ( wrobj(solname, DIR_SOLID) )
	return TCL_ERROR;
    solname[8] = '\0';

    /* track slope to drive */
    for (i=0; i<24; i++)
	sol.s_values[i] = 0.0;
    slope(lw, dw, tr);
    VMOVE(temp1, &sol.s_values[0]);
    crname(solname, 5, sizeof(solname));
    bu_strlcpy(sol.s_name, solname, NAMESIZE+1);
    if (wrobj(solname, DIR_SOLID))
	return TCL_ERROR;
    solname[8] = '\0';

    /* track around drive */
    for (i=0; i<24; i++)
	sol.s_values[i] = 0.0;
    sol.s_type = ID_TGC;
    trcurve(dw, tr);
    crname(solname, 6, sizeof(solname));
    bu_strlcpy(sol.s_name, solname, NAMESIZE+1);
    if ( wrobj(solname, DIR_SOLID) )
	return TCL_ERROR;
    solname[8] = '\0';

    /* drive dummy rcc */
    sol.s_values[6] = dw[2];
    sol.s_values[11] = dw[2];
    VMOVE(&sol.s_values[12], &sol.s_values[6]);
    VMOVE(&sol.s_values[15], &sol.s_values[9]);
    crname(solname, 7, sizeof(solname));
    bu_strlcpy(sol.s_name, solname, NAMESIZE+1);
    if ( wrobj(solname, DIR_SOLID) )
	return TCL_ERROR;
    solname[8] = '\0';

    /* drive dummy arb8 */
    for (i=0; i<24; i++)
	sol.s_name[i] = 0.0;
    crname(solname, 8, sizeof(solname));
    bu_strlcpy(sol.s_name, solname, NAMESIZE+1);
    sol.s_type = ID_ARB8;
    crdummy(dw, tr, 2);
    if ( wrobj(solname, DIR_SOLID) )
	return TCL_ERROR;
    solname[8] = '\0';

    /* track bottom */
    temp1[1] = temp2[1] = tr[0];
    bottom(temp1, temp2, tr);
    crname(solname, 9, sizeof(solname));
    bu_strlcpy(sol.s_name, solname, NAMESIZE+1);
    if ( wrobj(solname, DIR_SOLID) )
	return TCL_ERROR;
    solname[8] = '\0';

    /* track top */
    temp1[0] = dw[0];
    temp1[1] = temp2[1] = tr[0];
    temp1[2] = dw[1] + dw[2];
    temp2[0] = iw[0];
    temp2[2] = iw[1] + iw[2];
    top(temp1, temp2, tr);
    crname(solname, 10, sizeof(solname));
    bu_strlcpy(sol.s_name, solname, NAMESIZE+1);
    if ( wrobj(solname, DIR_SOLID) )
	return TCL_ERROR;
    solname[8] = '\0';

    /* add the regions */
    item = item_default;
    mat = mat_default;
    los = los_default;
    item_default = 500;
    mat_default = 1;
    los_default = 50;
    /* region 1 */
    memb[0] = 1;
    memb[1] = 4;
    crname(regname, 1, sizeof(regname));
    crregion(regname, oper, memb, 2, solname, sizeof(regname));
    solname[8] = regname[8] = '\0';

    /* region 2 */
    crname(regname, 2, sizeof(regname));
    memb[0] = 2;
    memb[1] = 3;
    memb[2] = 4;
    crregion(regname, oper, memb, 3, solname, sizeof(regname));
    solname[8] = regname[8] = '\0';

    /* region 5 */
    crname(regname, 5, sizeof(regname));
    memb[0] = 5;
    memb[1] = 8;
    crregion(regname, oper, memb, 2, solname, sizeof(regname));
    solname[8] = regname[8] = '\0';

    /* region 6 */
    crname(regname, 6, sizeof(regname));
    memb[0] = 6;
    memb[1] = 7;
    memb[2] = 8;
    crregion(regname, oper, memb, 3, solname, sizeof(regname));
    solname[8] = regname[8] = '\0';

    /* region 9 */
    crname(regname, 9, sizeof(regname));
    memb[0] = 9;
    memb[1] = 1;
    memb[2] = 5;
    oper[2] = WMOP_SUBTRACT;
    crregion(regname, oper, memb, 3, solname, sizeof(regname));
    solname[8] = regname[8] = '\0';

    /* region 10 */
    crname(regname, 10, sizeof(regname));
    memb[0] = 10;
    memb[1] = 4;
    memb[2] = 8;
    crregion(regname, oper, memb, 3, solname, sizeof(regname));
    solname[8] = regname[8] = '\0';

    /* group all the track regions */
    j = 1;
    if ( (i = Trackpos / 10 + 1) > 9 )
	j = 2;
    itoa(i, temp, j);
    bu_strlcat(grpname, temp, sizeof(grpname));
    for (i=1; i<11; i++) {
	if ( i == 3 || i ==4 || i == 7 || i == 8 )
	    continue;
	regname[8] = '\0';
	crname(regname, i, sizeof(regname));
	if ( db_lookup( dbip, regname, LOOKUP_QUIET) == DIR_NULL ) {
	    Tcl_AppendResult(interp, "group: ", grpname, " will skip member: ",
			     regname, "\n", (char *)NULL);
	    continue;
	}
	mk_addmember( regname, &head, NULL, WMOP_UNION );
    }

    /* Add them all at once */
    if ( mk_comb( wdbp, grpname, &head,
		  0, NULL, NULL, NULL,
		  0, 0, 0, 0,
		  0, 1, 1 ) < 0 )
    {
	Tcl_AppendResult(interp,
			 "An error has occured while adding '",
			 grpname, "' to the database.\n", (char *)NULL);
    }

    /* draw this track */
    Tcl_AppendResult(interp, "The track regions are in group ", grpname,
		     "\n", (char *)NULL);
    {
	const char *arglist[3];
	arglist[0] = "e";
	arglist[1] = grpname;
	arglist[2] = NULL;
	edit_result = cmd_draw( clientData, interp, 2, arglist );
    }

    Trackpos += 10;
    item_default = item;
    mat_default = mat;
    los_default = los;
    grpname[5] = solname[8] = regname[8] = '\0';

    return edit_result;
 end:
    (void)signal( SIGINT, SIG_IGN );
    return edit_result;
}
Esempio n. 22
0
DisplayContext *manageTrace(edview *xx,
			    char *format,
			    char *rawDataFile,
			    int baseNum,
			    int leftCutOff,
			    int cutLength,
			    int complemented,
			    int baseSpacing,
			    char *traceTitle,
			    int allow_dup,
			    int small_seq
			    ) {
    char *traceName;
    DisplayContext *dc;
    int exists;
    Tcl_Interp *interp = EDINTERP(xx->ed);
    char buf[1024];
    char *pname;
    Tcl_CmdInfo info;
    char *edpath;
    char seqbuf[1024];

    if ((traceName=(char *)strrchr(rawDataFile,'/'))==NULL)
        traceName = rawDataFile;
    else
        traceName++;

    dc = getTDisplay(xx, traceName, allow_dup, small_seq, &exists);
    if (exists) {
	repositionSeq(xx, dc, baseNum);
	flashCursor(xx, dc);
	return dc;
    }

    pname = get_default_string(interp, gap5_defs, "TRACE_DISPLAY.WIN");

    /*
     * If we're the bottom half of a join editor, combine traces with the
     * top half.
     */
    if (inJoinMode(xx) && xx->link && xx == xx->link->xx[1] && !small_seq) {
	edpath = Tk_PathName(EDTKWIN(xx->link->xx[0]->ed));
    } else {
	edpath = Tk_PathName(EDTKWIN(xx->ed));
    }

    if (small_seq) {
	/* Mini-traces embedded in the editor */
	//sprintf(seqbuf, "%d %d", small_seq, xx->lines_per_seq-1);
	sprintf(seqbuf, "%d %d", small_seq, 3);
	if (TCL_OK != Tcl_VarEval(interp, "trace_small_add ",
				  edpath, pname, " {", rawDataFile, "} {",
				  edpath, "} ", seqbuf, NULL)) {
	    freeTDisplay(traceName);
	    puts(Tcl_GetStringResult(interp));
	    return NULL;
	}
    } else {
	/* The full-blown trace display. */
	if (TCL_OK != Tcl_VarEval(interp, "trace_add ",
				  edpath, pname, " {", rawDataFile, "} {",
				  edpath, "} {", traceTitle, "}", NULL)) {
	    freeTDisplay(traceName);
	    return NULL;
	}
    }
    strcpy(dc->path, Tcl_GetStringResult(interp));

    /* Get Trace widget pointer */
    if (-1 == Tcl_GetCommandInfo(interp, Tcl_GetStringResult(interp), &info)) {
	freeTDisplay(traceName);
	return NULL;
    }
    dc->tracePtr = (DNATrace *)info.clientData;

    /* Set orientation and cutoffs */
    if (complemented)
	Tcl_VarEval(interp, dc->path, " complement", NULL);
    dc->complemented = complemented;

    sprintf(buf, "%s left_cutoff %d", dc->path, leftCutOff);
    Tcl_Eval(interp, buf);

    sprintf(buf, "%s right_cutoff %d", dc->path, leftCutOff + cutLength);
    Tcl_Eval(interp, buf);

    /* Tcl_VarEval(interp, "update idletasks", NULL); */

    /* Adjust position */
    repositionSeq(xx, dc, baseNum);

    return dc;
}
Esempio n. 23
0
File: tcltk.c Progetto: kmillar/rho
void tcltk_init(int *TkUp)
{
    int code;

    *TkUp = 0;

    /* Absence of the following line is said to be an error with
     * tcl >= 8.4 on all platforms, and is known to cause crashes under
     * Windows */

    Tcl_FindExecutable(NULL);

    RTcl_interp = Tcl_CreateInterp();
    code = Tcl_Init(RTcl_interp);
    if (code != TCL_OK) error(Tcl_GetStringResult(RTcl_interp));

/* HAVE_AQUA is not really right here.
   On Mac OS X we might be using Aqua Tcl/Tk or X11 Tcl/Tk, and that
   is in principle independent of whether we want quartz() built.
*/
#if !defined(Win32) && !defined(HAVE_AQUA)
    char *p= getenv("DISPLAY");
    if(p && p[0])  /* exclude DISPLAY = "" */
#endif
    {
	code = Tk_Init(RTcl_interp);  /* Load Tk into interpreter */
	if (code != TCL_OK) {
	    warning(Tcl_GetStringResult(RTcl_interp));
	} else {
	    Tcl_StaticPackage(RTcl_interp, "Tk", Tk_Init, Tk_SafeInit);

	    code = Tcl_Eval(RTcl_interp, "wm withdraw .");  /* Hide window */
	    if (code != TCL_OK) error(Tcl_GetStringResult(RTcl_interp));
	    *TkUp = 1;
	}
    }
#if !defined(Win32) && !defined(HAVE_AQUA)
    else
	warningcall(R_NilValue, _("no DISPLAY variable so Tk is not available"));
#endif

    Tcl_CreateCommand(RTcl_interp,
		      "R_eval",
		      R_eval,
		      (ClientData) NULL,
		      (Tcl_CmdDeleteProc *) NULL);

    Tcl_CreateCommand(RTcl_interp,
		      "R_call",
		      R_call,
		      (ClientData) NULL,
		      (Tcl_CmdDeleteProc *) NULL);

    Tcl_CreateCommand(RTcl_interp,
		      "R_call_lang",
		      R_call_lang,
		      (ClientData) NULL,
		      (Tcl_CmdDeleteProc *) NULL);

#ifndef Win32
    Tcl_unix_setup();
#endif
    Tcl_SetServiceMode(TCL_SERVICE_ALL);

/*** We may want to revive this at some point ***/

#if 0
  code = Tcl_EvalFile(RTcl_interp, "init.tcl");
  if (code != TCL_OK)
    error("%s\n", Tcl_GetStringResult(RTcl_interp));
#endif

}
Esempio n. 24
0
int Tk_utils_Init(Tcl_Interp *interp) {
    char *s, c[20], *lib = NULL, buf[1024];

    our_interp = interp;

    /* FIXME: Remove this, but firstly we need to remove from tcl code */
    Tcl_SetVar2(interp, "licence","type", "f", TCL_GLOBAL_ONLY);

    /* Master subversion repository version */
    Tcl_SetVar(interp, "svn_version", SVN_VERS, TCL_GLOBAL_ONLY);

    /* Keyed lists from tclX */
    TclX_KeyedListInit(interp);
 
    /* Our updated Raster widget */
    Raster_Init(interp);

    /* Our own widgets and commands */
    Tk_utils_Misc_Init(interp);
    TextOutput_Init(interp);
    Trace_Init(interp);
    Sheet_Init(interp);

    /* Other ancillary commands */
    Tcl_CreateObjCommand(interp, "read_seq_trace", tcl_read_seq_trace,
			 (ClientData) NULL,
			 NULL);

    /* Used only by spin2; not currently supported */
    /*
    Container_Init(interp);

    Tk_CreateItemType(&tkGraphType);
    Tcl_GraphInit(interp);
    */

    /* SeqReg_Init(interp); */

    /*
     * The auto_path.
     */
    if (lib = getenv("STADTCL")) {
	sprintf(buf, "%s/tk_utils", lib);
	lib = buf;
    }

    if (lib) {
	char *argv[3];
	int argc = 3;
	char *merged;
	argv[0] = "lappend";
	argv[1] = "auto_path";
	argv[2] = lib;
	Tcl_Eval(interp, merged = Tcl_Merge(argc, argv));
	Tcl_Free(merged);
    }

    /*
     * Set packages(name). This is done to prevent subsequent reloading
     * of this library (for efficiency reasons). The only reason that this
     * is necessary is that currently gap4 dynamically links with some
     * libraries at link time. When they're all at run time this won't
     * be necessary.
     */
    if (s = Tcl_GetVar2(interp, "packages", "tk_utils", TCL_GLOBAL_ONLY))
	sprintf(c, "%d", atoi(s)|2);
    else
	strcpy(c, "2");
    Tcl_SetVar2(interp, "packages", "tk_utils", c, TCL_GLOBAL_ONLY);

    /*
     * tk_utils_defs (a Tcl_Obj pointer)
     *
     * We keep this up to date by creating a write trace on the object and
     * doing an ObjGetVar2 when it changes. This way the object is always
     * valid.
     * Firstly we have to create tk_utils_defs though as initially it doesn't
     * exist.
     */
    {
	Tcl_Obj *val = Tcl_NewStringObj("", -1);

	defs_name = Tcl_NewStringObj("tk_utils_defs", -1); /* global */
	tk_utils_defs = Tcl_ObjSetVar2(interp, defs_name, NULL, val,
				       TCL_GLOBAL_ONLY);
	Tcl_TraceVar(interp, "tk_utils_defs",
		     TCL_TRACE_WRITES | TCL_GLOBAL_ONLY,
		     tk_utils_defs_trace, NULL);
    }

    return Tcl_PkgProvide(interp, "tk_utils", "1.0");
}
Esempio n. 25
0
void DupStatCmdTests::getmixeddups()
{
    registerCmd();
    
    // Data for source 1 ts : 100, 110, 110, 110, 110 120
    
    EVB::FlatFragment frag;
    frag.s_header.s_timestamp = 100;              // nonzero is the key.
    frag.s_header.s_sourceId  = 1;
    frag.s_header.s_size      = 0;
    frag.s_header.s_barrier   = 0;
    m_pOrderer->addFragments(sizeof(frag), &frag);
    
    frag.s_header.s_timestamp = 110;
    m_pOrderer->addFragments(sizeof(frag), &frag);
    frag.s_header.s_timestamp = 110;                 /// dup 1
    m_pOrderer->addFragments(sizeof(frag), &frag);
    frag.s_header.s_timestamp = 110;                 // dup 2
    m_pOrderer->addFragments(sizeof(frag), &frag);
    frag.s_header.s_timestamp = 110;                 // dup 3
    m_pOrderer->addFragments(sizeof(frag), &frag);
    
    frag.s_header.s_timestamp = 120;                 // not a dup.
    m_pOrderer->addFragments(sizeof(frag), &frag);
    
    // Data from source 2 is 100 110 120 130 140 150
    
    frag.s_header.s_sourceId = 2;
    frag.s_header.s_timestamp = 100;                   // yeah. could be a loop.
    m_pOrderer->addFragments(sizeof(frag), &frag);
    frag.s_header.s_timestamp = 120;
    m_pOrderer->addFragments(sizeof(frag), &frag);
    frag.s_header.s_timestamp = 130;
    m_pOrderer->addFragments(sizeof(frag), &frag);
    frag.s_header.s_timestamp = 140;
    m_pOrderer->addFragments(sizeof(frag), &frag);
    frag.s_header.s_timestamp = 150;
    m_pOrderer->addFragments(sizeof(frag), &frag);
    
    // Data from source 3 is 112, 112, 120, 125, 130, 132
    
    frag.s_header.s_sourceId = 3;
    frag.s_header.s_timestamp = 112;
    m_pOrderer->addFragments(sizeof(frag), &frag);
    frag.s_header.s_timestamp = 112;
    m_pOrderer->addFragments(sizeof(frag), &frag);    // dup 1 (and only)
    frag.s_header.s_timestamp = 120;
    m_pOrderer->addFragments(sizeof(frag), &frag);
    frag.s_header.s_timestamp = 125;
    m_pOrderer->addFragments(sizeof(frag), &frag);
    frag.s_header.s_timestamp = 130;
    m_pOrderer->addFragments(sizeof(frag), &frag);
    frag.s_header.s_timestamp = 132;
    m_pOrderer->addFragments(sizeof(frag), &frag);
    
    // flush the data:
    
    m_pOrderer->flushQueues();
    
    // Run the command and analyze the results:
    
    EQ(TCL_OK, Tcl_Eval(m_pNativeInterp, "dupstat get"));
    CTCLObject result(Tcl_GetObjResult(m_pNativeInterp));
    result.Bind(m_pInterp);
    
    // Should have a 2 element list, element 0 is the integer 4
    // (sum of all dups over all sources.
    
    EQ(2, result.llength());
    EQ(4, int(result.lindex(0)));
    
    // The details should be a 2 element list:
    
    CTCLObject details(result.lindex(1));
    details.Bind(m_pInterp);
    EQ(2, details.llength());
    
    checkDetails(1, 3, 110, details.lindex(0));
    checkDetails(3, 1, 112, details.lindex(1));
    
}
Esempio n. 26
0
int InitializeModuleCommands( Tcl_Interp* interp)
{

#if WITH_DEBUGGING_INIT
    ErrorLogger( NO_ERR_START, LOC, _proc_InitializeModuleCommands, NULL);
#endif

    /**
     **  General initialization of the Tcl interpreter
     **/
    if( Tcl_Init( interp) == TCL_ERROR)
	if( OK != ErrorLogger( ERR_INIT_TCL, LOC, NULL))
	    goto unwind0;

#ifdef  HAS_TCLXLIBS

    /**
     **  Extended Tcl initialization if configured so ...
     **/

#if (TCL_MAJOR_VERSION > 8 || TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION > 3)
    if( Tclx_Init( interp) == TCL_ERROR)
#elif (TCL_MAJOR_VERSION > 7 || TCL_MAJOR_VERSION == 7 && TCL_MINOR_VERSION > 5)
    if( Tclxcmd_Init( interp) == TCL_ERROR)
#else
    if( TclXCmd_Init( interp) == TCL_ERROR)
#endif
    {
	if( OK != ErrorLogger( ERR_INIT_TCLX, LOC, NULL))
	    goto unwind0;
    }

#endif  /* HAS_TCLXLIBS */

#ifdef	AUTOLOADPATH

    /**
     ** Extend autoload path
     **/
    if( TCL_OK != Tcl_Eval( interp,
	"if [info exists auto_path] { "
		"set auto_path [linsert $auto_path 0 " AUTOLOADPATH
	"]} else {"
		"set auto_path \"" AUTOLOADPATH "\" }"))
	if( OK != ErrorLogger( ERR_INIT_ALPATH, LOC, NULL))
	    goto unwind0;

#endif	/* AUTOLOADPATH */

    /**
     **   Now for each module command a callback routine has to be specified
     **/
    Tcl_CreateCommand( interp, "exit", Module_Tcl_ExitCmd,
		       (ClientData) shell_derelict,(void (*)(ClientData)) NULL);

    Tcl_CreateCommand( interp, "setenv", cmdSetEnv, 
		       (ClientData) shell_derelict,(void (*)(ClientData)) NULL);
    Tcl_CreateCommand( interp, "unsetenv", cmdUnsetEnv, 
		       (ClientData) shell_derelict,(void (*)(ClientData)) NULL);
  
    Tcl_CreateCommand( interp, "prepend-path", cmdSetPath, 
		       (ClientData) shell_derelict,(void (*)(ClientData)) NULL);
    Tcl_CreateCommand( interp, "append-path", cmdSetPath, 
		       (ClientData) shell_derelict,(void (*)(ClientData)) NULL);
    Tcl_CreateCommand( interp, "remove-path", cmdRemovePath, 
		       (ClientData) shell_derelict,(void (*)(ClientData)) NULL);

    Tcl_CreateCommand( interp, "module-info", cmdModuleInfo, 
		       (ClientData) shell_derelict,(void (*)(ClientData)) NULL);
    Tcl_CreateCommand( interp, "module", cmdModule, 
		       (ClientData) shell_derelict,(void (*)(ClientData)) NULL);

    Tcl_CreateCommand( interp, "module-whatis", cmdModuleWhatis, 
		       (ClientData) shell_derelict,(void (*)(ClientData)) NULL);
    Tcl_CreateCommand( interp, "module-verbosity", cmdModuleVerbose, 
		       (ClientData) shell_derelict,(void (*)(ClientData)) NULL);
    Tcl_CreateCommand( interp, "module-user", cmdModuleUser, 
		       (ClientData) shell_derelict,(void (*)(ClientData)) NULL);
    Tcl_CreateCommand( interp, "module-log", cmdModuleLog, 
		       (ClientData) shell_derelict,(void (*)(ClientData)) NULL);
    Tcl_CreateCommand( interp, "module-trace", cmdModuleTrace, 
		       (ClientData) shell_derelict,(void (*)(ClientData)) NULL);

    Tcl_CreateCommand( interp, "module-alias", cmdModuleAlias, 
		       (ClientData) shell_derelict,(void (*)(ClientData)) NULL);
    Tcl_CreateCommand( interp, "module-version", cmdModuleVersion, 
		       (ClientData) shell_derelict,(void (*)(ClientData)) NULL);

    Tcl_CreateCommand( interp, "module-set", cmdModuleSet, 
		       (ClientData) shell_derelict,(void (*)(ClientData)) NULL);
  
    Tcl_CreateCommand( interp, "set-alias", cmdSetAlias, 
		       (ClientData) shell_derelict,(void (*)(ClientData)) NULL);
    Tcl_CreateCommand( interp, "unset-alias", cmdSetAlias, 
		       (ClientData) shell_derelict,(void (*)(ClientData)) NULL);

    Tcl_CreateCommand( interp, "conflict", cmdConflict, 
		       (ClientData) shell_derelict,(void (*)(ClientData)) NULL);
    Tcl_CreateCommand( interp, "prereq", cmdPrereq, 
		       (ClientData) shell_derelict,(void (*)(ClientData)) NULL);

    Tcl_CreateCommand( interp, "is-loaded", cmdIsLoaded, 
		       (ClientData) shell_derelict,(void (*)(ClientData)) NULL);

    Tcl_CreateCommand( interp, "chdir", cmdChDir,
		       (ClientData) shell_derelict,(void (*)(ClientData)) NULL);
    Tcl_CreateCommand( interp, "system", cmdSystem, 
		       (ClientData) shell_derelict,(void (*)(ClientData)) NULL);
    Tcl_CreateCommand( interp, "uname", cmdUname, 
		       (ClientData) shell_derelict,(void (*)(ClientData)) NULL);

    Tcl_CreateCommand( interp, "x-resource", cmdXResource,
 		       (ClientData) shell_derelict,(void (*)(ClientData)) NULL);

    return( TCL_OK);			/** -------- EXIT (SUCCESS) -------> **/

unwind0:
    return( TCL_ERROR);			/** -------- EXIT (FAILURE) -------> **/

} /** End of 'InitializeModuleCommands' **/
Esempio n. 27
0
	virtual void OnPreRehash() {
		if (interp)
			Tcl_Eval(interp,"Binds::ProcessEvnt prerehash");
	}
Esempio n. 28
0
/* draw the contig lines of the contig selector */
int
display_contigs(Tcl_Interp *interp,                                   /* in */
		GapIO *io,                                            /* in */
		char *win_name,                                       /* in */
		char *colour,                                         /* in */
		int width,                                            /* in */
		int tick_wd,                                          /* in */
		int tick_ht,                                          /* in */
		int offset,                                           /* in */
		char *direction)                                      /* in */
{
    char cmd[1024];
    int i;
    int x1 = 1;
    int x2 = x1;
    int y1 = 1;
    int y2 = y1;

    sprintf(cmd, "%s delete all", win_name);
    Tcl_Eval(interp, cmd);

    /* draw first tick */
    if (strcmp(direction, "horizontal")==0){
	sprintf(cmd, "%s create line %d %d %d %d "
		"-fill %s -width %d -tags sep_1\n",
		win_name, x1, offset-tick_ht, x1, offset+tick_ht,
		colour, tick_wd);
    } else if (strcmp(direction, "vertical")==0){
	sprintf(cmd, "%s create line %d %d %d %d "
		"-fill %s -width %d -tags sep_1\n",
		win_name, offset-tick_ht, y1, offset+tick_ht, y1,
		colour, tick_wd);
    }
    /* printf("cmd %s \n", cmd); */
    Tcl_Eval(interp, cmd);

#ifdef DEBUG
    printf("num contigs %d \n", NumContigs(io));
    for (i = 0; i < NumContigs(io); i++ ){
	printf("i %d %d\n", i, arr(GCardinal, io->contig_order, i));
    }
#endif

    for (i = 0; i < NumContigs(io); i++){
	if (arr(GCardinal, io->contig_order, i) > 0) {
	    int clen = io_clength(io, arr(GCardinal, io->contig_order, i));
	    if (strcmp(direction, "horizontal")==0){
		x1 = x2;
		x2 = clen + x2;
		/*
		  printf("i %d num %d length %d x1 %d x2 %d \n",
		  i, arr(GCardinal, io->contig_order, i), clen,
		  x1, x2);
		*/
		/* contig line */
		sprintf(cmd,"%s create line %d %d %d %d "
			"-fill %s -width %d "
			"-tags {contig c_%d num_%d hl_%d S}\n",
			win_name, x1, offset, x2, offset,
			colour, width, i+1,
			arr(GCardinal, io->contig_order, i),
			arr(GCardinal, io->contig_order, i));
	    } else if (strcmp(direction, "vertical")==0){
		y1 = y2;
		y2 = clen + y2;
		sprintf(cmd,"%s create line %d %d %d %d "
			"-fill %s -width %d "
			"-tags {contig c_%d num_%d hl_%d S}\n",
			win_name, offset, y1, offset, y2,
			colour, width, i+1,
			arr(GCardinal, io->contig_order, i),
			arr(GCardinal, io->contig_order, i));
	    }
	    Tcl_Eval(interp, cmd);

	    /* Store canvas item number in an array containing contig no. */
	    {
		char aname[1024], aele[50];
		sprintf(aname, "%s.Cnum", win_name);
		sprintf(aele, "%d", i+1);
		Tcl_SetVar2(interp, aname, aele, Tcl_GetStringResult(interp),
			    TCL_GLOBAL_ONLY);
	    }

	    /* tick at end of line */
	    if (strcmp(direction, "horizontal")==0){
		sprintf(cmd, "%s create line %d %d %d %d "
			"-fill %s -width %d -tags sep_%d\n",
			win_name, x2, offset-tick_ht, x2, offset+tick_ht,
			colour, tick_wd, i+2);
	    } else if (strcmp(direction, "vertical")==0){
		sprintf(cmd, "%s create line %d %d %d %d "
			"-fill %s -width %d -tags sep_%d\n",
			win_name, offset-tick_ht, y2, offset+tick_ht, y2,
			colour, tick_wd, i+2);

	    }
	    /* printf("cmd %s \n", cmd); */
	    Tcl_Eval(interp, cmd);
	}
    }
    return TCL_OK;
}
Esempio n. 29
0
	virtual void OnIRCConnected() {
		if (interp)
			Tcl_Eval(interp, "Binds::ProcessEvnt init-server");
	}
Esempio n. 30
0
/*
 * Lexical analyzer for expression parser:  parses a single value,
 * operator, or other syntactic element from an expression string.
 *
 * Results:
 *	TCL_OK is returned unless an error occurred while doing lexical
 *	analysis or executing an embedded command.  In that case a
 *	standard Tcl error is returned, using interp->result to hold
 *	an error message.  In the event of a successful return, the token
 *	and field in infoPtr is updated to refer to the next symbol in
 *	the expression string, and the expr field is advanced past that
 *	token;  if the token is a value, then the value is stored at
 *	valuePtr.
 *
 * Side effects:
 *	None.
 */
static unsigned char
get_lex (Tcl_Interp *interp,	/* Interpreter to use for error reporting. */
	Expr_info_t *infoPtr,	/* Describes the state of the parse. */
	Value_t *valuePtr)	/* Where to store value, if that is
				 * what's parsed from string.  Caller
				 * must have initialized pv field correctly. */
{
    unsigned char *p, c, *var, *term;
    unsigned char result;

    p = infoPtr->expr;
    c = *p;
    while (isspace(c)) {
	p++;
	c = *p;
    }
    infoPtr->expr = p+1;
    switch (c) {
	case '0':
	case '1':
	case '2':
	case '3':
	case '4':
	case '5':
	case '6':
	case '7':
	case '8':
	case '9':

	    /*
	     * Number.  First read an integer.  Then if it looks like
	     * there's a floating-point number (or if it's too big a
	     * number to fit in an integer), parse it as a floating-point
	     * number.
	     */

	    infoPtr->token = VALUE;
	    valuePtr->type = TYPE_INT;
	    valuePtr->int_value = strtoul (p, &term, 0);
	    c = *term;
	    infoPtr->expr = term;
	    return TCL_OK;

	case '$':

	    /*
	     * Variable.  Fetch its value, then see if it makes sense
	     * as an integer or floating-point number.
	     */

	    infoPtr->token = VALUE;
	    var = Tcl_ParseVar(interp, p, &infoPtr->expr);
	    if (var == 0) {
		return TCL_ERROR;
	    }
	    if (((Interp *) interp)->noEval) {
		valuePtr->type = TYPE_INT;
		valuePtr->int_value = 0;
		return TCL_OK;
	    }
	    return parse_string(interp, var, valuePtr);

	case '[':
	    infoPtr->token = VALUE;
	    result = Tcl_Eval(interp, p+1, TCL_BRACKET_TERM,
		    &infoPtr->expr);
	    if (result != TCL_OK) {
		return result;
	    }
	    infoPtr->expr++;
	    if (((Interp *) interp)->noEval) {
		valuePtr->type = TYPE_INT;
		valuePtr->int_value = 0;
		Tcl_ResetResult(interp);
		return TCL_OK;
	    }
	    result = parse_string(interp, interp->result, valuePtr);
	    if (result != TCL_OK) {
		return result;
	    }
	    Tcl_ResetResult(interp);
	    return TCL_OK;

	case '"':
	    infoPtr->token = VALUE;
	    result = TclParseQuotes(interp, infoPtr->expr, '"', 0,
		    &infoPtr->expr, &valuePtr->pv);
	    if (result != TCL_OK) {
		return result;
	    }
	    return parse_string(interp, valuePtr->pv.buffer, valuePtr);

	case '{':
	    infoPtr->token = VALUE;
	    result = TclParseBraces(interp, infoPtr->expr, &infoPtr->expr,
		    &valuePtr->pv);
	    if (result != TCL_OK) {
		return result;
	    }
	    return parse_string(interp, valuePtr->pv.buffer, valuePtr);

	case '(':
	    infoPtr->token = OPEN_PAREN;
	    return TCL_OK;

	case ')':
	    infoPtr->token = CLOSE_PAREN;
	    return TCL_OK;

	case '*':
	    infoPtr->token = MULT;
	    return TCL_OK;

	case '/':
	    infoPtr->token = DIVIDE;
	    return TCL_OK;

	case '%':
	    infoPtr->token = MOD;
	    return TCL_OK;

	case '+':
	    infoPtr->token = PLUS;
	    return TCL_OK;

	case '-':
	    infoPtr->token = MINUS;
	    return TCL_OK;

	case '?':
	    infoPtr->token = QUESTY;
	    return TCL_OK;

	case ':':
	    infoPtr->token = COLON;
	    return TCL_OK;

	case '<':
	    switch (p[1]) {
		case '<':
		    infoPtr->expr = p+2;
		    infoPtr->token = LEFT_SHIFT;
		    break;
		case '=':
		    infoPtr->expr = p+2;
		    infoPtr->token = LEQ;
		    break;
		default:
		    infoPtr->token = LESS;
		    break;
	    }
	    return TCL_OK;

	case '>':
	    switch (p[1]) {
		case '>':
		    infoPtr->expr = p+2;
		    infoPtr->token = RIGHT_SHIFT;
		    break;
		case '=':
		    infoPtr->expr = p+2;
		    infoPtr->token = GEQ;
		    break;
		default:
		    infoPtr->token = GREATER;
		    break;
	    }
	    return TCL_OK;

	case '=':
	    if (p[1] == '=') {
		infoPtr->expr = p+2;
		infoPtr->token = EQUAL;
	    } else {
		infoPtr->token = UNKNOWN;
	    }
	    return TCL_OK;

	case '!':
	    if (p[1] == '=') {
		infoPtr->expr = p+2;
		infoPtr->token = NEQ;
	    } else {
		infoPtr->token = NOT;
	    }
	    return TCL_OK;

	case '&':
	    if (p[1] == '&') {
		infoPtr->expr = p+2;
		infoPtr->token = AND;
	    } else {
		infoPtr->token = BIT_AND;
	    }
	    return TCL_OK;

	case '^':
	    infoPtr->token = BIT_XOR;
	    return TCL_OK;

	case '|':
	    if (p[1] == '|') {
		infoPtr->expr = p+2;
		infoPtr->token = OR;
	    } else {
		infoPtr->token = BIT_OR;
	    }
	    return TCL_OK;

	case '~':
	    infoPtr->token = BIT_NOT;
	    return TCL_OK;

	case 0:
	    infoPtr->token = END;
	    infoPtr->expr = p;
	    return TCL_OK;

	default:
	    infoPtr->expr = p+1;
	    infoPtr->token = UNKNOWN;
	    return TCL_OK;
    }
}