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(); }
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; }
virtual void OnPostRehash() { if (interp) { Tcl_Eval(interp,"rehash"); Tcl_Eval(interp,"Binds::ProcessEvnt rehash"); } }
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; }
/******************************************************************************************** * 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; }
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; } }
/** 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; }
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*/ }
int tcl::eval(char *cmd) { return Tcl_Eval(tcl_int, cmd) == TCL_OK; }
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 */
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; }
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; }
/* 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; }
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; }
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); }
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; }
/* * 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); }
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; }
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); } } }
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; }
/* * * 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; }
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; }
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 }
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"); }
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)); }
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' **/
virtual void OnPreRehash() { if (interp) Tcl_Eval(interp,"Binds::ProcessEvnt prerehash"); }
/* 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; }
virtual void OnIRCConnected() { if (interp) Tcl_Eval(interp, "Binds::ProcessEvnt init-server"); }
/* * 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; } }