/* Check for and process Tcl binds */
int check_tcl_bind(tcl_bind_list_t *tl, const char *match,
struct flag_record *atr, const char *param, int match_type)
{
int x, result = 0, cnt = 0, finish = 0;
char *proc = NULL, *mask = NULL;
tcl_bind_mask_t *tm, *tm_last = NULL, *tm_p = NULL;
tcl_cmd_t *tc, *htc = NULL;
for (tm = tl->first; tm && !finish; tm_last = tm, tm = tm->next) {
if (tm->flags & TBM_DELETED)
continue; /* This bind mask was deleted */
if (!check_bind_match(match, tm->mask, match_type))
continue; /* This bind does not match. */
for (tc = tm->first; tc; tc = tc->next) {
/* Search for valid entry. */
if (!(tc->attributes & TC_DELETED)) {
/* Check if the provided flags suffice for this command. */
if (check_bind_flags(&tc->flags, atr, match_type)) {
cnt++;
tm_p = tm_last;
/* Not stackable */
if (!(match_type & BIND_STACKABLE)) {
/* Remember information about this bind. */
proc = tc->func_name;
mask = tm->mask;
htc = tc;
/* Either this is a non-partial match, which means we
* only want to execute _one_ bind ...
*/
if ((match_type & 0x03) != MATCH_PARTIAL ||
/* ... or this happens to be an exact match. */
!egg_strcasecmp(match, tm->mask)) {
cnt = 1;
finish = 1;
}
/* We found a match so break out of the inner loop. */
break;
}
/*
* Stackable; could be multiple commands/triggers.
* Note: This code assumes BIND_ALTER_ARGS, BIND_WANTRET, and
* BIND_STACKRET will only be used for stackable binds.
*/
tc->hits++;
Tcl_SetVar(interp, "lastbind", (char *) tm->mask, TCL_GLOBAL_ONLY);
x = trigger_bind(tc->func_name, param, tm->mask);
if (match_type & BIND_ALTER_ARGS) {
if (interp->result == NULL || !interp->result[0])
return x;
} else if ((match_type & BIND_STACKRET) && x == BIND_EXEC_LOG) {
/* If we have multiple commands/triggers, and if any of the
* commands return 1, we store the result so we can return it
* after processing all stacked binds.
*/
if (!result)
result = x;
continue;
} else if ((match_type & BIND_WANTRET) && x == BIND_EXEC_LOG)
/* Return immediately if any commands return 1 */
return x;
}
}
}
}
if (!cnt)
return BIND_NOMATCH;
/* Do this before updating the preferred entries information,
* since we don't want to change the order of stacked binds
*/
if (result) /* BIND_STACKRET */
return result;
if ((match_type & 0x03) == MATCH_MASK || (match_type & 0x03) == MATCH_CASE)
return BIND_EXECUTED;
/* Hit counter */
if (htc)
htc->hits++;
/* Now that we have found at least one bind, we can update the
* preferred entries information.
*/
if (tm_p) {
tm = tm_p->next; /* Move mask to front of bind's mask list. */
tm_p->next = tm->next; /* Unlink mask from list. */
tm->next = tl->first; /* Readd mask to front of list. */
tl->first = tm;
}
if (cnt > 1)
return BIND_AMBIGUOUS;
return trigger_bind(proc, param, mask);
}
int
TclKit_AppInit(Tcl_Interp *interp)
{
char *oldCmd;
KITDEBUG("Initializing static packages")
%DQKIT_INIT_CODE%
Tcl_StaticPackage(0, "Mk4tcl", Mk4tcl_Init, NULL);
Tcl_StaticPackage(0, "dqkitpwb", Pwb_Init, NULL);
Tcl_StaticPackage(0, "rechan", Rechan_Init, NULL);
Tcl_StaticPackage(0, "vfs", Vfs_Init, NULL);
Tcl_StaticPackage(0, "zlib", Zlib_Init, NULL);
#ifdef _WIN32
Tcl_StaticPackage(0, "dde", Dde_Init, NULL);
Tcl_StaticPackage(0, "registry", Registry_Init, NULL);
#endif
#ifdef KIT_INCLUDES_TK
Tcl_StaticPackage(0, "Tk", Tk_Init, Tk_SafeInit);
#endif
/* the tcl_rcFileName variable only exists in the initial interpreter */
#ifdef _WIN32
Tcl_SetVar(interp, "tcl_rcFileName", "~/tclkitrc.tcl", TCL_GLOBAL_ONLY);
#else
Tcl_SetVar(interp, "tcl_rcFileName", "~/.tclkitrc", TCL_GLOBAL_ONLY);
#ifdef MAC_TCL
Tcl_SetVar(interp, "tcl_rcRsrcName", "tclkitrc", TCL_GLOBAL_ONLY);
#endif
#endif
KITDEBUG("TclSetPreInitScript()")
oldCmd = TclSetPreInitScript(preInitCmd);
KITDEBUG("Tcl_Init()")
if (Tcl_Init(interp) == TCL_ERROR)
goto error;
KITDEBUG("Tcl_Init2()")
TclSetPreInitScript(preInitCmd2);
#ifdef KIT_INCLUDES_TK
KITDEBUG("Initializing Tk")
#if defined(_WIN32) || defined(MAC_TCL)
if (Tk_Init(interp) == TCL_ERROR)
goto error;
#ifdef _WIN32
KITDEBUG("Initializing Tk console window")
if (Tk_CreateConsoleWindow(interp) == TCL_ERROR)
goto error;
#else
KITDEBUG("Setting up main Tcl interp")
SetupMainInterp(interp);
#endif
#endif
#endif
KITDEBUG("Tcl_Eval(initScript)")
/* messy because TclSetStartupScriptPath is called slightly too late */
if (Tcl_Eval(interp, initScript) == TCL_OK) {
Tcl_Obj* path = TclGetStartupScriptPath();
TclSetStartupScriptPath(Tcl_GetObjResult(interp));
if (path == NULL)
Tcl_Eval(interp, "incr argc -1; set argv [lrange $argv 1 end]");
}
KITDEBUG("returning")
Tcl_SetVar(interp, "errorInfo", "", TCL_GLOBAL_ONLY);
Tcl_ResetResult(interp);
return TCL_OK;
error:
#ifdef KIT_INCLUDES_TK
#ifdef _WIN32
MessageBeep(MB_ICONEXCLAMATION);
MessageBox(NULL, Tcl_GetStringResult(interp), "Error in TclKit",
MB_ICONSTOP | MB_OK | MB_TASKMODAL | MB_SETFOREGROUND);
ExitProcess(1);
/* we won't reach this, but we need the return */
#endif
#endif
return TCL_ERROR;
}
/* Initialisation, based on tkMain.c */
CAMLprim value camltk_opentk(value argv)
{
CAMLparam1(argv);
CAMLlocal1(tmp);
char *argv0;
/* argv must contain argv[0], the application command name */
tmp = Val_unit;
if ( argv == Val_int(0) ) {
failwith("camltk_opentk: argv is empty");
}
argv0 = String_val( Field( argv, 0 ) );
if (!cltk_slave_mode) {
/* Create an interpreter, dies if error */
#if TCL_MAJOR_VERSION >= 8
Tcl_FindExecutable(String_val(argv0));
#endif
cltclinterp = Tcl_CreateInterp();
{
/* Register cltclinterp for use in other related extensions */
value *interp = caml_named_value("cltclinterp");
if (interp != NULL)
Store_field(*interp,0,copy_nativeint((intnat)cltclinterp));
}
if (Tcl_Init(cltclinterp) != TCL_OK)
tk_error(Tcl_GetStringResult(cltclinterp));
Tcl_SetVar(cltclinterp, "argv0", String_val (argv0), TCL_GLOBAL_ONLY);
{ /* Sets argv */
int argc = 0;
tmp = Field(argv, 1); /* starts from argv[1] */
while ( tmp != Val_int(0) ) {
argc++;
tmp = Field(tmp, 1);
}
if( argc != 0 ) {
int i;
char *args;
char **tkargv;
char argcstr[256]; /* string of argc */
tkargv = (char**)stat_alloc(sizeof( char* ) * argc );
tmp = Field(argv, 1); /* starts from argv[1] */
i = 0;
while ( tmp != Val_int(0) ) {
tkargv[i] = String_val(Field(tmp, 0));
tmp = Field(tmp, 1);
i++;
}
sprintf( argcstr, "%d", argc );
Tcl_SetVar(cltclinterp, "argc", argcstr, TCL_GLOBAL_ONLY);
args = Tcl_Merge(argc, (const char *const*)tkargv); /* args must be freed by Tcl_Free */
Tcl_SetVar(cltclinterp, "argv", args, TCL_GLOBAL_ONLY);
Tcl_Free(args);
stat_free( tkargv );
}
}
if (Tk_Init(cltclinterp) != TCL_OK)
tk_error(Tcl_GetStringResult(cltclinterp));
/* Retrieve the main window */
cltk_mainWindow = Tk_MainWindow(cltclinterp);
if (NULL == cltk_mainWindow)
tk_error(Tcl_GetStringResult(cltclinterp));
Tk_GeometryRequest(cltk_mainWindow,200,200);
}
/* Create the camlcallback command */
Tcl_CreateCommand(cltclinterp,
CAMLCB, CamlCBCmd,
(ClientData)NULL,(Tcl_CmdDeleteProc *)NULL);
/* This is required by "unknown" and thus autoload */
Tcl_SetVar(cltclinterp, "tcl_interactive", "0", TCL_GLOBAL_ONLY);
/* Our hack for implementing break in callbacks */
Tcl_SetVar(cltclinterp, "BreakBindingsSequence", "0", TCL_GLOBAL_ONLY);
/* Load the traditional rc file */
{
char *home = getenv("HOME");
if (home != NULL) {
char *f = stat_alloc(strlen(home)+strlen(RCNAME)+2);
f[0]='\0';
strcat(f, home);
strcat(f, "/");
strcat(f, RCNAME);
if (0 == access(f,R_OK))
if (TCL_OK != Tcl_EvalFile(cltclinterp,f)) {
stat_free(f);
tk_error(Tcl_GetStringResult(cltclinterp));
};
stat_free(f);
}
}
CAMLreturn(Val_unit);
}
int
Tcl_AppInit(Tcl_Interp *interp)
{
Tk_Window main_window;
const char * _tkinter_skip_tk_init;
#ifdef TK_AQUA
#ifndef MAX_PATH_LEN
#define MAX_PATH_LEN 1024
#endif
char tclLibPath[MAX_PATH_LEN], tkLibPath[MAX_PATH_LEN];
Tcl_Obj* pathPtr;
/* pre- Tcl_Init code copied from tkMacOSXAppInit.c */
Tk_MacOSXOpenBundleResources (interp, "com.tcltk.tcllibrary",
tclLibPath, MAX_PATH_LEN, 0);
if (tclLibPath[0] != '\0') {
Tcl_SetVar(interp, "tcl_library", tclLibPath, TCL_GLOBAL_ONLY);
Tcl_SetVar(interp, "tclDefaultLibrary", tclLibPath, TCL_GLOBAL_ONLY);
Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath, TCL_GLOBAL_ONLY);
}
if (tclLibPath[0] != '\0') {
Tcl_SetVar(interp, "tcl_library", tclLibPath, TCL_GLOBAL_ONLY);
Tcl_SetVar(interp, "tclDefaultLibrary", tclLibPath, TCL_GLOBAL_ONLY);
Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath, TCL_GLOBAL_ONLY);
}
#endif
if (Tcl_Init (interp) == TCL_ERROR)
return TCL_ERROR;
#ifdef TK_AQUA
/* pre- Tk_Init code copied from tkMacOSXAppInit.c */
Tk_MacOSXOpenBundleResources (interp, "com.tcltk.tklibrary",
tkLibPath, MAX_PATH_LEN, 1);
if (tclLibPath[0] != '\0') {
pathPtr = Tcl_NewStringObj(tclLibPath, -1);
} else {
Tcl_Obj *pathPtr = TclGetLibraryPath();
}
if (tkLibPath[0] != '\0') {
Tcl_Obj *objPtr;
Tcl_SetVar(interp, "tk_library", tkLibPath, TCL_GLOBAL_ONLY);
objPtr = Tcl_NewStringObj(tkLibPath, -1);
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
}
TclSetLibraryPath(pathPtr);
#endif
#ifdef WITH_XXX
// Initialize modules that don't require Tk
#endif
_tkinter_skip_tk_init = Tcl_GetVar(interp, "_tkinter_skip_tk_init", TCL_GLOBAL_ONLY);
if (_tkinter_skip_tk_init != NULL && strcmp(_tkinter_skip_tk_init, "1") == 0) {
return TCL_OK;
}
if (Tk_Init(interp) == TCL_ERROR)
return TCL_ERROR;
main_window = Tk_MainWindow(interp);
#ifdef TK_AQUA
TkMacOSXInitAppleEvents(interp);
TkMacOSXInitMenus(interp);
#endif
#ifdef WITH_MOREBUTTONS
{
extern Tcl_CmdProc studButtonCmd;
extern Tcl_CmdProc triButtonCmd;
Tcl_CreateCommand(interp, "studbutton", studButtonCmd,
(ClientData) main_window, NULL);
Tcl_CreateCommand(interp, "tributton", triButtonCmd,
(ClientData) main_window, NULL);
}
#endif
#ifdef WITH_PIL /* 0.2b5 and later -- not yet released as of May 14 */
{
extern void TkImaging_Init(Tcl_Interp *);
TkImaging_Init(interp);
/* XXX TkImaging_Init() doesn't have the right return type */
/*Tcl_StaticPackage(interp, "Imaging", TkImaging_Init, NULL);*/
}
#endif
#ifdef WITH_PIL_OLD /* 0.2b4 and earlier */
{
extern void TkImaging_Init(void);
/* XXX TkImaging_Init() doesn't have the right prototype */
/*Tcl_StaticPackage(interp, "Imaging", TkImaging_Init, NULL);*/
}
#endif
#ifdef WITH_TIX
{
extern int Tix_Init(Tcl_Interp *interp);
extern int Tix_SafeInit(Tcl_Interp *interp);
Tcl_StaticPackage(NULL, "Tix", Tix_Init, Tix_SafeInit);
}
#endif
#ifdef WITH_BLT
{
extern int Blt_Init(Tcl_Interp *);
extern int Blt_SafeInit(Tcl_Interp *);
Tcl_StaticPackage(NULL, "Blt", Blt_Init, Blt_SafeInit);
}
#endif
#ifdef WITH_TOGL
{
/* XXX I've heard rumors that this doesn't work */
extern int Togl_Init(Tcl_Interp *);
/* XXX Is there no Togl_SafeInit? */
Tcl_StaticPackage(NULL, "Togl", Togl_Init, NULL);
}
#endif
#ifdef WITH_XXX
#endif
return TCL_OK;
}
int
Tcl_AppInit(
Tcl_Interp *interp) /* Interpreter for application. */
{
if (Tcl_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
#ifdef TCL_TEST
if (Tcltest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init,
(Tcl_PackageInitProc *) NULL);
if (TclObjTest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
#endif /* TCL_TEST */
/*
* Call the init procedures for included packages. Each call should
* look like this:
*
* if (Mod_Init(interp) == TCL_ERROR) {
* return TCL_ERROR;
* }
*
* where "Mod" is the name of the module.
*/
if (Itcl_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Itcl", Itcl_Init, Itcl_SafeInit);
/*
* This is itclsh, so import all [incr Tcl] commands by
* default into the global namespace. Fix up the autoloader
* to do the same.
*/
if (Tcl_Import(interp, Tcl_GetGlobalNamespace(interp),
"::itcl::*", /* allowOverwrite */ 1) != TCL_OK) {
return TCL_ERROR;
}
if (Tcl_Eval(interp, "auto_mkindex_parser::slavehook { _%@namespace import -force ::itcl::* }") != TCL_OK) {
return TCL_ERROR;
}
/*
* Call Tcl_CreateCommand for application-specific commands, if
* they weren't already created by the init procedures called above.
* Each call would loo like this:
*
* Tcl_CreateCommand(interp, "tclName", CFuncCmd, NULL, NULL);
*/
/*
* Specify a user-specific startup script to invoke if the application
* is run interactively. On the Mac we can specifiy either a TEXT resource
* which contains the script or the more UNIX like file location
* may also used. (I highly recommend using the resource method.)
*/
Tcl_SetVar(interp, "tcl_rcRsrcName", "itclshrc", TCL_GLOBAL_ONLY);
/* Tcl_SetVar(interp, "tcl_rcFileName", "~/.itclshrc", TCL_GLOBAL_ONLY); */
return TCL_OK;
}
int
Tcl_AppInit(
Tcl_Interp *interp) /* Interpreter for application. */
{
Tcl_Channel tempChan;
if (Tcl_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
#ifdef TCL_TEST
if (Tcltest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init,
(Tcl_PackageInitProc *) NULL);
if (TclObjTest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
#endif /* TCL_TEST */
/*
* Call the init procedures for included packages. Each call should
* look like this:
*
* if (Mod_Init(interp) == TCL_ERROR) {
* return TCL_ERROR;
* }
*
* where "Mod" is the name of the module.
*/
/*
* Call Tcl_CreateCommand for application-specific commands, if
* they weren't already created by the init procedures called above.
* Each call would loo like this:
*
* Tcl_CreateCommand(interp, "tclName", CFuncCmd, NULL, NULL);
*/
/*
* Specify a user-specific startup script to invoke if the application
* is run interactively. On the Mac we can specifiy either a TEXT resource
* which contains the script or the more UNIX like file location
* may also used. (I highly recommend using the resource method.)
*/
Tcl_SetVar(interp, "tcl_rcRsrcName", "tclshrc", TCL_GLOBAL_ONLY);
/* Tcl_SetVar(interp, "tcl_rcFileName", "~/.tclshrc", TCL_GLOBAL_ONLY); */
/*
* We have to support at least the quit Apple Event.
*/
TkMacInitAppleEvents(interp);
/*
* Open a file channel to put stderr, stdin, stdout...
*/
tempChan = Tcl_OpenFileChannel(interp, ":temp.in", "a+", 0);
Tcl_SetStdChannel(tempChan,TCL_STDIN);
Tcl_RegisterChannel(interp, tempChan);
Tcl_SetChannelOption(NULL, tempChan, "-translation", "cr");
Tcl_SetChannelOption(NULL, tempChan, "-buffering", "line");
tempChan = Tcl_OpenFileChannel(interp, ":temp.out", "a+", 0);
Tcl_SetStdChannel(tempChan,TCL_STDOUT);
Tcl_RegisterChannel(interp, tempChan);
Tcl_SetChannelOption(NULL, tempChan, "-translation", "cr");
Tcl_SetChannelOption(NULL, tempChan, "-buffering", "line");
tempChan = Tcl_OpenFileChannel(interp, ":temp.err", "a+", 0);
Tcl_SetStdChannel(tempChan,TCL_STDERR);
Tcl_RegisterChannel(interp, tempChan);
Tcl_SetChannelOption(NULL, tempChan, "-translation", "cr");
Tcl_SetChannelOption(NULL, tempChan, "-buffering", "none");
return TCL_OK;
}
int Ng_SetOCCVisParameters (ClientData clientData,
Tcl_Interp * interp,
int argc, tcl_const char *argv[])
{
#ifdef OCCGEOMETRY
int showvolume;
OCCGeometry * occgeometry = dynamic_cast<OCCGeometry*> (ng_geometry.Ptr());
showvolume = atoi (Tcl_GetVar (interp, "::occoptions.showvolumenr", 0));
if (occgeometry)
if (showvolume != vispar.occshowvolumenr)
{
if (showvolume < 0 || showvolume > occgeometry->NrSolids())
{
char buf[20];
sprintf (buf, "%5i", vispar.occshowvolumenr);
Tcl_SetVar (interp, "::occoptions.showvolumenr", buf, 0);
}
else
{
vispar.occshowvolumenr = showvolume;
if (occgeometry)
occgeometry -> changed = OCCGEOMETRYVISUALIZATIONHALFCHANGE;
}
}
int temp;
temp = atoi (Tcl_GetVar (interp, "::occoptions.visproblemfaces", 0));
if ((bool) temp != vispar.occvisproblemfaces)
{
vispar.occvisproblemfaces = temp;
if (occgeometry)
occgeometry -> changed = OCCGEOMETRYVISUALIZATIONHALFCHANGE;
}
vispar.occshowsurfaces = atoi (Tcl_GetVar (interp, "::occoptions.showsurfaces", 0));
vispar.occshowedges = atoi (Tcl_GetVar (interp, "::occoptions.showedges", 0));
vispar.occzoomtohighlightedentity = atoi (Tcl_GetVar (interp, "::occoptions.zoomtohighlightedentity", 0));
vispar.occdeflection = pow(10.0,-1-atof (Tcl_GetVar (interp, "::occoptions.deflection", 0)));
#endif
#ifdef ACIS
vispar.ACISshowfaces = atoi (Tcl_GetVar (interp, "::occoptions.showsurfaces", 0));
vispar.ACISshowedges = atoi (Tcl_GetVar (interp, "::occoptions.showedges", 0));
vispar.ACISshowsolidnr = atoi (Tcl_GetVar (interp, "::occoptions.showsolidnr", 0));
vispar.ACISshowsolidnr2 = atoi (Tcl_GetVar (interp, "::occoptions.showsolidnr2", 0));
#endif
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;
}
static int
Initialize (
Tcl_Interp *interp)
{
Tcl_Namespace *nsPtr;
ItclObjectInfo *infoPtr;
if (Tcl_InitStubs(interp, "8.6", 0) == NULL) {
return TCL_ERROR;
}
if (Tk_InitStubs(interp, "8.6", 0) == NULL) {
return TCL_ERROR;
}
if (Itcl_InitStubs(interp, "4.0.0", 0) == NULL) {
return TCL_ERROR;
}
infoPtr = (ItclObjectInfo *)Tcl_GetAssocData(interp,
ITCL_INTERP_DATA, NULL);
nsPtr = Tcl_CreateNamespace(interp, "::itcl::widget", NULL, NULL);
if (nsPtr == NULL) {
Tcl_Panic("Itcl: cannot create namespace: \"%s\" \n", "::itcl::widget");
}
nsPtr = Tcl_CreateNamespace(interp, ITCL_WIDGETS_NAMESPACE, NULL, NULL);
if (nsPtr == NULL) {
Tcl_Panic("Itcl: cannot create namespace: \"%s\" \n",
"::itcl::widget::internal");
}
#if 0 /* This doesn't compile ???? */
infoPtr->windgetInfoPtr = (ItclWidgetInfo *)ckalloc(sizeof(ItclWidgetInfo));
infoPtr->windgetInfoPtr->initObjectOpts = ItclWidgetInitObjectOptions;
infoPtr->windgetInfoPtr->hullAndOptsInst = HullAndOptionsInstall;
infoPtr->windgetInfoPtr->delegationInst = DelegationInstall;
infoPtr->windgetInfoPtr->componentInst = InstallComponent;
#endif
/*
* Create "itcl::builtin" namespace for commands that
* are automatically built into class definitions.
*/
if (Itcl_WidgetBiInit(interp, infoPtr) != TCL_OK) {
return TCL_ERROR;
}
if (ItclWidgetInfoInit(interp, infoPtr) != TCL_OK) {
return TCL_ERROR;
}
/*
* Set up the variables containing version info.
*/
Tcl_SetVar(interp, "::itcl::widget::version", ITCL_VERSION, TCL_NAMESPACE_ONLY);
Tcl_SetVar(interp, "::itcl::widget::patchLevel", ITCL_PATCH_LEVEL,
TCL_NAMESPACE_ONLY);
/*
* Package is now loaded.
*/
return Tcl_PkgProvide(interp, "itclwidget", ITCL_PATCH_LEVEL);
}
int
Tcl_AppInit(
Tcl_Interp *interp) /* Interpreter for application. */
{
if (Tcl_Init(interp) == TCL_ERROR) {
goto error;
}
if (Tk_Init(interp) == TCL_ERROR) {
goto error;
}
Tcl_StaticPackage(interp, "Tk", Tk_Init, Tk_SafeInit);
/*
* Initialize the console only if we are running as an interactive
* application.
*/
if (consoleRequired) {
if (Tk_CreateConsoleWindow(interp) == TCL_ERROR) {
goto error;
}
}
#if defined(STATIC_BUILD) && TCL_USE_STATIC_PACKAGES
{
extern Tcl_PackageInitProc Registry_Init;
extern Tcl_PackageInitProc Dde_Init;
if (Registry_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "registry", Registry_Init, NULL);
if (Dde_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "dde", Dde_Init, NULL);
}
#endif
#ifdef TK_TEST
if (Tktest_Init(interp) == TCL_ERROR) {
goto error;
}
Tcl_StaticPackage(interp, "Tktest", Tktest_Init, NULL);
#endif /* TK_TEST */
Tcl_SetVar(interp, "tcl_rcFileName", "~/wishrc.tcl", TCL_GLOBAL_ONLY);
return TCL_OK;
error:
MessageBeep(MB_ICONEXCLAMATION);
MessageBox(NULL, Tcl_GetStringResult(interp), "Error in Wish",
MB_ICONSTOP | MB_OK | MB_TASKMODAL | MB_SETFOREGROUND);
ExitProcess(1);
/*
* We won't reach this, but we need the return.
*/
return TCL_ERROR;
}
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 flow_demo_c (ClientData clientData, Tcl_Interp* interp, int argc, const char** argv)
{
int i, i_seq, nr, j,pft_version=3,num_points,dumy;
char name[128];
unsigned char *imgf;
Tk_PhotoHandle img_handle;
Tk_PhotoImageBlock img_block;
nr = atoi(argv[1]);
fpp = fopen_r ("parameters/sequence.par");
for (i=0; i<4; i++)
fscanf (fpp, "%s\n", seq_name[i]); /* name of sequence */
fscanf (fpp,"%d\n", &seq_first);
fscanf (fpp,"%d\n", &seq_last);
fclose (fpp);
/* allocate memory */
imgf = (unsigned char *) calloc (imgsize, 1);
fpp = fopen ("parameters/pft_version.par", "r");
if (fpp){
fscanf (fpp, "%d\n", &pft_version);
pft_version=pft_version+3;
fclose (fpp);
}
else{
fpp = fopen ("parameters/pft_version.par", "w");
fprintf(fpp,"%d\n", 0);
fclose(fpp);
}
/* load and display images */
for (i_seq=seq_first; i_seq<=seq_last; i_seq++){
compose_name_plus_nr (seq_name[nr], "", i_seq, name);
fp1 = fopen_r (name); if (! fp1) return TCL_OK;
sprintf (buf, "display camera %d, image %d", nr+1, i_seq);
Tcl_SetVar(interp, "tbuf", buf, TCL_GLOBAL_ONLY);
Tcl_Eval(interp, ".text delete 2");
Tcl_Eval(interp, ".text insert 2 $tbuf");
read_image (interp, name, imgf);
fclose (fp1);
img_handle = Tk_FindPhoto( interp, "temp");
Tk_PhotoGetImage (img_handle, &img_block);
sprintf(buf, "newimage %d", nr+1);
Tcl_Eval(interp, buf);
if(pft_version==4){
sprintf (filename, "%s%s", name,"_targets");
/* read targets of camera nr*/
nt4[3][nr]=0;
fp1= fopen (filename, "r");
if (! fp1) printf("Can't open ascii file: %s\n", filename);
fscanf (fp1, "%d\n", &nt4[3][nr]);
for (j=0; j<nt4[3][nr]; j++){
fscanf (fp1, "%4d %lf %lf %d %d %d %d %d\n",
&pix[nr][j].pnr, &pix[nr][j].x,
&pix[nr][j].y, &pix[nr][j].n ,
&pix[nr][j].nx ,&pix[nr][j].ny,
&pix[nr][j].sumg, &pix[nr][j].tnr);
}
fclose (fp1);
num[nr] = nt4[3][nr];
if (display){
for (j=0; j<num[nr]; j++){
drawcross (interp, (int) pix[nr][j].x, (int) pix[nr][j].y,cr_sz, nr, "blue");
}
printf ("drawing %d 2d ", num[nr]);
}
sprintf (filename, "res/rt_is.%d", i_seq);
fp1= fopen (filename, "r");
if (fp1){
fscanf (fp1, "%d\n", &num_points);
for (j=0; j<num_points; j++){
if (n_img==4){
fscanf(fp1, "%d %lf %lf %lf %d %d %d %d\n",
&dumy, &fix[j].x, &fix[j].y, &fix[j].z,
&geo[0][j].pnr, &geo[1][j].pnr, &geo[2][j].pnr, &geo[3][j].pnr);
}
if (n_img==3){
fscanf(fp1, "%d %lf %lf %lf %d %d %d %d\n",
&dumy, &fix[j].x, &fix[j].y, &fix[j].z,
&geo[0][j].pnr, &geo[1][j].pnr, &geo[2][j].pnr);
}
if (n_img==2){ // Alex's patch. 24.09.09. Working on Wesleyan data of 2 cameras only
fscanf(fp1, "%d %lf %lf %lf %d %d %d %d\n",
&dumy, &fix[j].x, &fix[j].y, &fix[j].z,
&geo[0][j].pnr, &geo[1][j].pnr);
}
}
fclose (fp1);
if (display){
for (j=0; j<num_points; j++){
img_coord (fix[j].x,fix[j].y,fix[j].z, Ex[nr], I[nr], G[nr], ap[nr], mmp, &pix[nr][j].x,&pix[nr][j].y);
metric_to_pixel (pix[nr][j].x,pix[nr][j].y, imx,imy, pix_x,pix_y, &pix[nr][j].x,&pix[nr][j].y, chfield);
//if(geo[nr][j].pnr>-1){
// drawcross (interp, (int) pix[nr][geo[nr][j].pnr].x, (int) pix[nr][geo[nr][j].pnr].y,cr_sz, nr, "yellow");
//}
drawcross (interp, (int) pix[nr][j].x, (int) pix[nr][j].y,cr_sz, nr, "red");
}
printf ("and %d corresponding 3d positions for frame %d\n", num_points,i_seq);
}
}
}
Tcl_Eval(interp, "update idletasks");
}
printf ("done\n\n");
free (imgf);
return TCL_OK;
}
void check_tcl_loadunld(const char *mod, tcl_bind_list_t *tl)
{
Tcl_SetVar(interp, "_lu1", (char *) mod, 0);
check_tcl_bind(tl, mod, 0, " $_lu1", MATCH_MASK | BIND_STACKABLE);
}
void check_tcl_disc(const char *bot)
{
Tcl_SetVar(interp, "_disc1", (char *) bot, 0);
check_tcl_bind(H_disc, bot, 0, " $_disc1", MATCH_MASK | BIND_STACKABLE);
}
int
Tcl_AppInit(
Tcl_Interp *interp) /* Interpreter for application. */
{
if (Tcl_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
#ifdef TCL_TEST
if (Tcltest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init, NULL);
if (TclObjTest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
if (Procbodytest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "procbodytest", Procbodytest_Init,
Procbodytest_SafeInit);
#endif /* TCL_TEST */
#if defined(STATIC_BUILD) && TCL_USE_STATIC_PACKAGES
{
extern Tcl_PackageInitProc Registry_Init;
extern Tcl_PackageInitProc Dde_Init;
extern Tcl_PackageInitProc Dde_SafeInit;
if (Registry_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "registry", Registry_Init, NULL);
if (Dde_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "dde", Dde_Init, Dde_SafeInit);
}
#endif
/*
* Call the init functions for included packages. Each call should look
* like this:
*
* if (Mod_Init(interp) == TCL_ERROR) {
* return TCL_ERROR;
* }
*
* where "Mod" is the name of the module.
*/
/*
* Call Tcl_CreateCommand for application-specific commands, if they
* weren't already created by the init functions called above.
*/
/*
* Specify a user-specific startup file to invoke if the application is
* run interactively. Typically the startup file is "~/.apprc" where "app"
* is the name of the application. If this line is deleted then no
* user-specific startup file will be run under any conditions.
*/
Tcl_SetVar(interp, "tcl_rcFileName", "~/tclshrc.tcl", TCL_GLOBAL_ONLY);
return TCL_OK;
}
char *tcl::setGlobalVar(char *name, char *value)
{
return (char *) Tcl_SetVar(tcl_int, name, value, TCL_GLOBAL_ONLY);
}
void
Tcl_Main(
int argc, /* Number of arguments. */
char **argv, /* Array of argument strings. */
Tcl_AppInitProc *appInitProc)
/* Application-specific initialization
* function to call after most initialization
* but before starting to execute commands. */
{
Tcl_Obj *path, *resultPtr, *argvPtr, *commandPtr = NULL;
const char *encodingName = NULL;
PromptType prompt = PROMPT_START;
int code, length, tty, exitCode = 0;
Tcl_Channel inChannel, outChannel, errChannel;
Tcl_Interp *interp;
Tcl_DString appName;
Tcl_FindExecutable(argv[0]);
interp = Tcl_CreateInterp();
Tcl_InitMemory(interp);
/*
* If the application has not already set a startup script, parse the
* first few command line arguments to determine the script path and
* encoding.
*/
if (NULL == Tcl_GetStartupScript(NULL)) {
/*
* Check whether first 3 args (argv[1] - argv[3]) look like
* -encoding ENCODING FILENAME
* or like
* FILENAME
*/
if ((argc > 3) && (0 == strcmp("-encoding", argv[1]))
&& ('-' != argv[3][0])) {
Tcl_SetStartupScript(Tcl_NewStringObj(argv[3], -1), argv[2]);
argc -= 3;
argv += 3;
} else if ((argc > 1) && ('-' != argv[1][0])) {
Tcl_SetStartupScript(Tcl_NewStringObj(argv[1], -1), NULL);
argc--;
argv++;
}
}
path = Tcl_GetStartupScript(&encodingName);
if (path == NULL) {
Tcl_ExternalToUtfDString(NULL, argv[0], -1, &appName);
} else {
const char *pathName = Tcl_GetStringFromObj(path, &length);
Tcl_ExternalToUtfDString(NULL, pathName, length, &appName);
path = Tcl_NewStringObj(Tcl_DStringValue(&appName), -1);
Tcl_SetStartupScript(path, encodingName);
}
Tcl_SetVar(interp, "argv0", Tcl_DStringValue(&appName), TCL_GLOBAL_ONLY);
Tcl_DStringFree(&appName);
argc--;
argv++;
Tcl_SetVar2Ex(interp, "argc", NULL, Tcl_NewIntObj(argc), TCL_GLOBAL_ONLY);
argvPtr = Tcl_NewListObj(0, NULL);
while (argc--) {
Tcl_DString ds;
Tcl_ExternalToUtfDString(NULL, *argv++, -1, &ds);
Tcl_ListObjAppendElement(NULL, argvPtr, Tcl_NewStringObj(
Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)));
Tcl_DStringFree(&ds);
}
Tcl_SetVar2Ex(interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY);
/*
* Set the "tcl_interactive" variable.
*/
tty = isatty(0);
Tcl_SetVar(interp, "tcl_interactive", ((path == NULL) && tty) ? "1" : "0",
TCL_GLOBAL_ONLY);
/*
* Invoke application-specific initialization.
*/
Tcl_Preserve(interp);
if (appInitProc(interp) != TCL_OK) {
errChannel = Tcl_GetStdChannel(TCL_STDERR);
if (errChannel) {
Tcl_WriteChars(errChannel,
"application-specific initialization failed: ", -1);
Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
Tcl_WriteChars(errChannel, "\n", 1);
}
}
if (Tcl_InterpDeleted(interp)) {
goto done;
}
if (Tcl_LimitExceeded(interp)) {
goto done;
}
/*
* If a script file was specified then just source that file and quit.
* Must fetch it again, as the appInitProc might have reset it.
*/
path = Tcl_GetStartupScript(&encodingName);
if (path != NULL) {
code = Tcl_FSEvalFileEx(interp, path, encodingName);
if (code != TCL_OK) {
errChannel = Tcl_GetStdChannel(TCL_STDERR);
if (errChannel) {
Tcl_Obj *options = Tcl_GetReturnOptions(interp, code);
Tcl_Obj *keyPtr, *valuePtr;
TclNewLiteralStringObj(keyPtr, "-errorinfo");
Tcl_IncrRefCount(keyPtr);
Tcl_DictObjGet(NULL, options, keyPtr, &valuePtr);
Tcl_DecrRefCount(keyPtr);
if (valuePtr) {
Tcl_WriteObj(errChannel, valuePtr);
}
Tcl_WriteChars(errChannel, "\n", 1);
}
exitCode = 1;
}
goto done;
}
/*
* We're running interactively. Source a user-specific startup file if the
* application specified one and if the file exists.
*/
Tcl_SourceRCFile(interp);
if (Tcl_LimitExceeded(interp)) {
goto done;
}
/*
* Process commands from stdin until there's an end-of-file. Note that we
* need to fetch the standard channels again after every eval, since they
* may have been changed.
*/
commandPtr = Tcl_NewObj();
Tcl_IncrRefCount(commandPtr);
/*
* Get a new value for tty if anyone writes to ::tcl_interactive
*/
Tcl_LinkVar(interp, "tcl_interactive", (char *) &tty, TCL_LINK_BOOLEAN);
inChannel = Tcl_GetStdChannel(TCL_STDIN);
outChannel = Tcl_GetStdChannel(TCL_STDOUT);
while ((inChannel != NULL) && !Tcl_InterpDeleted(interp)) {
if (mainLoopProc == NULL) {
if (tty) {
Prompt(interp, &prompt);
if (Tcl_InterpDeleted(interp)) {
break;
}
if (Tcl_LimitExceeded(interp)) {
break;
}
inChannel = Tcl_GetStdChannel(TCL_STDIN);
if (inChannel == NULL) {
break;
}
}
if (Tcl_IsShared(commandPtr)) {
Tcl_DecrRefCount(commandPtr);
commandPtr = Tcl_DuplicateObj(commandPtr);
Tcl_IncrRefCount(commandPtr);
}
length = Tcl_GetsObj(inChannel, commandPtr);
if (length < 0) {
if (Tcl_InputBlocked(inChannel)) {
/*
* This can only happen if stdin has been set to
* non-blocking. In that case cycle back and try again.
* This sets up a tight polling loop (since we have no
* event loop running). If this causes bad CPU hogging, we
* might try toggling the blocking on stdin instead.
*/
continue;
}
/*
* Either EOF, or an error on stdin; we're done
*/
break;
}
/*
* Add the newline removed by Tcl_GetsObj back to the string. Have
* to add it back before testing completeness, because it can make
* a difference. [Bug 1775878]
*/
if (Tcl_IsShared(commandPtr)) {
Tcl_DecrRefCount(commandPtr);
commandPtr = Tcl_DuplicateObj(commandPtr);
Tcl_IncrRefCount(commandPtr);
}
Tcl_AppendToObj(commandPtr, "\n", 1);
if (!TclObjCommandComplete(commandPtr)) {
prompt = PROMPT_CONTINUE;
continue;
}
prompt = PROMPT_START;
/*
* The final newline is syntactically redundant, and causes some
* error messages troubles deeper in, so lop it back off.
*/
Tcl_GetStringFromObj(commandPtr, &length);
Tcl_SetObjLength(commandPtr, --length);
code = Tcl_RecordAndEvalObj(interp, commandPtr, TCL_EVAL_GLOBAL);
inChannel = Tcl_GetStdChannel(TCL_STDIN);
outChannel = Tcl_GetStdChannel(TCL_STDOUT);
errChannel = Tcl_GetStdChannel(TCL_STDERR);
Tcl_DecrRefCount(commandPtr);
commandPtr = Tcl_NewObj();
Tcl_IncrRefCount(commandPtr);
if (code != TCL_OK) {
if (errChannel) {
Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
Tcl_WriteChars(errChannel, "\n", 1);
}
} else if (tty) {
resultPtr = Tcl_GetObjResult(interp);
Tcl_IncrRefCount(resultPtr);
Tcl_GetStringFromObj(resultPtr, &length);
if ((length > 0) && outChannel) {
Tcl_WriteObj(outChannel, resultPtr);
Tcl_WriteChars(outChannel, "\n", 1);
}
Tcl_DecrRefCount(resultPtr);
}
} else { /* (mainLoopProc != NULL) */
/*
* If a main loop has been defined while running interactively, we
* want to start a fileevent based prompt by establishing a
* channel handler for stdin.
*/
InteractiveState *isPtr = NULL;
if (inChannel) {
if (tty) {
Prompt(interp, &prompt);
}
isPtr = (InteractiveState *)
ckalloc(sizeof(InteractiveState));
isPtr->input = inChannel;
isPtr->tty = tty;
isPtr->commandPtr = commandPtr;
isPtr->prompt = prompt;
isPtr->interp = interp;
Tcl_UnlinkVar(interp, "tcl_interactive");
Tcl_LinkVar(interp, "tcl_interactive", (char *) &(isPtr->tty),
TCL_LINK_BOOLEAN);
Tcl_CreateChannelHandler(inChannel, TCL_READABLE, StdinProc,
isPtr);
}
mainLoopProc();
mainLoopProc = NULL;
if (inChannel) {
tty = isPtr->tty;
Tcl_UnlinkVar(interp, "tcl_interactive");
Tcl_LinkVar(interp, "tcl_interactive", (char *) &tty,
TCL_LINK_BOOLEAN);
prompt = isPtr->prompt;
commandPtr = isPtr->commandPtr;
if (isPtr->input != NULL) {
Tcl_DeleteChannelHandler(isPtr->input, StdinProc, isPtr);
}
ckfree((char *) isPtr);
}
inChannel = Tcl_GetStdChannel(TCL_STDIN);
outChannel = Tcl_GetStdChannel(TCL_STDOUT);
errChannel = Tcl_GetStdChannel(TCL_STDERR);
}
#ifdef TCL_MEM_DEBUG
/*
* This code here only for the (unsupported and deprecated) [checkmem]
* command.
*/
if (tclMemDumpFileName != NULL) {
mainLoopProc = NULL;
Tcl_DeleteInterp(interp);
}
#endif
}
done:
if ((exitCode == 0) && (mainLoopProc != NULL)
&& !Tcl_LimitExceeded(interp)) {
/*
* If everything has gone OK so far, call the main loop proc, if it
* exists. Packages (like Tk) can set it to start processing events at
* this point.
*/
mainLoopProc();
mainLoopProc = NULL;
}
if (commandPtr != NULL) {
Tcl_DecrRefCount(commandPtr);
}
/*
* Rather than calling exit, invoke the "exit" command so that users can
* replace "exit" with some other command to do additional cleanup on
* exit. The Tcl_EvalObjEx call should never return.
*/
if (!Tcl_InterpDeleted(interp)) {
if (!Tcl_LimitExceeded(interp)) {
Tcl_Obj *cmd = Tcl_ObjPrintf("exit %d", exitCode);
Tcl_IncrRefCount(cmd);
Tcl_EvalObjEx(interp, cmd, TCL_EVAL_GLOBAL);
Tcl_DecrRefCount(cmd);
}
/*
* If Tcl_EvalObjEx returns, trying to eval [exit], something unusual
* is happening. Maybe interp has been deleted; maybe [exit] was
* redefined, maybe we've blown up because of an exceeded limit. We
* still want to cleanup and exit.
*/
if (!Tcl_InterpDeleted(interp)) {
Tcl_DeleteInterp(interp);
}
}
Tcl_SetStartupScript(NULL, NULL);
/*
* If we get here, the master interp has been deleted. Allow its
* destruction with the last matching Tcl_Release.
*/
Tcl_Release(interp);
Tcl_Exit(exitCode);
}
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;
}
int Ng_OCCCommand (ClientData clientData,
Tcl_Interp * interp,
int argc, tcl_const char *argv[])
{
#ifdef OCCGEOMETRY
OCCGeometry * occgeometry = dynamic_cast<OCCGeometry*> (ng_geometry.Ptr());
stringstream str;
if (argc >= 2)
{
if (strcmp (argv[1], "isoccgeometryloaded") == 0)
{
if (occgeometry)
str << "1 " << flush;
else str << "0 " << flush;
Tcl_SetResult (interp, (char*)str.str().c_str(), TCL_VOLATILE);
}
if (occgeometry)
{
if (strcmp (argv[1], "buildvisualizationmesh") == 0)
{
occgeometry->BuildVisualizationMesh(vispar.occdeflection);
occgeometry->changed = OCCGEOMETRYVISUALIZATIONHALFCHANGE;
}
if (strcmp (argv[1], "mesherror") == 0)
{
if (occgeometry->ErrorInSurfaceMeshing())
str << 1;
else
str << 0;
}
if (strcmp (argv[1], "sewfaces") == 0)
{
cout << "Before operation:" << endl;
occgeometry->PrintNrShapes();
occgeometry->SewFaces();
occgeometry->BuildFMap();
cout << endl << "After operation:" << endl;
occgeometry->PrintNrShapes();
occgeometry->BuildVisualizationMesh(vispar.occdeflection);
occgeometry->changed = OCCGEOMETRYVISUALIZATIONHALFCHANGE;
}
if (strcmp (argv[1], "makesolid") == 0)
{
cout << "Before operation:" << endl;
occgeometry->PrintNrShapes();
occgeometry->MakeSolid();
occgeometry->BuildFMap();
cout << endl << "After operation:" << endl;
occgeometry->PrintNrShapes();
occgeometry->BuildVisualizationMesh(vispar.occdeflection);
occgeometry->changed = OCCGEOMETRYVISUALIZATIONHALFCHANGE;
}
if (strcmp (argv[1], "upgradetopology") == 0)
{
cout << "Before operation:" << endl;
occgeometry->PrintNrShapes();
occgeometry->SewFaces();
occgeometry->MakeSolid();
occgeometry->BuildFMap();
cout << endl << "After operation:" << endl;
occgeometry->PrintNrShapes();
occgeometry->BuildVisualizationMesh(vispar.occdeflection);
occgeometry->changed = OCCGEOMETRYVISUALIZATIONHALFCHANGE;
}
if (strcmp (argv[1], "shapehealing") == 0)
{
occgeometry->tolerance =
atof (Tcl_GetVar (interp, "::occoptions.tolerance", 0));
occgeometry->fixsmalledges =
atoi (Tcl_GetVar (interp, "::occoptions.fixsmalledges", 0));
occgeometry->fixspotstripfaces =
atoi (Tcl_GetVar (interp, "::occoptions.fixspotstripfaces", 0));
occgeometry->sewfaces =
atoi (Tcl_GetVar (interp, "::occoptions.sewfaces", 0));
occgeometry->makesolids =
atoi (Tcl_GetVar (interp, "::occoptions.makesolids", 0));
occgeometry->splitpartitions =
atoi (Tcl_GetVar (interp, "::occoptions.splitpartitions", 0));
// cout << "Before operation:" << endl;
// occgeometry->PrintNrShapes();
occgeometry->HealGeometry();
occgeometry->BuildFMap();
// cout << endl << "After operation:" << endl;
// occgeometry->PrintNrShapes();
occgeometry->BuildVisualizationMesh(vispar.occdeflection);
occgeometry->changed = OCCGEOMETRYVISUALIZATIONHALFCHANGE;
}
if (strcmp (argv[1], "highlightentity") == 0)
{
if (strcmp (argv[2], "Face") == 0)
{
int nr = atoi (argv[3]);
occgeometry->LowLightAll();
occgeometry->fvispar[nr-1].Highlight();
if (vispar.occzoomtohighlightedentity)
occgeometry->changed = OCCGEOMETRYVISUALIZATIONFULLCHANGE;
else
occgeometry->changed = OCCGEOMETRYVISUALIZATIONHALFCHANGE;
}
if (strcmp (argv[2], "Shell") == 0)
{
int nr = atoi (argv[3]);
occgeometry->LowLightAll();
TopExp_Explorer exp;
for (exp.Init (occgeometry->shmap(nr), TopAbs_FACE);
exp.More(); exp.Next())
{
int i = occgeometry->fmap.FindIndex (TopoDS::Face(exp.Current()));
occgeometry->fvispar[i-1].Highlight();
}
if (vispar.occzoomtohighlightedentity)
occgeometry->changed = OCCGEOMETRYVISUALIZATIONFULLCHANGE;
else
occgeometry->changed = OCCGEOMETRYVISUALIZATIONHALFCHANGE;
}
if (strcmp (argv[2], "Solid") == 0)
{
int nr = atoi (argv[3]);
occgeometry->LowLightAll();
TopExp_Explorer exp;
for (exp.Init (occgeometry->somap(nr), TopAbs_FACE);
exp.More(); exp.Next())
{
int i = occgeometry->fmap.FindIndex (TopoDS::Face(exp.Current()));
occgeometry->fvispar[i-1].Highlight();
}
if (vispar.occzoomtohighlightedentity)
occgeometry->changed = OCCGEOMETRYVISUALIZATIONFULLCHANGE;
else
occgeometry->changed = OCCGEOMETRYVISUALIZATIONHALFCHANGE;
}
/*
if (strcmp (argv[2], "CompSolid") == 0)
{
int nr = atoi (argv[3]);
occgeometry->LowLightAll();
TopExp_Explorer exp;
for (exp.Init (occgeometry->cmap(nr), TopAbs_FACE);
exp.More(); exp.Next())
{
int i = occgeometry->fmap.FindIndex (TopoDS::Face(exp.Current()));
occgeometry->fvispar[i-1].Highlight();
}
occgeometry->changed = OCCGEOMETRYVISUALIZATIONHALFCHANGE;
}
*/
if (strcmp (argv[2], "Edge") == 0)
{
int nr = atoi (argv[3]);
occgeometry->LowLightAll();
occgeometry->evispar[nr-1].Highlight();
if (vispar.occzoomtohighlightedentity)
occgeometry->changed = OCCGEOMETRYVISUALIZATIONFULLCHANGE;
else
occgeometry->changed = OCCGEOMETRYVISUALIZATIONHALFCHANGE;
}
if (strcmp (argv[2], "Wire") == 0)
{
int nr = atoi (argv[3]);
occgeometry->LowLightAll();
TopExp_Explorer exp;
for (exp.Init (occgeometry->wmap(nr), TopAbs_EDGE);
exp.More(); exp.Next())
{
int i = occgeometry->emap.FindIndex (TopoDS::Edge(exp.Current()));
occgeometry->evispar[i-1].Highlight();
}
if (vispar.occzoomtohighlightedentity)
occgeometry->changed = OCCGEOMETRYVISUALIZATIONFULLCHANGE;
else
occgeometry->changed = OCCGEOMETRYVISUALIZATIONHALFCHANGE;
}
if (strcmp (argv[2], "Vertex") == 0)
{
int nr = atoi (argv[3]);
occgeometry->LowLightAll();
occgeometry->vvispar[nr-1].Highlight();
if (vispar.occzoomtohighlightedentity)
occgeometry->changed = OCCGEOMETRYVISUALIZATIONFULLCHANGE;
else
occgeometry->changed = OCCGEOMETRYVISUALIZATIONHALFCHANGE;
}
}
if (strcmp (argv[1], "show") == 0)
{
int nr = atoi (argv[3]);
occgeometry->changed = OCCGEOMETRYVISUALIZATIONHALFCHANGE;
if (strcmp (argv[2], "Face") == 0)
{
occgeometry->fvispar[nr-1].Show();
}
if (strcmp (argv[2], "Shell") == 0)
{
TopExp_Explorer exp;
for (exp.Init (occgeometry->shmap(nr), TopAbs_FACE);
exp.More(); exp.Next())
{
int i = occgeometry->fmap.FindIndex (TopoDS::Face(exp.Current()));
occgeometry->fvispar[i-1].Show();
}
}
if (strcmp (argv[2], "Solid") == 0)
{
TopExp_Explorer exp;
for (exp.Init (occgeometry->somap(nr), TopAbs_FACE);
exp.More(); exp.Next())
{
int i = occgeometry->fmap.FindIndex (TopoDS::Face(exp.Current()));
occgeometry->fvispar[i-1].Show();
}
}
if (strcmp (argv[2], "Edge") == 0)
{
occgeometry->evispar[nr-1].Show();
}
if (strcmp (argv[2], "Wire") == 0)
{
TopExp_Explorer exp;
for (exp.Init (occgeometry->wmap(nr), TopAbs_EDGE);
exp.More(); exp.Next())
{
int i = occgeometry->emap.FindIndex (TopoDS::Edge(exp.Current()));
occgeometry->evispar[i-1].Show();
}
}
}
if (strcmp (argv[1], "hide") == 0)
{
int nr = atoi (argv[3]);
occgeometry->changed = OCCGEOMETRYVISUALIZATIONHALFCHANGE;
if (strcmp (argv[2], "Face") == 0)
{
occgeometry->fvispar[nr-1].Hide();
}
if (strcmp (argv[2], "Shell") == 0)
{
TopExp_Explorer exp;
for (exp.Init (occgeometry->shmap(nr), TopAbs_FACE);
exp.More(); exp.Next())
{
int i = occgeometry->fmap.FindIndex (TopoDS::Face(exp.Current()));
occgeometry->fvispar[i-1].Hide();
}
}
if (strcmp (argv[2], "Solid") == 0)
{
TopExp_Explorer exp;
for (exp.Init (occgeometry->somap(nr), TopAbs_FACE);
exp.More(); exp.Next())
{
int i = occgeometry->fmap.FindIndex (TopoDS::Face(exp.Current()));
occgeometry->fvispar[i-1].Hide();
}
}
if (strcmp (argv[2], "Edge") == 0)
{
occgeometry->evispar[nr-1].Hide();
}
if (strcmp (argv[2], "Wire") == 0)
{
TopExp_Explorer exp;
for (exp.Init (occgeometry->wmap(nr), TopAbs_EDGE);
exp.More(); exp.Next())
{
int i = occgeometry->emap.FindIndex (TopoDS::Edge(exp.Current()));
occgeometry->evispar[i-1].Hide();
}
}
}
if (strcmp (argv[1], "findsmallentities") == 0)
{
stringstream str("");
occgeometry->CheckIrregularEntities(str);
Tcl_SetResult (interp, (char*)str.str().c_str(), TCL_VOLATILE);
}
if (strcmp (argv[1], "getunmeshedfaceinfo") == 0)
{
occgeometry->GetUnmeshedFaceInfo(str);
Tcl_SetResult (interp, (char*)str.str().c_str(), TCL_VOLATILE);
}
if (strcmp (argv[1], "getnotdrawablefaces") == 0)
{
occgeometry->GetNotDrawableFaces(str);
Tcl_SetResult (interp, (char*)str.str().c_str(), TCL_VOLATILE);
}
if (strcmp (argv[1], "redrawstatus") == 0)
{
int i = atoi (argv[2]);
occgeometry->changed = i;
}
if (strcmp (argv[1], "swaporientation") == 0)
{
IGESControl_Writer writer("millimeters", 1);
writer.AddShape (occgeometry->shape);
writer.Write ("1.igs");
/*
int nr = atoi (argv[3]);
// const_cast<TopoDS_Shape&> (occgeometry->fmap(nr)).Reverse();
Handle_ShapeBuild_ReShape rebuild = new ShapeBuild_ReShape;
rebuild->Apply(occgeometry->shape);
TopoDS_Shape sh;
// if (strcmp (argv[2], "CompSolid") == 0) sh = occgeometry->cmap(nr);
if (strcmp (argv[2], "Solid") == 0) sh = occgeometry->somap(nr);
if (strcmp (argv[2], "Shell") == 0) sh = occgeometry->shmap(nr);
if (strcmp (argv[2], "Face") == 0) sh = occgeometry->fmap(nr);
if (strcmp (argv[2], "Wire") == 0) sh = occgeometry->wmap(nr);
if (strcmp (argv[2], "Edge") == 0) sh = occgeometry->emap(nr);
rebuild->Replace(sh, sh.Reversed(), Standard_False);
TopoDS_Shape newshape = rebuild->Apply(occgeometry->shape, TopAbs_SHELL, 1);
occgeometry->shape = newshape;
occgeometry->BuildFMap();
occgeometry->BuildVisualizationMesh();
occgeometry->changed = OCCGEOMETRYVISUALIZATIONHALFCHANGE;
*/
}
if (strcmp (argv[1], "marksingular") == 0)
{
int nr = atoi (argv[3]);
cout << "marking " << argv[2] << " " << nr << endl;
char buf[2]; buf[0] = '0'; buf[1] = 0;
bool sing = false;
if (strcmp (argv[2], "Face") == 0)
sing = occgeometry->fsingular[nr-1] = !occgeometry->fsingular[nr-1];
if (strcmp (argv[2], "Edge") == 0)
sing = occgeometry->esingular[nr-1] = !occgeometry->esingular[nr-1];
if (strcmp (argv[2], "Vertex") == 0)
sing = occgeometry->vsingular[nr-1] = !occgeometry->vsingular[nr-1];
if (sing) buf[0] = '1';
Tcl_SetVar (interp, "::ismarkedsingular", buf, 0);
stringstream str;
occgeometry->GetTopologyTree (str);
char* cstr = (char*)str.str().c_str();
(*testout) << cstr << endl;
char helpstr[1000];
while (strchr (cstr, '}'))
{
strncpy (helpstr, cstr+2, strlen(strchr(cstr+2, '}')));
(*testout) << "***" << cstr << "***" << endl;
cstr = strchr (cstr, '}');
}
}
}
}
#endif
return TCL_OK;
}
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;
}
// Philippose - 25/07/2010
// TCL interface function for extracting and eventually
// setting or editing the current colours present in the mesh
int Ng_CurrentFaceColours (ClientData clientData,
Tcl_Interp * interp,
int argc, tcl_const char *argv[])
{
if(argc < 1)
{
Tcl_SetResult (interp, (char *)"Ng_GetCurrentFaceColours needs arguments", TCL_STATIC);
return TCL_ERROR;
}
if(!mesh.Ptr())
{
Tcl_SetResult (interp, (char *)"Ng_GetCurrentFaceColours: Valid netgen mesh required...please mesh the Geometry first", TCL_STATIC);
return TCL_ERROR;
}
if(strcmp(argv[1], "getcolours") == 0)
{
stringstream outVar;
Array<Vec3d> face_colours;
GetFaceColours(*mesh, face_colours);
for(int i = 0; i < face_colours.Size();i++)
{
outVar << "{ " << face_colours[i].X(1)
<< " " << face_colours[i].X(2)
<< " " << face_colours[i].X(3)
<< " } ";
}
tcl_const char * valuevar = argv[2];
Tcl_SetVar (interp, valuevar, (char*)outVar.str().c_str(), 0);
}
if(strcmp(argv[1], "showalso") == 0)
{
Array<Vec3d> face_colours;
GetFaceColours(*mesh,face_colours);
int colourind = atoi (argv[2]);
for(int i = 1; i <= mesh->GetNFD(); i++)
{
Array<SurfaceElementIndex> surfElems;
mesh->GetSurfaceElementsOfFace(i,surfElems);
if(ColourMatch(face_colours[colourind],mesh->GetFaceDescriptor(i).SurfColour()))
{
for(int j = 0; j < surfElems.Size(); j++)
{
mesh->SurfaceElement(surfElems[j]).Visible(1);
}
}
}
mesh->SetNextTimeStamp();
}
if(strcmp(argv[1], "hidealso") == 0)
{
Array<Vec3d> face_colours;
GetFaceColours(*mesh,face_colours);
int colourind = atoi (argv[2]);
for(int i = 1; i <= mesh->GetNFD(); i++)
{
Array<SurfaceElementIndex> surfElems;
mesh->GetSurfaceElementsOfFace(i,surfElems);
if(ColourMatch(face_colours[colourind],mesh->GetFaceDescriptor(i).SurfColour()))
{
for(int j = 0; j < surfElems.Size(); j++)
{
mesh->SurfaceElement(surfElems[j]).Visible(0);
}
}
}
mesh->SetNextTimeStamp();
}
if(strcmp(argv[1], "showonly") == 0)
{
Array<Vec3d> face_colours;
GetFaceColours(*mesh,face_colours);
int colourind = atoi (argv[2]);
for(int i = 1; i <= mesh->GetNFD(); i++)
{
Array<SurfaceElementIndex> surfElems;
mesh->GetSurfaceElementsOfFace(i,surfElems);
if(ColourMatch(face_colours[colourind],mesh->GetFaceDescriptor(i).SurfColour()))
{
for(int j = 0; j < surfElems.Size(); j++)
{
mesh->SurfaceElement(surfElems[j]).Visible(1);
}
}
else
{
for(int j = 0; j < surfElems.Size(); j++)
{
mesh->SurfaceElement(surfElems[j]).Visible(0);
}
}
}
mesh->SetNextTimeStamp();
}
if(strcmp(argv[1], "hideonly") == 0)
{
Array<Vec3d> face_colours;
GetFaceColours(*mesh,face_colours);
int colourind = atoi (argv[2]);
for(int i = 1; i <= mesh->GetNFD(); i++)
{
Array<SurfaceElementIndex> surfElems;
mesh->GetSurfaceElementsOfFace(i,surfElems);
if(ColourMatch(face_colours[colourind],mesh->GetFaceDescriptor(i).SurfColour()))
{
for(int j = 0; j < surfElems.Size(); j++)
{
mesh->SurfaceElement(surfElems[j]).Visible(0);
}
}
else
{
for(int j = 0; j < surfElems.Size(); j++)
{
mesh->SurfaceElement(surfElems[j]).Visible(1);
}
}
}
mesh->SetNextTimeStamp();
}
if(strcmp(argv[1], "showall") == 0)
{
for(int i = 1; i <= mesh->GetNSE(); i++)
{
mesh->SurfaceElement(i).Visible(1);
}
mesh->SetNextTimeStamp();
}
if(strcmp(argv[1], "hideall") == 0)
{
for(int i = 1; i <= mesh->GetNSE(); i++)
{
mesh->SurfaceElement(i).Visible(0);
}
mesh->SetNextTimeStamp();
}
return TCL_OK;
}
/*
** Called for each row of the result.
**
** This version is used when TCL expects UTF-8 data but the database
** uses the ISO8859 format. A translation must occur from ISO8859 into
** UTF-8.
*/
static int DbEvalCallback(
void *clientData, /* An instance of CallbackData */
int nCol, /* Number of columns in the result */
char ** azCol, /* Data for each column */
char ** azN /* Name for each column */
){
CallbackData *cbData = (CallbackData*)clientData;
int i, rc;
Tcl_DString dCol;
Tcl_DStringInit(&dCol);
if( cbData->azColName==0 ){
assert( cbData->once );
cbData->once = 0;
if( cbData->zArray[0] ){
Tcl_SetVar2(cbData->interp, cbData->zArray, "*", "", 0);
}
cbData->azColName = malloc( nCol*sizeof(char*) );
if( cbData->azColName==0 ){ return 1; }
cbData->nColName = nCol;
for(i=0; i<nCol; i++){
Tcl_ExternalToUtfDString(NULL, azN[i], -1, &dCol);
cbData->azColName[i] = malloc( Tcl_DStringLength(&dCol) + 1 );
if( cbData->azColName[i] ){
strcpy(cbData->azColName[i], Tcl_DStringValue(&dCol));
}else{
return 1;
}
if( cbData->zArray[0] ){
Tcl_SetVar2(cbData->interp, cbData->zArray, "*",
Tcl_DStringValue(&dCol), TCL_LIST_ELEMENT|TCL_APPEND_VALUE);
if( azN[nCol]!=0 ){
Tcl_DString dType;
Tcl_DStringInit(&dType);
Tcl_DStringAppend(&dType, "typeof:", -1);
Tcl_DStringAppend(&dType, Tcl_DStringValue(&dCol), -1);
Tcl_DStringFree(&dCol);
Tcl_ExternalToUtfDString(NULL, azN[i+nCol], -1, &dCol);
Tcl_SetVar2(cbData->interp, cbData->zArray,
Tcl_DStringValue(&dType), Tcl_DStringValue(&dCol),
TCL_LIST_ELEMENT|TCL_APPEND_VALUE);
Tcl_DStringFree(&dType);
}
}
Tcl_DStringFree(&dCol);
}
}
if( azCol!=0 ){
if( cbData->zArray[0] ){
for(i=0; i<nCol; i++){
char *z = azCol[i];
if( z==0 ) z = "";
Tcl_DStringInit(&dCol);
Tcl_ExternalToUtfDString(NULL, z, -1, &dCol);
Tcl_SetVar2(cbData->interp, cbData->zArray, cbData->azColName[i],
Tcl_DStringValue(&dCol), 0);
Tcl_DStringFree(&dCol);
}
}else{
for(i=0; i<nCol; i++){
char *z = azCol[i];
if( z==0 ) z = "";
Tcl_DStringInit(&dCol);
Tcl_ExternalToUtfDString(NULL, z, -1, &dCol);
Tcl_SetVar(cbData->interp, cbData->azColName[i],
Tcl_DStringValue(&dCol), 0);
Tcl_DStringFree(&dCol);
}
}
}
rc = Tcl_EvalObj(cbData->interp, cbData->pCode);
if( rc==TCL_CONTINUE ) rc = TCL_OK;
cbData->tcl_rc = rc;
return rc!=TCL_OK;
}
int
TkpInit(
Tcl_Interp *interp) /* Interp to initialize. */
{
char *libDir, *tempPath;
Tcl_DString path;
int result;
/*
* The following does not work with
* safe interps because file exists is restricted.
* to be fixed using [interp issafe] like in Unix & Windows.
*/
static char initCmd[] = "\
proc sourcePath {file} {\n\
global tk_library\n\
if {[catch {uplevel #0 [list source $tk_library:$file.tcl]}] == 0} {\n\
return\n\
}\n\
if {[catch {uplevel #0 [list source -rsrc $file]}] == 0} {\n\
return\n\
}\n\
rename sourcePath {}\n\
set msg \"can't find $file resource or a usable $file.tcl file\"\n\
append msg \" perhaps you need to install Tk or set your \"\n\
append msg \"TK_LIBRARY environment variable?\"\n\
error $msg\n\
}\n\
sourcePath tk\n\
sourcePath button\n\
sourcePath dialog\n\
sourcePath entry\n\
sourcePath focus\n\
sourcePath listbox\n\
sourcePath menu\n\
sourcePath optMenu\n\
sourcePath palette\n\
sourcePath scale\n\
sourcePath scrlbar\n\
sourcePath tearoff\n\
sourcePath text\n\
sourcePath bgerror\n\
sourcePath msgbox\n\
sourcePath comdlg\n\
rename sourcePath {}";
Tcl_DStringInit(&path);
/*
* The tk_library path can be found in several places. Here is the order
* in which the are searched.
* 1) the variable may already exist
* 2) env array
* 3) System Folder:Extensions:Tool Command Language:
*/
libDir = Tcl_GetVar(interp, "tk_library", TCL_GLOBAL_ONLY);
if (libDir == NULL) {
libDir = Tcl_GetVar2(interp, "env", "TK_LIBRARY", TCL_GLOBAL_ONLY);
}
if (libDir == NULL) {
tempPath = Tcl_GetVar2(interp, "env", "EXT_FOLDER", TCL_GLOBAL_ONLY);
if (tempPath != NULL) {
Tcl_DString libPath;
char *argv[3];
argv[0] = tempPath;
argv[1] = "Tool Command Language";
Tcl_DStringInit(&libPath);
Tcl_DStringAppend(&libPath, "tk", -1);
Tcl_DStringAppend(&libPath, TK_VERSION, -1);
argv[2] = libPath.string;
Tcl_JoinPath(3, argv, &path);
Tcl_DStringFree(&libPath);
libDir = path.string;
}
}
if (libDir == NULL) {
libDir = "no library";
}
/*
* Assign path to the global Tcl variable tcl_library.
*/
Tcl_SetVar(interp, "tk_library", libDir, TCL_GLOBAL_ONLY);
Tcl_DStringFree(&path);
result = Tcl_Eval(interp, initCmd);
return result;
}
/*
*----------------------------------------------------------------------
*
* TkpGetAppName --
*
* Retrieves the name of the current application from a platform
* specific location. On the Macintosh we look to see if the
* App Name is specified in a resource. If not, the application
* name is the root of the tail of the path contained in the tcl
* variable argv0.
*
* Results:
* Returns the application name in the given Tcl_DString.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
void
TkpGetAppName(
Tcl_Interp *interp, /* The main interpreter. */
Tcl_DString *namePtr) /* A previously initialized Tcl_DString. */
{
int argc;
char **argv = NULL, *name, *p;
Handle h = NULL;
h = GetNamedResource('STR ', "\pTk App Name");
if (h != NULL) {
HLock(h);
Tcl_DStringAppend(namePtr, (*h)+1, **h);
HUnlock(h);
ReleaseResource(h);
return;
}
name = Tcl_GetVar(interp, "argv0", TCL_GLOBAL_ONLY);
if (name != NULL) {
Tcl_SplitPath(name, &argc, &argv);
if (argc > 0) {
name = argv[argc-1];
p = strrchr(name, '.');
if (p != NULL) {
*p = '\0';
}
} else {
name = NULL;
}
}
if ((name == NULL) || (*name == 0)) {
name = "tk";
}
Tcl_DStringAppend(namePtr, name, -1);
if (argv != NULL) {
ckfree((char *)argv);
}
}
/*
*----------------------------------------------------------------------
*
* TkpDisplayWarning --
*
* This routines is called from Tk_Main to display warning
* messages that occur during startup.
*
* Results:
* None.
*
* Side effects:
* Displays a message box.
*
*----------------------------------------------------------------------
*/
void
TkpDisplayWarning(
char *msg, /* Message to be displayed. */
char *title) /* Title of warning. */
{
Tcl_DString ds;
Tcl_DStringInit(&ds);
Tcl_DStringAppend(&ds, title, -1);
Tcl_DStringAppend(&ds, ": ", -1);
Tcl_DStringAppend(&ds, msg, -1);
panic(Tcl_DStringValue(&ds));
Tcl_DStringFree(&ds);
}
void
ParadynTkGUI::chooseMetricsandResources(chooseMandRCBFunc cb,
pdvector<metric_focus_pair> * /* pairList */ )
{
// store record with unique id and callback function
UIMMsgTokenID++;
int newptr;
Tcl_HashEntry *entryPtr = Tcl_CreateHashEntry (&UIMMsgReplyTbl,
(char *)UIMMsgTokenID,
&newptr);
if (newptr == 0) {
showError(21, "");
thr_exit(0);
}
unsigned requestingThread = getRequestingThread();
// in theory, we can check here whether this (VISI-) thread already
// has an outstanding metric request. But for now, we let code in mets.tcl do this...
// pdstring commandStr = pdstring("winfo exists .metmenunew") + pdstring(requestingThread);
// myTclEval(interp, commandStr);
// int result;
// assert(TCL_OK == Tcl_GetBoolean(interp, Tcl_GetStringResult(interp), &result));
// if (result)
// return; // the window is already up for this thread!
UIMReplyRec *reply = new UIMReplyRec;
reply->tid = requestingThread;
reply->cb = (void *) cb;
Tcl_SetHashValue (entryPtr, reply);
if (!all_metrics_set_yet) {
pdvector<met_name_id> *all_mets = dataMgr->getAvailableMetInfo(true);
for (unsigned metlcv=0; metlcv < all_mets->size(); metlcv++) {
unsigned id = (*all_mets)[metlcv].id;
pdstring &name = (*all_mets)[metlcv].name;
all_metric_names[id] = name;
pdstring idString(id);
bool aflag;
aflag=(Tcl_SetVar2(interp, "metricNamesById",
const_cast<char*>(idString.c_str()),
const_cast<char*>(name.c_str()),
TCL_GLOBAL_ONLY) != NULL);
assert(aflag);
}
delete all_mets;
all_metrics_set_yet = true;
}
// Set metIndexes2Id via "temp"
(void)Tcl_UnsetVar(interp, "temp", 0);
// ignore result; temp may not have existed
pdvector<met_name_id> *curr_avail_mets_ptr = dataMgr->getAvailableMetInfo(false);
pdvector<met_name_id> &curr_avail_mets = *curr_avail_mets_ptr;
unsigned numAvailMets = curr_avail_mets.size();
assert( numAvailMets > 0 );
for (unsigned metlcv=0; metlcv < numAvailMets; metlcv++) {
pdstring metricIdStr = pdstring(curr_avail_mets[metlcv].id);
bool aflag;
aflag = (Tcl_SetVar(interp, "temp",
const_cast<char*>(metricIdStr.c_str()),
TCL_APPEND_VALUE | TCL_LIST_ELEMENT) != NULL);
assert(aflag);
}
delete curr_avail_mets_ptr;
pdstring tcommand("getMetsAndRes ");
tcommand += pdstring(UIMMsgTokenID);
tcommand += pdstring(" ") + pdstring(requestingThread);
tcommand += pdstring(" ") + pdstring(numAvailMets);
tcommand += pdstring(" $temp");
int retVal = Tcl_VarEval (interp, tcommand.c_str(), 0);
if (retVal == TCL_ERROR) {
uiMgr->showError (22, "");
cerr << Tcl_GetStringResult(interp) << endl;
thr_exit(0);
}
}
int UUTCLEXPORT UUTCLFUNC
Uu_Init (Tcl_Interp *interp)
{
char tmp[32];
/*
* Check whether we are already initialized
*/
if (uu_AlreadyInitialized++)
return TCL_OK;
/*
* Initialize decoding engine
*/
if (UUInitialize () != UURET_OK) {
Tcl_SetResult (interp, "Error initializing decoding engine", TCL_STATIC);
return TCL_ERROR;
}
/*
* register commands
*/
Tcl_CreateCommand (interp, "uu_Info", uutcl_Info, NULL, NULL);
Tcl_CreateCommand (interp, "uu_SetMessageProc",uutcl_SetMessageProc,
NULL, NULL);
Tcl_CreateCommand (interp, "uu_SetBusyProc", uutcl_SetBusyProc,NULL,NULL);
Tcl_CreateCommand (interp, "uu_GetProgressInfo",uutcl_GetProgressInfo,
NULL, NULL);
Tcl_CreateCommand (interp, "uu_GetListOfFiles",uutcl_GetListOfFiles,
NULL, NULL);
Tcl_CreateCommand (interp, "uu_LoadFile", uutcl_LoadFile, NULL, NULL);
Tcl_CreateCommand (interp, "uu_DecodeFile", uutcl_DecodeFile, NULL, NULL);
Tcl_CreateCommand (interp, "uu_GetTempFile", uutcl_GetTempFile,NULL,NULL);
Tcl_CreateCommand (interp, "uu_InfoFile", uutcl_InfoFile, NULL, NULL);
Tcl_CreateCommand (interp, "uu_ListFile", uutcl_ListFile, NULL, NULL);
Tcl_CreateCommand (interp, "uu_Rename", uutcl_Rename, NULL, NULL);
Tcl_CreateCommand (interp, "uu_CleanUp", uutcl_CleanUp, NULL, NULL);
Tcl_CreateCommand (interp, "uu_EncodeToFile", uutcl_EncodeToFile,NULL,NULL);
Tcl_CreateCommand (interp, "uu_EncodeToMail", uutcl_EncodeToMail,NULL,NULL);
Tcl_CreateCommand (interp, "uu_EncodeToNews", uutcl_EncodeToNews,NULL,NULL);
/*
* our message-handling function and busy callback
*/
theDMcbdata.interp = NULL;
theDMcbdata.tclproc[0] = '\0';
UUSetMsgCallback (&theDMcbdata, uutcl_DisplayMessage);
theBusycbdata.interp = NULL;
theBusycbdata.tclproc[0] = '\0';
UUSetBusyCallback (&theBusycbdata, uutcl_BusyCallback, 1000);
/*
* only set variables if they aren't set already
*/
sprintf (tmp, "%d", UUGetOption (UUOPT_FAST, NULL, NULL, 0));
if (Tcl_GetVar (interp, "OptionFast", TCL_GLOBAL_ONLY) == NULL)
Tcl_SetVar (interp, "OptionFast", tmp, TCL_GLOBAL_ONLY);
sprintf (tmp, "%d", UUGetOption (UUOPT_BRACKPOL, NULL, NULL, 0));
if (Tcl_GetVar (interp, "OptionBracket", TCL_GLOBAL_ONLY) == NULL)
Tcl_SetVar (interp, "OptionBracket", tmp, TCL_GLOBAL_ONLY);
sprintf (tmp, "%d", UUGetOption (UUOPT_DESPERATE, NULL, NULL, 0));
if (Tcl_GetVar (interp, "OptionDesperate", TCL_GLOBAL_ONLY) == NULL)
Tcl_SetVar (interp, "OptionDesperate", tmp, TCL_GLOBAL_ONLY);
sprintf (tmp, "%d", UUGetOption (UUOPT_DEBUG, NULL, NULL, 0));
if (Tcl_GetVar (interp, "OptionDebug", TCL_GLOBAL_ONLY) == NULL)
Tcl_SetVar (interp, "OptionDebug", tmp, TCL_GLOBAL_ONLY);
sprintf (tmp, "%d", UUGetOption (UUOPT_USETEXT, NULL, NULL, 0));
if (Tcl_GetVar (interp, "OptionUsetext", TCL_GLOBAL_ONLY) == NULL)
Tcl_SetVar (interp, "OptionUsetext", tmp, TCL_GLOBAL_ONLY);
return TCL_OK;
}
int Ng_TopLevel (ClientData clientData,
Tcl_Interp * interp,
int argc, tcl_const char *argv[])
{
CSGeometry * geometry = dynamic_cast<CSGeometry*> (ng_geometry.get());
if (!geometry)
{
Tcl_SetResult (interp, err_needscsgeometry, TCL_STATIC);
return TCL_ERROR;
}
int i;
/*
for (i = 0; i < argc; i++)
cout << argv[i] << ", ";
cout << endl;
*/
if (strcmp (argv[1], "getlist") == 0)
{
stringstream vst;
for (i = 0; i < geometry->GetNTopLevelObjects(); i++)
{
const Solid * sol;
const Surface * surf;
geometry->GetTopLevelObject (i, sol, surf);
if (!surf)
vst << "{ " << sol->Name() << " } ";
else
vst << "{ " << sol->Name() << " " << surf->Name() << " } ";
}
tcl_const char * valuevar = argv[2];
Tcl_SetVar (interp, valuevar, (char*)vst.str().c_str(), 0);
}
if (strcmp (argv[1], "set") == 0)
{
tcl_const char * solname = argv[2];
tcl_const char * surfname = argv[3];
Solid * sol = (Solid*)geometry->GetSolid (solname);
Surface * surf = (Surface*)geometry->GetSurface (surfname);
geometry->SetTopLevelObject (sol, surf);
}
if (strcmp (argv[1], "remove") == 0)
{
tcl_const char * solname = argv[2];
tcl_const char * surfname = argv[3];
Solid * sol = (Solid*)geometry->GetSolid (solname);
Surface * surf = (Surface*)geometry->GetSurface (surfname);
geometry->RemoveTopLevelObject (sol, surf);
}
if (strcmp (argv[1], "setprop") == 0)
{
tcl_const char * solname = argv[2];
tcl_const char * surfname = argv[3];
tcl_const char * propvar = argv[4];
Solid * sol = (Solid*)geometry->GetSolid (solname);
Surface * surf = (Surface*)geometry->GetSurface (surfname);
TopLevelObject * tlo = geometry->GetTopLevelObject (sol, surf);
if (!tlo) return TCL_OK;
char varname[50];
sprintf (varname, "%s(red)", propvar);
double red = atof (Tcl_GetVar (interp, varname, 0));
sprintf (varname, "%s(blue)", propvar);
double blue = atof (Tcl_GetVar (interp, varname, 0));
sprintf (varname, "%s(green)", propvar);
double green = atof (Tcl_GetVar (interp, varname, 0));
tlo -> SetRGB (red, green, blue);
sprintf (varname, "%s(visible)", propvar);
tlo -> SetVisible (bool(atoi (Tcl_GetVar (interp, varname, 0))));
sprintf (varname, "%s(transp)", propvar);
tlo -> SetTransparent (bool(atoi (Tcl_GetVar (interp, varname, 0))));
}
if (strcmp (argv[1], "getprop") == 0)
{
tcl_const char * solname = argv[2];
tcl_const char * surfname = argv[3];
tcl_const char * propvar = argv[4];
Solid * sol = (Solid*)geometry->GetSolid (solname);
Surface * surf = (Surface*)geometry->GetSurface (surfname);
TopLevelObject * tlo = geometry->GetTopLevelObject (sol, surf);
if (!tlo) return TCL_OK;
char varname[50], varval[10];
sprintf (varname, "%s(red)", propvar);
sprintf (varval, "%lf", tlo->GetRed());
Tcl_SetVar (interp, varname, varval, 0);
sprintf (varname, "%s(green)", propvar);
sprintf (varval, "%lf", tlo->GetGreen());
Tcl_SetVar (interp, varname, varval, 0);
sprintf (varname, "%s(blue)", propvar);
sprintf (varval, "%lf", tlo->GetBlue());
Tcl_SetVar (interp, varname, varval, 0);
sprintf (varname, "%s(visible)", propvar);
sprintf (varval, "%d", tlo->GetVisible());
Tcl_SetVar (interp, varname, varval, 0);
sprintf (varname, "%s(transp)", propvar);
sprintf (varval, "%d", tlo->GetTransparent());
Tcl_SetVar (interp, varname, varval, 0);
}
return TCL_OK;
}
void
TclpSetVariables(
Tcl_Interp *interp)
{
#ifndef NO_UNAME
struct utsname name;
#endif
int unameOK;
Tcl_DString ds;
#ifdef HAVE_COREFOUNDATION
char tclLibPath[MAXPATHLEN + 1];
#if MAC_OS_X_VERSION_MAX_ALLOWED > 1020
/*
* Set msgcat fallback locale to current CFLocale identifier.
*/
CFLocaleRef localeRef;
if (CFLocaleCopyCurrent != NULL && CFLocaleGetIdentifier != NULL &&
(localeRef = CFLocaleCopyCurrent())) {
CFStringRef locale = CFLocaleGetIdentifier(localeRef);
if (locale) {
char loc[256];
if (CFStringGetCString(locale, loc, 256, kCFStringEncodingUTF8)) {
if (!Tcl_CreateNamespace(interp, "::tcl::mac", NULL, NULL)) {
Tcl_ResetResult(interp);
}
Tcl_SetVar(interp, "::tcl::mac::locale", loc, TCL_GLOBAL_ONLY);
}
}
CFRelease(localeRef);
}
#endif /* MAC_OS_X_VERSION_MAX_ALLOWED > 1020 */
if (MacOSXGetLibraryPath(interp, MAXPATHLEN, tclLibPath) == TCL_OK) {
CONST char *str;
CFBundleRef bundleRef;
Tcl_SetVar(interp, "tclDefaultLibrary", tclLibPath, TCL_GLOBAL_ONLY);
Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath, TCL_GLOBAL_ONLY);
Tcl_SetVar(interp, "tcl_pkgPath", " ",
TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
str = TclGetEnv("DYLD_FRAMEWORK_PATH", &ds);
if ((str != NULL) && (str[0] != '\0')) {
char *p = Tcl_DStringValue(&ds);
/*
* Convert DYLD_FRAMEWORK_PATH from colon to space separated.
*/
do {
if (*p == ':') {
*p = ' ';
}
} while (*p++);
Tcl_SetVar(interp, "tcl_pkgPath", Tcl_DStringValue(&ds),
TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
Tcl_SetVar(interp, "tcl_pkgPath", " ",
TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
Tcl_DStringFree(&ds);
}
bundleRef = CFBundleGetMainBundle();
if (bundleRef) {
CFURLRef frameworksURL;
Tcl_StatBuf statBuf;
frameworksURL = CFBundleCopyPrivateFrameworksURL(bundleRef);
if (frameworksURL) {
if (CFURLGetFileSystemRepresentation(frameworksURL, TRUE,
(unsigned char*) tclLibPath, MAXPATHLEN) &&
! TclOSstat(tclLibPath, &statBuf) &&
S_ISDIR(statBuf.st_mode)) {
Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath,
TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
Tcl_SetVar(interp, "tcl_pkgPath", " ",
TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
}
CFRelease(frameworksURL);
}
frameworksURL = CFBundleCopySharedFrameworksURL(bundleRef);
if (frameworksURL) {
if (CFURLGetFileSystemRepresentation(frameworksURL, TRUE,
(unsigned char*) tclLibPath, MAXPATHLEN) &&
! TclOSstat(tclLibPath, &statBuf) &&
S_ISDIR(statBuf.st_mode)) {
Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath,
TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
Tcl_SetVar(interp, "tcl_pkgPath", " ",
TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
}
CFRelease(frameworksURL);
}
}
Tcl_SetVar(interp, "tcl_pkgPath", pkgPath,
TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
} else
#endif /* HAVE_COREFOUNDATION */
{
Tcl_SetVar(interp, "tcl_pkgPath", pkgPath, TCL_GLOBAL_ONLY);
}
#ifdef DJGPP
Tcl_SetVar2(interp, "tcl_platform", "platform", "dos", TCL_GLOBAL_ONLY);
#else
Tcl_SetVar2(interp, "tcl_platform", "platform", "unix", TCL_GLOBAL_ONLY);
#endif
unameOK = 0;
#ifndef NO_UNAME
if (uname(&name) >= 0) {
CONST char *native;
unameOK = 1;
native = Tcl_ExternalToUtfDString(NULL, name.sysname, -1, &ds);
Tcl_SetVar2(interp, "tcl_platform", "os", native, TCL_GLOBAL_ONLY);
Tcl_DStringFree(&ds);
/*
* The following code is a special hack to handle differences in the
* way version information is returned by uname. On most systems the
* full version number is available in name.release. However, under
* AIX the major version number is in name.version and the minor
* version number is in name.release.
*/
if ((strchr(name.release, '.') != NULL)
|| !isdigit(UCHAR(name.version[0]))) { /* INTL: digit */
Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.release,
TCL_GLOBAL_ONLY);
} else {
#ifdef DJGPP
/*
* For some obscure reason DJGPP puts major version into
* name.release and minor into name.version. As of DJGPP 2.04 this
* is documented in djgpp libc.info file.
*/
Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.release,
TCL_GLOBAL_ONLY);
Tcl_SetVar2(interp, "tcl_platform", "osVersion", ".",
TCL_GLOBAL_ONLY|TCL_APPEND_VALUE);
Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.version,
TCL_GLOBAL_ONLY|TCL_APPEND_VALUE);
#else
Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.version,
TCL_GLOBAL_ONLY);
Tcl_SetVar2(interp, "tcl_platform", "osVersion", ".",
TCL_GLOBAL_ONLY|TCL_APPEND_VALUE);
Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.release,
TCL_GLOBAL_ONLY|TCL_APPEND_VALUE);
#endif /* DJGPP */
}
Tcl_SetVar2(interp, "tcl_platform", "machine", name.machine,
TCL_GLOBAL_ONLY);
}
#endif /* !NO_UNAME */
if (!unameOK) {
Tcl_SetVar2(interp, "tcl_platform", "os", "", TCL_GLOBAL_ONLY);
Tcl_SetVar2(interp, "tcl_platform", "osVersion", "", TCL_GLOBAL_ONLY);
Tcl_SetVar2(interp, "tcl_platform", "machine", "", TCL_GLOBAL_ONLY);
}
/*
* Copy the username of the real user (according to getuid()) into
* tcl_platform(user).
*/
{
struct passwd *pwEnt = TclpGetPwUid(getuid());
const char *user;
if (pwEnt == NULL) {
user = "";
Tcl_DStringInit(&ds); /* ensure cleanliness */
} else {
user = Tcl_ExternalToUtfDString(NULL, pwEnt->pw_name, -1, &ds);
}
Tcl_SetVar2(interp, "tcl_platform", "user", user, TCL_GLOBAL_ONLY);
Tcl_DStringFree(&ds);
}
}
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");
}
int
Tcl_AppInit(
Tcl_Interp *interp) /* Interpreter for application. */
{
if (Tcl_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
#ifdef TCL_TEST
#ifdef TCL_XT_TEST
if (Tclxttest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
#endif
if (Tcltest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init,
(Tcl_PackageInitProc *) NULL);
if (TclObjTest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
if (Procbodytest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "procbodytest", Procbodytest_Init,
Procbodytest_SafeInit);
#endif /* TCL_TEST */
/*
* Call the init functions for included packages. Each call should look
* like this:
*
* if (Mod_Init(interp) == TCL_ERROR) {
* return TCL_ERROR;
* }
*
* where "Mod" is the name of the module. (Dynamically-loadable packages
* should have the same entry-point name.)
*/
/*
* Call Tcl_CreateCommand for application-specific commands, if they
* weren't already created by the init functions called above.
*/
/*
* Specify a user-specific startup file to invoke if the application is
* run interactively. Typically the startup file is "~/.apprc" where "app"
* is the name of the application. If this line is deleted then no user-
* specific startup file will be run under any conditions.
*/
#ifdef DJGPP
Tcl_SetVar(interp, "tcl_rcFileName", "~/tclsh.rc", TCL_GLOBAL_ONLY);
#else
Tcl_SetVar(interp, "tcl_rcFileName", "~/.tclshrc", TCL_GLOBAL_ONLY);
#endif
return TCL_OK;
}
void check_tcl_event(const char *event)
{
Tcl_SetVar(interp, "_event1", (char *) event, 0);
check_tcl_bind(H_event, event, 0, " $_event1", MATCH_EXACT | BIND_STACKABLE);
}