static void
OpenGLEventProc(ClientData clientData, XEvent *eventPtr)
{
OpenGLClientData *OpenGLPtr = (OpenGLClientData *) clientData;
if (eventPtr->type == DestroyNotify)
{
#ifndef _WIN32
glXMakeContextCurrent(OpenGLPtr->display, None, None, 0);
#else
wglMakeCurrent(OpenGLPtr->hDC,0);
#endif
XSync(OpenGLPtr->display, False);
// glXDestroyWindow(OpenGLPtr->display, OpenGLPtr->glx_win);
#ifndef _WIN32
glXDestroyContext(OpenGLPtr->display, OpenGLPtr->cx);
#else
wglDeleteContext( OpenGLPtr->cx );
#endif
XSync(OpenGLPtr->display, False);
Tcl_DeleteCommand(OpenGLPtr->interp, Tk_PathName(OpenGLPtr->tkwin));
OpenGLPtr->tkwin = NULL;
Tk_EventuallyFree((ClientData) OpenGLPtr, (Tcl_FreeProc*)OpenGLDestroy);
}
}
static void
imfsample_event_proc(ClientData cldata, XEvent *eventPtr)
{
Imfsample *imfsample = (Imfsample *) cldata;
if (eventPtr->type == Expose) {
if (!imfsample->update_pending) {
Tcl_DoWhenIdle(imfsample_display, cldata);
imfsample->update_pending = 1;
}
} else if (eventPtr->type == ConfigureNotify) {
if (!imfsample->update_pending) {
Tcl_DoWhenIdle(imfsample_display, cldata);
imfsample->update_pending = 1;
}
} else if (eventPtr->type == DestroyNotify) {
if (imfsample->tkwin != NULL) {
imfsample->tkwin = NULL;
Tcl_DeleteCommand(imfsample->interp,
Tcl_GetCommandName(imfsample->interp,
imfsample->widgetCmd));
}
if (imfsample->update_pending) {
Tcl_CancelIdleCall(imfsample_display, cldata);
}
Tcl_EventuallyFree(cldata, imfsample_destroy);
}
}
/** The function for analyzing a column only.
\anchor UWerr
*/
int UWerr(Tcl_Interp * interp,
double ** data, int rows, int cols,
int col_to_analyze,
int * n_rep, int len,
double s_tau, int plot)
{
Tcl_CmdInfo cmdInfo;
char * argv[2];
char * name = "UWerrInternalFunction";
int res;
argv[0] = name;
argv[1] = (char*)malloc(TCL_INTEGER_SPACE*sizeof(char));
sprintf(argv[1], "%d", col_to_analyze);
if (Tcl_CreateCommand(interp, name, UWerr_proj, 0, NULL) == NULL) {
Tcl_AppendResult(interp, "could not create command \"", name, "\"", (char *)NULL);
return TCL_ERROR;
}
if (Tcl_GetCommandInfo(interp, name, &cmdInfo) == 0) {
Tcl_AppendResult(interp, "could not access command \"", name, "\"", (char *)NULL);
return TCL_ERROR;
}
res = UWerr_f(interp, &cmdInfo, 2, argv,
data, rows, cols, n_rep, len, s_tau, plot);
Tcl_DeleteCommand(interp, name);
free(argv[1]);
return res;
}
static void destroyFunc( GtkWidget *widget, gpointer data )
{
CanvasParams *p = (CanvasParams *)data;
GPtrArray *items;
gnoclForgetWidgetFromName( p->name );
Tcl_DeleteCommand( p->interp, p->name );
g_free( p->name );
/* TODO: the canvas receives the destroy signal before its items. But
the items use the hash table on destruction.
Shouldn't children receive the signal before their parents?
Hmm, GTK widgets do it the same way.
gtk_container_foreach( GTK_CONTAINER( widget ),
(GtkCallback)destroyItemFunc, NULL);
doesn't help either
*/
items = gnoclCanvasAllItems( p );
if( items != NULL )
{
int k;
for( k = items->len - 1; k >= 0; --k )
{
Gnocl_CanvasItemInfo *info = GET_INFO( items, k );
gtk_object_destroy( GTK_OBJECT( info->item ) );
}
}
g_hash_table_destroy( p->tagToItems );
}
static int xQueryPhraseCb(
const Fts5ExtensionApi *pApi,
Fts5Context *pFts,
void *pCtx
){
F5tFunction *p = (F5tFunction*)pCtx;
static sqlite3_int64 iCmd = 0;
Tcl_Obj *pEval;
int rc;
char zCmd[64];
F5tApi sApi;
sApi.pApi = pApi;
sApi.pFts = pFts;
sprintf(zCmd, "f5t_2_%lld", iCmd++);
Tcl_CreateObjCommand(p->interp, zCmd, xF5tApi, &sApi, 0);
pEval = Tcl_DuplicateObj(p->pScript);
Tcl_IncrRefCount(pEval);
Tcl_ListObjAppendElement(p->interp, pEval, Tcl_NewStringObj(zCmd, -1));
rc = Tcl_EvalObjEx(p->interp, pEval, 0);
Tcl_DecrRefCount(pEval);
Tcl_DeleteCommand(p->interp, zCmd);
if( rc==TCL_OK ){
rc = f5tResultToErrorCode(Tcl_GetStringResult(p->interp));
}
return rc;
}
void deleteEdge(gctx_t *gctx, Agraph_t * g, Agedge_t *e)
{
char *hndl;
hndl = obj2cmd(e);
agdelete(gctx->g, e); /* delete edge from root graph */
Tcl_DeleteCommand(gctx->ictx->interp, hndl);
}
void deleteNode(gctx_t * gctx, Agraph_t *g, Agnode_t *n)
{
char *hndl;
deleteNodeEdges(gctx, gctx->g, n); /* delete all edges to/from node in root graph */
hndl = obj2cmd(n);
agdelete(gctx->g, n); /* delete node from root graph */
Tcl_DeleteCommand(gctx->ictx->interp, hndl);
}
static TkappObject *
Tkapp_New(char *screenName, char *baseName, char *className, int interactive)
{
TkappObject *v;
char *argv0;
v = PyObject_New(TkappObject, &Tkapp_Type);
if (v == NULL)
return NULL;
v->interp = Tcl_CreateInterp();
#if defined(macintosh)
/* This seems to be needed */
ClearMenuBar();
TkMacInitMenus(v->interp);
#endif
/* Delete the 'exit' command, which can screw things up */
Tcl_DeleteCommand(v->interp, "exit");
if (screenName != NULL)
Tcl_SetVar2(v->interp, "env", "DISPLAY",
screenName, TCL_GLOBAL_ONLY);
if (interactive)
Tcl_SetVar(v->interp, "tcl_interactive", "1", TCL_GLOBAL_ONLY);
else
Tcl_SetVar(v->interp, "tcl_interactive", "0", TCL_GLOBAL_ONLY);
/* This is used to get the application class for Tk 4.1 and up */
argv0 = (char*)ckalloc(strlen(className) + 1);
if (!argv0) {
PyErr_NoMemory();
Py_DECREF(v);
return NULL;
}
strcpy(argv0, className);
if (isupper((int)(argv0[0])))
argv0[0] = tolower(argv0[0]);
Tcl_SetVar(v->interp, "argv0", argv0, TCL_GLOBAL_ONLY);
ckfree(argv0);
if (Tcl_AppInit(v->interp) != TCL_OK)
return (TkappObject *)Tkinter_Error((PyObject *)v);
EnableEventHook();
return v;
}
/* Remove the default msg/dcc/fil commands from the Tcl interpreter */
void rem_builtins(tcl_bind_list_t *table, cmd_t *cc)
{
int k, i;
char p[1024], *l;
for (i = 0; cc[i].name; i++) {
egg_snprintf(p, sizeof p, "*%s:%s", table->name,
cc[i].funcname ? cc[i].funcname : cc[i].name);
l = nmalloc(Tcl_ScanElement(p, &k));
Tcl_ConvertElement(p, l, k | TCL_DONT_USE_BRACES);
Tcl_DeleteCommand(interp, p);
unbind_bind_entry(table, cc[i].flags, cc[i].name, l);
nfree(l);
}
}
/*
* Close a framebuffer object.
*
* Usage:
* procname close
*/
HIDDEN int
fbo_close_tcl(void *clientData, int argc, const char **UNUSED(argv))
{
struct fb_obj *fbop = (struct fb_obj *)clientData;
if (argc != 2) {
bu_log("ERROR: expecting two arguments\n");
return BRLCAD_ERROR;
}
/* Among other things, this will call dmo_deleteProc. */
Tcl_DeleteCommand(fbop->fbo_interp, bu_vls_addr(&fbop->fbo_name));
return BRLCAD_OK;
}
void kit::unbind(int fd)
/*
* unbind fd, i.e. detach handler from fd (do not close fd!)
*/
{
if(fd_table.find(fd) == fd_table.end())
return;
binding *b = fd_table[fd];
fd_table.erase(fd);
Tcl_DeleteCommand(interp, b->cmd);
Tcl_DeleteFileHandler(fd);
delete b;
}
static void spinButtonDestroyFunc ( GtkWidget *widget, gpointer data )
{
SpinButtonParams *para = (SpinButtonParams *)data;
gnoclForgetWidgetFromName( para->name );
Tcl_DeleteCommand( para->interp, para->name );
gnoclAttacheOptCmdAndVar( NULL, ¶->onValueChanged,
NULL, ¶->variable,
"changed", G_OBJECT( para->spinButton ), G_CALLBACK( changedFunc ),
para->interp, traceFunc, para );
g_free( para->variable );
g_free( para->name );
g_free( para );
}
static void destroyFunc( GtkWidget *widget, gpointer data )
{
ComboParams *para = (ComboParams *)data;
gnoclAttacheOptCmdAndVar(
NULL, ¶->onChanged,
NULL, ¶->variable,
"changed", getSigObj( para->comboBox ),
G_CALLBACK( changedFunc ), para->interp, traceFunc, para );
gnoclForgetWidgetFromName( para->name );
Tcl_DeleteCommand( para->interp, para->name );
g_free( para->variable );
g_free( para->onChanged );
g_free( para->name );
g_free( para );
}
static void
ImageDelete(
ClientData clientData) /* Pointer to TImageMaster for image. When
* this function is called, no more instances
* exist. */
{
TImageMaster *timPtr = clientData;
char buffer[100];
sprintf(buffer, "%s delete", timPtr->imageName);
Tcl_SetVar(timPtr->interp, timPtr->varName, buffer,
TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
Tcl_DeleteCommand(timPtr->interp, timPtr->imageName);
ckfree(timPtr->imageName);
ckfree(timPtr->varName);
ckfree((char *) timPtr);
}
void deleteGraph(gctx_t * gctx, Agraph_t *g)
{
Agraph_t *sg;
char *hndl;
for (sg = agfstsubg (g); sg; sg = agnxtsubg (sg)) {
deleteGraph(gctx, sg);
}
deleteGraphNodes(gctx, g);
hndl = obj2cmd(g);
if (g == agroot(g)) {
agclose(g);
} else {
agdelsubg(agroot(g), g);
}
Tcl_DeleteCommand(gctx->ictx->interp, hndl);
}
/*
* Close a framebuffer object.
*
* Usage:
* procname close
*/
HIDDEN int
fbo_close_tcl(ClientData clientData, Tcl_Interp *interp, int argc, char **argv)
{
struct fb_obj *fbop = (struct fb_obj *)clientData;
struct bu_vls vls;
if (argc != 2) {
bu_vls_init(&vls);
bu_vls_printf(&vls, "helplib fb_close");
Tcl_Eval(interp, bu_vls_addr(&vls));
bu_vls_free(&vls);
return TCL_ERROR;
}
/* Among other things, this will call dmo_deleteProc. */
Tcl_DeleteCommand(interp, bu_vls_addr(&fbop->fbo_name));
return TCL_OK;
}
static void
PaxWidgetEventProc(ClientData clientData, XEvent *event)
{
PaxWidget *paxwidget = (PaxWidget *) clientData;
if (event->type == Expose || event->type == GraphicsExpose)
{
handle_expose_event(paxwidget, event);
}
else if (event->type == ConfigureNotify)
{
paxWidget_CallMethodArgs(paxwidget->obj, ResizedMethodIdx,
Py_BuildValue("ii", event->xconfigure.width,
event->xconfigure.height));
}
else if (event->type == MapNotify)
{
paxWidget_CallMethod(paxwidget->obj, MapMethodIdx);
}
else if (event->type == DestroyNotify)
{
paxWidget_CallMethod(paxwidget->obj, DestroyMethodIdx);
if (paxwidget->tkwin != NULL)
{
paxwidget->tkwin = NULL;
Tcl_DeleteCommand(paxwidget->interp,
Tcl_GetCommandName(paxwidget->interp,
paxwidget->widget_cmd));
}
if (paxwidget->update_pending)
{
Tk_CancelIdleCall(PaxWidgetDisplay, (ClientData) paxwidget);
}
Tk_EventuallyFree((ClientData) paxwidget, PaxWidgetDestroy);
}
else if (event->type > LASTEvent)
{
paxWidget_CallMethodArgs(paxwidget->obj, ExtensionEventIdx,
Py_BuildValue("(i)", event->type));
}
}
void
SimGraphEventProc(ClientData clientData, XEvent *eventPtr)
{
SimGraph *graph = (SimGraph *) clientData;
if ((eventPtr->type == Expose) && (eventPtr->xexpose.count == 0)) {
graph->visible = 1;
EventuallyRedrawGraph(graph);
} else if (eventPtr->type == MapNotify) {
graph->visible = 1;
} else if (eventPtr->type == UnmapNotify) {
graph->visible = 0;
} else if (eventPtr->type == VisibilityNotify) {
if (eventPtr->xvisibility.state == VisibilityFullyObscured)
graph->visible = 0;
else
graph->visible = 1;
} else if (eventPtr->type == ConfigureNotify) {
DoResizeGraph(graph,
eventPtr->xconfigure.width,
eventPtr->xconfigure.height);
EventuallyRedrawGraph(graph);
} else if (eventPtr->type == DestroyNotify) {
Tcl_DeleteCommand(graph->interp, Tk_PathName(graph->tkwin));
graph->tkwin = NULL;
if (graph->flags & VIEW_REDRAW_PENDING) {
//fprintf(stderr, "SimGraphEventProc Destroy token %d\n", graph->draw_graph_token);
assert(graph->draw_graph_token != 0);
if (graph->draw_graph_token != 0) {
Tk_DeleteTimerHandler(graph->draw_graph_token);
graph->draw_graph_token = 0;
}
graph->flags &= ~VIEW_REDRAW_PENDING;
}
Tk_EventuallyFree((ClientData) graph, DestroySimGraph);
}
}
/**
\brief
\author Peter G Baum, William J Giddings
\date
**/
static void destroyFunc (
GtkWidget *widget,
gpointer data )
{
#ifdef DEBUG_LABEL
printf ( "label/staticFuncs/destroyFunc\n" );
#endif
LabelParams *para = ( LabelParams * ) data;
gnoclForgetWidgetFromName ( para->name );
Tcl_DeleteCommand ( para->interp, para->name );
gnoclAttacheOptCmdAndVar (
NULL, ¶->onChanged,
NULL, ¶->textVariable,
"changed", G_OBJECT ( para->label ),
G_CALLBACK ( changedFunc ), para->interp, traceFunc, para );
g_free ( para->textVariable );
g_free ( para->name );
g_free ( para );
}
/* process vgpane methods */
static int
vgpanecmd(ClientData clientData, Tcl_Interp * interp, int argc,
char *argv[])
{
int vargc, length, i, j, n, result;
char c, *s, **vargv, vbuf[30];
vgpane_t *vgp, **vgpp;
point p, q, *ps;
poly *tpp;
double alpha, gain;
Pvector_t slopes[2];
Ppolyline_t line, spline;
int pp, qp; /* polygon indices for p, q */
Pedge_t *barriers;
int n_barriers;
if (argc < 2) {
Tcl_AppendResult(interp, "wrong # args: should be \"",
" ", argv[0], " method ?arg arg ...?\"",
(char *) NULL);
return TCL_ERROR;
}
if (!(vgpp = (vgpane_t **) tclhandleXlate(vgpaneTable, argv[0]))) {
Tcl_AppendResult(interp, "Invalid handle: \"", argv[0],
"\"", (char *) NULL);
return TCL_ERROR;
}
vgp = *vgpp;
c = argv[1][0];
length = strlen(argv[1]);
if ((c == 'c') && (strncmp(argv[1], "coords", length) == 0)) {
if ((argc < 3)) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" ", argv[1], " id ?x1 y1 x2 y2...?\"",
(char *) NULL);
return TCL_ERROR;
}
if (sscanf(argv[2], "%d", &polyid) != 1) {
Tcl_AppendResult(interp, "not an integer: ", argv[2],
(char *) NULL);
return TCL_ERROR;
}
if (argc == 3) {
/* find poly and return its coordinates */
for (i = 0; i < vgp->Npoly; i++) {
if (vgp->poly[i].id == polyid) {
n = vgp->poly[i].boundary.pn;
for (j = 0; j < n; j++) {
appendpoint(interp, vgp->poly[i].boundary.ps[j]);
}
return TCL_OK;
}
}
Tcl_AppendResult(interp, " no such polygon: ", argv[2],
(char *) NULL);
return TCL_ERROR;
}
/* accept either inline or delimited list */
if ((argc == 4)) {
result =
Tcl_SplitList(interp, argv[3], &vargc,
(CONST84 char ***) &vargv);
if (result != TCL_OK) {
return result;
}
} else {
vargc = argc - 3;
vargv = &argv[3];
}
if (!vargc || vargc % 2) {
Tcl_AppendResult(interp,
"There must be a multiple of two terms in the list.",
(char *) NULL);
return TCL_ERROR;
}
/* remove old poly, add modified polygon to the end with
the same id as the original */
if (!(remove_poly(vgp, polyid))) {
Tcl_AppendResult(interp, " no such polygon: ", argv[2],
(char *) NULL);
return TCL_ERROR;
}
return (insert_poly(interp, vgp, polyid, vargv, vargc));
} else if ((c == 'd') && (strncmp(argv[1], "debug", length) == 0)) {
/* debug only */
printf("debug output goes here\n");
return TCL_OK;
} else if ((c == 'd') && (strncmp(argv[1], "delete", length) == 0)) {
/* delete a vgpane and all memory associated with it */
if (vgp->vc)
Pobsclose(vgp->vc);
free(vgp->poly); /* ### */
Tcl_DeleteCommand(interp, argv[0]);
free((char *) tclhandleFree(vgpaneTable, argv[0]));
return TCL_OK;
} else if ((c == 'f') && (strncmp(argv[1], "find", length) == 0)) {
/* find the polygon that the point is inside and return it
id, or null */
if ((argc < 3)) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" ", argv[1], " x y\"", (char *) NULL);
return TCL_ERROR;
}
if (argc == 3) {
result =
Tcl_SplitList(interp, argv[2], &vargc,
(CONST84 char ***) &vargv);
if (result != TCL_OK) {
return result;
}
} else {
vargc = argc - 2;
vargv = &argv[2];
}
result = scanpoint(interp, &vargv[0], &p);
if (result != TCL_OK)
return result;
/* determine the polygons (if any) that contain the point */
for (i = 0; i < vgp->Npoly; i++) {
if (in_poly(vgp->poly[i].boundary, p)) {
sprintf(vbuf, "%d", vgp->poly[i].id);
Tcl_AppendElement(interp, vbuf);
}
}
return TCL_OK;
} else if ((c == 'i') && (strncmp(argv[1], "insert", length) == 0)) {
/* add poly to end poly list, and it coordinates to the end of
the point list */
if ((argc < 3)) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" ", argv[1], " x1 y1 x2 y2 ...\"",
(char *) NULL);
return TCL_ERROR;
}
/* accept either inline or delimited list */
if ((argc == 3)) {
result =
Tcl_SplitList(interp, argv[2], &vargc,
(CONST84 char ***) &vargv);
if (result != TCL_OK) {
return result;
}
} else {
vargc = argc - 2;
vargv = &argv[2];
}
if (!vargc || vargc % 2) {
Tcl_AppendResult(interp,
"There must be a multiple of two terms in the list.",
(char *) NULL);
return TCL_ERROR;
}
polyid++;
result = insert_poly(interp, vgp, polyid, vargv, vargc);
if (result != TCL_OK)
return result;
sprintf(vbuf, "%d", polyid);
Tcl_AppendResult(interp, vbuf, (char *) NULL);
return TCL_OK;
} else if ((c == 'l') && (strncmp(argv[1], "list", length) == 0)) {
/* return list of polygon ids */
for (i = 0; i < vgp->Npoly; i++) {
sprintf(vbuf, "%d", vgp->poly[i].id);
Tcl_AppendElement(interp, vbuf);
}
return TCL_OK;
} else if ((c == 'p') && (strncmp(argv[1], "path", length) == 0)) {
/* return a list of points corresponding to the shortest path
that does not cross the remaining "visible" polygons. */
if ((argc < 3)) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" ", argv[1], " x1 y1 x2 y2\"",
(char *) NULL);
return TCL_ERROR;
}
if (argc == 3) {
result =
Tcl_SplitList(interp, argv[2], &vargc,
(CONST84 char ***) &vargv);
if (result != TCL_OK) {
return result;
}
} else {
vargc = argc - 2;
vargv = &argv[2];
}
if ((vargc < 4)) {
Tcl_AppendResult(interp,
"invalid points: should be: \"x1 y1 x2 y2\"",
(char *) NULL);
return TCL_ERROR;
}
result = scanpoint(interp, &vargv[0], &p);
if (result != TCL_OK)
return result;
result = scanpoint(interp, &vargv[2], &q);
if (result != TCL_OK)
return result;
/* only recompute the visibility graph if we have to */
if ((vc_refresh(vgp))) {
Pobspath(vgp->vc, p, POLYID_UNKNOWN, q, POLYID_UNKNOWN, &line);
for (i = 0; i < line.pn; i++) {
appendpoint(interp, line.ps[i]);
}
}
return TCL_OK;
} else if ((c == 'b') && (strncmp(argv[1], "bind", length) == 0)) {
if ((argc < 2) || (argc > 4)) {
Tcl_AppendResult(interp, "wrong # args: should be \"",
argv[0], " bind triangle ?command?\"",
(char *) NULL);
return TCL_ERROR;
}
if (argc == 2) {
Tcl_AppendElement(interp, "triangle");
return TCL_OK;
}
length = strlen(argv[2]);
if (strncmp(argv[2], "triangle", length) == 0) {
s = vgp->triangle_cmd;
if (argc == 4)
vgp->triangle_cmd = s = buildBindings(s, argv[3]);
} else {
Tcl_AppendResult(interp, "unknown event \"", argv[2],
"\": must be one of:\n\ttriangle.",
(char *) NULL);
return TCL_ERROR;
}
if (argc == 3)
Tcl_AppendResult(interp, s, (char *) NULL);
return TCL_OK;
} else if ((c == 'b') && (strncmp(argv[1], "bpath", length) == 0)) {
/* return a list of points corresponding to the shortest path
that does not cross the remaining "visible" polygons. */
if ((argc < 3)) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" ", argv[1], " x1 y1 x2 y2\"",
(char *) NULL);
return TCL_ERROR;
}
if (argc == 3) {
result =
Tcl_SplitList(interp, argv[2], &vargc,
(CONST84 char ***) &vargv);
if (result != TCL_OK) {
return result;
}
} else {
vargc = argc - 2;
vargv = &argv[2];
}
if ((vargc < 4)) {
Tcl_AppendResult(interp,
"invalid points: should be: \"x1 y1 x2 y2\"",
(char *) NULL);
return TCL_ERROR;
}
result = scanpoint(interp, &vargv[0], &p);
if (result != TCL_OK)
return result;
result = scanpoint(interp, &vargv[2], &q);
if (result != TCL_OK)
return result;
/* determine the polygons (if any) that contain the endpoints */
pp = qp = POLYID_NONE;
for (i = 0; i < vgp->Npoly; i++) {
tpp = &(vgp->poly[i]);
if ((pp == POLYID_NONE) && in_poly(tpp->boundary, p))
pp = i;
if ((qp == POLYID_NONE) && in_poly(tpp->boundary, q))
qp = i;
}
if (vc_refresh(vgp)) {
/*Pobspath(vgp->vc, p, pp, q, qp, &line); */
Pobspath(vgp->vc, p, POLYID_UNKNOWN, q, POLYID_UNKNOWN, &line);
make_barriers(vgp, pp, qp, &barriers, &n_barriers);
slopes[0].x = slopes[0].y = 0.0;
slopes[1].x = slopes[1].y = 0.0;
Proutespline(barriers, n_barriers, line, slopes, &spline);
for (i = 0; i < spline.pn; i++) {
appendpoint(interp, spline.ps[i]);
}
}
return TCL_OK;
} else if ((c == 'b') && (strncmp(argv[1], "bbox", length) == 0)) {
if ((argc < 3)) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" ", argv[1], " id\"", (char *) NULL);
return TCL_ERROR;
}
if (sscanf(argv[2], "%d", &polyid) != 1) {
Tcl_AppendResult(interp, "not an integer: ", argv[2],
(char *) NULL);
return TCL_ERROR;
}
for (i = 0; i < vgp->Npoly; i++) {
if (vgp->poly[i].id == polyid) {
Ppoly_t pp = vgp->poly[i].boundary;
point LL, UR;
LL = UR = pp.ps[0];
for (j = 1; j < pp.pn; j++) {
p = pp.ps[j];
if (p.x > UR.x)
UR.x = p.x;
if (p.y > UR.y)
UR.y = p.y;
if (p.x < LL.x)
LL.x = p.x;
if (p.y < LL.y)
LL.y = p.y;
}
appendpoint(interp, LL);
appendpoint(interp, UR);
return TCL_OK;
}
}
Tcl_AppendResult(interp, " no such polygon: ", argv[2],
(char *) NULL);
return TCL_ERROR;
} else if ((c == 'c') && (strncmp(argv[1], "center", length) == 0)) {
if ((argc < 3)) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" ", argv[1], " id\"", (char *) NULL);
return TCL_ERROR;
}
if (sscanf(argv[2], "%d", &polyid) != 1) {
Tcl_AppendResult(interp, "not an integer: ", argv[2],
(char *) NULL);
return TCL_ERROR;
}
for (i = 0; i < vgp->Npoly; i++) {
if (vgp->poly[i].id == polyid) {
appendpoint(interp, center(vgp->poly[i].boundary.ps,
vgp->poly[i].boundary.pn));
return TCL_OK;
}
}
Tcl_AppendResult(interp, " no such polygon: ", argv[2],
(char *) NULL);
return TCL_ERROR;
} else if ((c == 't')
&& (strncmp(argv[1], "triangulate", length) == 0)) {
if ((argc < 2)) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" id ", (char *) NULL);
return TCL_ERROR;
}
if (sscanf(argv[2], "%d", &polyid) != 1) {
Tcl_AppendResult(interp, "not an integer: ", argv[2],
(char *) NULL);
return TCL_ERROR;
}
for (i = 0; i < vgp->Npoly; i++) {
if (vgp->poly[i].id == polyid) {
Ptriangulate(&(vgp->poly[i].boundary), triangle_callback,
vgp);
return TCL_OK;
}
}
Tcl_AppendResult(interp, " no such polygon: ", argv[2],
(char *) NULL);
return TCL_ERROR;
} else if ((c == 'r') && (strncmp(argv[1], "rotate", length) == 0)) {
if ((argc < 4)) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" ", argv[1], " id alpha\"", (char *) NULL);
return TCL_ERROR;
}
if (sscanf(argv[2], "%d", &polyid) != 1) {
Tcl_AppendResult(interp, "not an integer: ", argv[2],
(char *) NULL);
return TCL_ERROR;
}
if (sscanf(argv[3], "%lg", &alpha) != 1) {
Tcl_AppendResult(interp, "not an angle in radians: ", argv[3],
(char *) NULL);
return TCL_ERROR;
}
for (i = 0; i < vgp->Npoly; i++) {
if (vgp->poly[i].id == polyid) {
n = vgp->poly[i].boundary.pn;
ps = vgp->poly[i].boundary.ps;
p = center(ps, n);
for (j = 0; j < n; j++) {
appendpoint(interp, rotate(p, ps[j], alpha));
}
return TCL_OK;
}
}
Tcl_AppendResult(interp, " no such polygon: ", argv[2],
(char *) NULL);
return TCL_ERROR;
} else if ((c == 's') && (strncmp(argv[1], "scale", length) == 0)) {
if ((argc < 4)) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" ", argv[1], " id gain\"", (char *) NULL);
return TCL_ERROR;
}
if (sscanf(argv[2], "%d", &polyid) != 1) {
Tcl_AppendResult(interp, "not an integer: ", argv[2],
(char *) NULL);
return TCL_ERROR;
}
if (sscanf(argv[3], "%lg", &gain) != 1) {
Tcl_AppendResult(interp, "not a number: ", argv[3],
(char *) NULL);
return TCL_ERROR;
}
for (i = 0; i < vgp->Npoly; i++) {
if (vgp->poly[i].id == polyid) {
n = vgp->poly[i].boundary.pn;
ps = vgp->poly[i].boundary.ps;
for (j = 0; j < n; j++) {
appendpoint(interp, scale(p, ps[j], gain));
}
return TCL_OK;
}
}
Tcl_AppendResult(interp, " no such polygon: ", argv[2],
(char *) NULL);
return TCL_ERROR;
} else if ((c == 'r') && (strncmp(argv[1], "remove", length) == 0)) {
if ((argc < 3)) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" ", argv[1], " id\"", (char *) NULL);
return TCL_ERROR;
}
if (sscanf(argv[2], "%d", &polyid) != 1) {
Tcl_AppendResult(interp, "not an integer: ", argv[2],
(char *) NULL);
return TCL_ERROR;
}
if (remove_poly(vgp, polyid))
return TCL_OK;
Tcl_AppendResult(interp, " no such polygon: ", argv[2],
(char *) NULL);
return TCL_ERROR;
}
Tcl_AppendResult(interp, "bad method \"", argv[1],
"\" must be one of:",
"\n\tbbox, bind, bpath, center, coords, delete, find,",
"\n\tinsert, list, path, remove, rotate, scale, triangulate.",
(char *) NULL);
return TCL_ERROR;
}
void commandsManager::unregisterFunction(const char *commandName)
{
commandsHelp.remove(commandName);
Tcl_DeleteCommand(interp, commandName);
}
/*
** The "sqlite" command below creates a new Tcl command for each
** connection it opens to an SQLite database. This routine is invoked
** whenever one of those connection-specific commands is executed
** in Tcl. For example, if you run Tcl code like this:
**
** sqlite db1 "my_database"
** db1 close
**
** The first command opens a connection to the "my_database" database
** and calls that connection "db1". The second command causes this
** subroutine to be invoked.
*/
static int DbObjCmd(void *cd, Tcl_Interp *interp, int objc,Tcl_Obj *const*objv){
SqliteDb *pDb = (SqliteDb*)cd;
int choice;
int rc = TCL_OK;
static const char *DB_strs[] = {
"authorizer", "busy", "changes",
"close", "commit_hook", "complete",
"errorcode", "eval", "function",
"last_insert_rowid", "last_statement_changes", "onecolumn",
"progress", "rekey", "timeout",
"trace",
0
};
enum DB_enum {
DB_AUTHORIZER, DB_BUSY, DB_CHANGES,
DB_CLOSE, DB_COMMIT_HOOK, DB_COMPLETE,
DB_ERRORCODE, DB_EVAL, DB_FUNCTION,
DB_LAST_INSERT_ROWID, DB_LAST_STATEMENT_CHANGES, DB_ONECOLUMN,
DB_PROGRESS, DB_REKEY, DB_TIMEOUT,
DB_TRACE
};
if( objc<2 ){
Tcl_WrongNumArgs(interp, 1, objv, "SUBCOMMAND ...");
return TCL_ERROR;
}
if( Tcl_GetIndexFromObj(interp, objv[1], DB_strs, "option", 0, &choice) ){
return TCL_ERROR;
}
switch( (enum DB_enum)choice ){
/* $db authorizer ?CALLBACK?
**
** Invoke the given callback to authorize each SQL operation as it is
** compiled. 5 arguments are appended to the callback before it is
** invoked:
**
** (1) The authorization type (ex: SQLITE_CREATE_TABLE, SQLITE_INSERT, ...)
** (2) First descriptive name (depends on authorization type)
** (3) Second descriptive name
** (4) Name of the database (ex: "main", "temp")
** (5) Name of trigger that is doing the access
**
** The callback should return on of the following strings: SQLITE_OK,
** SQLITE_IGNORE, or SQLITE_DENY. Any other return value is an error.
**
** If this method is invoked with no arguments, the current authorization
** callback string is returned.
*/
case DB_AUTHORIZER: {
if( objc>3 ){
Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?");
}else if( objc==2 ){
if( pDb->zAuth ){
Tcl_AppendResult(interp, pDb->zAuth, 0);
}
}else{
char *zAuth;
int len;
if( pDb->zAuth ){
Tcl_Free(pDb->zAuth);
}
zAuth = Tcl_GetStringFromObj(objv[2], &len);
if( zAuth && len>0 ){
pDb->zAuth = Tcl_Alloc( len + 1 );
strcpy(pDb->zAuth, zAuth);
}else{
pDb->zAuth = 0;
}
#ifndef SQLITE_OMIT_AUTHORIZATION
if( pDb->zAuth ){
pDb->interp = interp;
sqlite_set_authorizer(pDb->db, auth_callback, pDb);
}else{
sqlite_set_authorizer(pDb->db, 0, 0);
}
#endif
}
break;
}
/* $db busy ?CALLBACK?
**
** Invoke the given callback if an SQL statement attempts to open
** a locked database file.
*/
case DB_BUSY: {
if( objc>3 ){
Tcl_WrongNumArgs(interp, 2, objv, "CALLBACK");
return TCL_ERROR;
}else if( objc==2 ){
if( pDb->zBusy ){
Tcl_AppendResult(interp, pDb->zBusy, 0);
}
}else{
char *zBusy;
int len;
if( pDb->zBusy ){
Tcl_Free(pDb->zBusy);
}
zBusy = Tcl_GetStringFromObj(objv[2], &len);
if( zBusy && len>0 ){
pDb->zBusy = Tcl_Alloc( len + 1 );
strcpy(pDb->zBusy, zBusy);
}else{
pDb->zBusy = 0;
}
if( pDb->zBusy ){
pDb->interp = interp;
sqlite_busy_handler(pDb->db, DbBusyHandler, pDb);
}else{
sqlite_busy_handler(pDb->db, 0, 0);
}
}
break;
}
/* $db progress ?N CALLBACK?
**
** Invoke the given callback every N virtual machine opcodes while executing
** queries.
*/
case DB_PROGRESS: {
if( objc==2 ){
if( pDb->zProgress ){
Tcl_AppendResult(interp, pDb->zProgress, 0);
}
}else if( objc==4 ){
char *zProgress;
int len;
int N;
if( TCL_OK!=Tcl_GetIntFromObj(interp, objv[2], &N) ){
return TCL_ERROR;
};
if( pDb->zProgress ){
Tcl_Free(pDb->zProgress);
}
zProgress = Tcl_GetStringFromObj(objv[3], &len);
if( zProgress && len>0 ){
pDb->zProgress = Tcl_Alloc( len + 1 );
strcpy(pDb->zProgress, zProgress);
}else{
pDb->zProgress = 0;
}
#ifndef SQLITE_OMIT_PROGRESS_CALLBACK
if( pDb->zProgress ){
pDb->interp = interp;
sqlite_progress_handler(pDb->db, N, DbProgressHandler, pDb);
}else{
sqlite_progress_handler(pDb->db, 0, 0, 0);
}
#endif
}else{
Tcl_WrongNumArgs(interp, 2, objv, "N CALLBACK");
return TCL_ERROR;
}
break;
}
/*
** $db changes
**
** Return the number of rows that were modified, inserted, or deleted by
** the most recent "eval".
*/
case DB_CHANGES: {
Tcl_Obj *pResult;
int nChange;
if( objc!=2 ){
Tcl_WrongNumArgs(interp, 2, objv, "");
return TCL_ERROR;
}
nChange = sqlite_changes(pDb->db);
pResult = Tcl_GetObjResult(interp);
Tcl_SetIntObj(pResult, nChange);
break;
}
/*
** $db last_statement_changes
**
** Return the number of rows that were modified, inserted, or deleted by
** the last statment to complete execution (excluding changes due to
** triggers)
*/
case DB_LAST_STATEMENT_CHANGES: {
Tcl_Obj *pResult;
int lsChange;
if( objc!=2 ){
Tcl_WrongNumArgs(interp, 2, objv, "");
return TCL_ERROR;
}
lsChange = sqlite_last_statement_changes(pDb->db);
pResult = Tcl_GetObjResult(interp);
Tcl_SetIntObj(pResult, lsChange);
break;
}
/* $db close
**
** Shutdown the database
*/
case DB_CLOSE: {
Tcl_DeleteCommand(interp, Tcl_GetStringFromObj(objv[0], 0));
break;
}
/* $db commit_hook ?CALLBACK?
**
** Invoke the given callback just before committing every SQL transaction.
** If the callback throws an exception or returns non-zero, then the
** transaction is aborted. If CALLBACK is an empty string, the callback
** is disabled.
*/
case DB_COMMIT_HOOK: {
if( objc>3 ){
Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?");
}else if( objc==2 ){
if( pDb->zCommit ){
Tcl_AppendResult(interp, pDb->zCommit, 0);
}
}else{
char *zCommit;
int len;
if( pDb->zCommit ){
Tcl_Free(pDb->zCommit);
}
zCommit = Tcl_GetStringFromObj(objv[2], &len);
if( zCommit && len>0 ){
pDb->zCommit = Tcl_Alloc( len + 1 );
strcpy(pDb->zCommit, zCommit);
}else{
pDb->zCommit = 0;
}
if( pDb->zCommit ){
pDb->interp = interp;
sqlite_commit_hook(pDb->db, DbCommitHandler, pDb);
}else{
sqlite_commit_hook(pDb->db, 0, 0);
}
}
break;
}
/* $db complete SQL
**
** Return TRUE if SQL is a complete SQL statement. Return FALSE if
** additional lines of input are needed. This is similar to the
** built-in "info complete" command of Tcl.
*/
case DB_COMPLETE: {
Tcl_Obj *pResult;
int isComplete;
if( objc!=3 ){
Tcl_WrongNumArgs(interp, 2, objv, "SQL");
return TCL_ERROR;
}
isComplete = sqlite_complete( Tcl_GetStringFromObj(objv[2], 0) );
pResult = Tcl_GetObjResult(interp);
Tcl_SetBooleanObj(pResult, isComplete);
break;
}
/*
** $db errorcode
**
** Return the numeric error code that was returned by the most recent
** call to sqlite_exec().
*/
case DB_ERRORCODE: {
Tcl_SetObjResult(interp, Tcl_NewIntObj(pDb->rc));
break;
}
/*
** $db eval $sql ?array { ...code... }?
**
** The SQL statement in $sql is evaluated. For each row, the values are
** placed in elements of the array named "array" and ...code... is executed.
** If "array" and "code" are omitted, then no callback is every invoked.
** If "array" is an empty string, then the values are placed in variables
** that have the same name as the fields extracted by the query.
*/
case DB_EVAL: {
CallbackData cbData;
char *zErrMsg;
char *zSql;
#ifdef UTF_TRANSLATION_NEEDED
Tcl_DString dSql;
int i;
#endif
if( objc!=5 && objc!=3 ){
Tcl_WrongNumArgs(interp, 2, objv, "SQL ?ARRAY-NAME CODE?");
return TCL_ERROR;
}
pDb->interp = interp;
zSql = Tcl_GetStringFromObj(objv[2], 0);
#ifdef UTF_TRANSLATION_NEEDED
Tcl_DStringInit(&dSql);
Tcl_UtfToExternalDString(NULL, zSql, -1, &dSql);
zSql = Tcl_DStringValue(&dSql);
#endif
Tcl_IncrRefCount(objv[2]);
if( objc==5 ){
cbData.interp = interp;
cbData.once = 1;
cbData.zArray = Tcl_GetStringFromObj(objv[3], 0);
cbData.pCode = objv[4];
cbData.tcl_rc = TCL_OK;
cbData.nColName = 0;
cbData.azColName = 0;
zErrMsg = 0;
Tcl_IncrRefCount(objv[3]);
Tcl_IncrRefCount(objv[4]);
rc = sqlite_exec(pDb->db, zSql, DbEvalCallback, &cbData, &zErrMsg);
Tcl_DecrRefCount(objv[4]);
Tcl_DecrRefCount(objv[3]);
if( cbData.tcl_rc==TCL_BREAK ){ cbData.tcl_rc = TCL_OK; }
}else{
Tcl_Obj *pList = Tcl_NewObj();
cbData.tcl_rc = TCL_OK;
rc = sqlite_exec(pDb->db, zSql, DbEvalCallback2, pList, &zErrMsg);
Tcl_SetObjResult(interp, pList);
}
pDb->rc = rc;
if( rc==SQLITE_ABORT ){
if( zErrMsg ) free(zErrMsg);
rc = cbData.tcl_rc;
}else if( zErrMsg ){
Tcl_SetResult(interp, zErrMsg, TCL_VOLATILE);
free(zErrMsg);
rc = TCL_ERROR;
}else if( rc!=SQLITE_OK ){
Tcl_AppendResult(interp, sqlite_error_string(rc), 0);
rc = TCL_ERROR;
}else{
}
Tcl_DecrRefCount(objv[2]);
#ifdef UTF_TRANSLATION_NEEDED
Tcl_DStringFree(&dSql);
if( objc==5 && cbData.azColName ){
for(i=0; i<cbData.nColName; i++){
if( cbData.azColName[i] ) free(cbData.azColName[i]);
}
free(cbData.azColName);
cbData.azColName = 0;
}
#endif
return rc;
}
/*
** $db function NAME SCRIPT
**
** Create a new SQL function called NAME. Whenever that function is
** called, invoke SCRIPT to evaluate the function.
*/
case DB_FUNCTION: {
SqlFunc *pFunc;
char *zName;
char *zScript;
int nScript;
if( objc!=4 ){
Tcl_WrongNumArgs(interp, 2, objv, "NAME SCRIPT");
return TCL_ERROR;
}
zName = Tcl_GetStringFromObj(objv[2], 0);
zScript = Tcl_GetStringFromObj(objv[3], &nScript);
pFunc = (SqlFunc*)Tcl_Alloc( sizeof(*pFunc) + nScript + 1 );
if( pFunc==0 ) return TCL_ERROR;
pFunc->interp = interp;
pFunc->pNext = pDb->pFunc;
pFunc->zScript = (char*)&pFunc[1];
strcpy(pFunc->zScript, zScript);
sqlite_create_function(pDb->db, zName, -1, tclSqlFunc, pFunc);
sqlite_function_type(pDb->db, zName, SQLITE_NUMERIC);
break;
}
/*
** $db last_insert_rowid
**
** Return an integer which is the ROWID for the most recent insert.
*/
case DB_LAST_INSERT_ROWID: {
Tcl_Obj *pResult;
int rowid;
if( objc!=2 ){
Tcl_WrongNumArgs(interp, 2, objv, "");
return TCL_ERROR;
}
rowid = sqlite_last_insert_rowid(pDb->db);
pResult = Tcl_GetObjResult(interp);
Tcl_SetIntObj(pResult, rowid);
break;
}
/*
** $db onecolumn SQL
**
** Return a single column from a single row of the given SQL query.
*/
case DB_ONECOLUMN: {
char *zSql;
char *zErrMsg = 0;
if( objc!=3 ){
Tcl_WrongNumArgs(interp, 2, objv, "SQL");
return TCL_ERROR;
}
zSql = Tcl_GetStringFromObj(objv[2], 0);
rc = sqlite_exec(pDb->db, zSql, DbEvalCallback3, interp, &zErrMsg);
if( rc==SQLITE_ABORT ){
rc = SQLITE_OK;
}else if( zErrMsg ){
Tcl_SetResult(interp, zErrMsg, TCL_VOLATILE);
free(zErrMsg);
rc = TCL_ERROR;
}else if( rc!=SQLITE_OK ){
Tcl_AppendResult(interp, sqlite_error_string(rc), 0);
rc = TCL_ERROR;
}
break;
}
/*
** $db rekey KEY
**
** Change the encryption key on the currently open database.
*/
case DB_REKEY: {
int nKey;
void *pKey;
if( objc!=3 ){
Tcl_WrongNumArgs(interp, 2, objv, "KEY");
return TCL_ERROR;
}
pKey = Tcl_GetByteArrayFromObj(objv[2], &nKey);
#ifdef SQLITE_HAS_CODEC
rc = sqlite_rekey(pDb->db, pKey, nKey);
if( rc ){
Tcl_AppendResult(interp, sqlite_error_string(rc), 0);
rc = TCL_ERROR;
}
#endif
break;
}
/*
** $db timeout MILLESECONDS
**
** Delay for the number of milliseconds specified when a file is locked.
*/
case DB_TIMEOUT: {
int ms;
if( objc!=3 ){
Tcl_WrongNumArgs(interp, 2, objv, "MILLISECONDS");
return TCL_ERROR;
}
if( Tcl_GetIntFromObj(interp, objv[2], &ms) ) return TCL_ERROR;
sqlite_busy_timeout(pDb->db, ms);
break;
}
/* $db trace ?CALLBACK?
**
** Make arrangements to invoke the CALLBACK routine for each SQL statement
** that is executed. The text of the SQL is appended to CALLBACK before
** it is executed.
*/
case DB_TRACE: {
if( objc>3 ){
Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?");
}else if( objc==2 ){
if( pDb->zTrace ){
Tcl_AppendResult(interp, pDb->zTrace, 0);
}
}else{
char *zTrace;
int len;
if( pDb->zTrace ){
Tcl_Free(pDb->zTrace);
}
zTrace = Tcl_GetStringFromObj(objv[2], &len);
if( zTrace && len>0 ){
pDb->zTrace = Tcl_Alloc( len + 1 );
strcpy(pDb->zTrace, zTrace);
}else{
pDb->zTrace = 0;
}
if( pDb->zTrace ){
pDb->interp = interp;
sqlite_trace(pDb->db, DbTraceHandler, pDb);
}else{
sqlite_trace(pDb->db, 0, 0);
}
}
break;
}
} /* End of the SWITCH statement */
return rc;
}
/*
* Initialize mged, configure the path, set up the tcl interpreter.
*/
void
mged_setup(Tcl_Interp **interpreter)
{
int try_auto_path = 0;
int init_tcl = 1;
int init_itcl = 1;
struct bu_vls str = BU_VLS_INIT_ZERO;
const char *name = bu_argv0_full_path();
/* locate our run-time binary (must be called before Tcl_CreateInterp()) */
if (name) {
Tcl_FindExecutable(name);
} else {
Tcl_FindExecutable("mged");
}
if (!interpreter ) {
bu_log("mged_setup Error - interpreter is NULL!\n");
return;
}
if (*interpreter != NULL)
Tcl_DeleteInterp(*interpreter);
/* Create the interpreter */
*interpreter = Tcl_CreateInterp();
/* a two-pass init loop. the first pass just tries default init
* routines while the second calls tclcad_auto_path() to help it
* find other, potentially uninstalled, resources.
*/
while (1) {
/* not called first time through, give Tcl_Init() a chance */
if (try_auto_path) {
/* Locate the BRL-CAD-specific Tcl scripts, set the auto_path */
tclcad_auto_path(*interpreter);
}
/* Initialize Tcl */
Tcl_ResetResult(*interpreter);
if (init_tcl && Tcl_Init(*interpreter) == TCL_ERROR) {
if (!try_auto_path) {
try_auto_path = 1;
continue;
}
bu_log("Tcl_Init ERROR:\n%s\n", Tcl_GetStringResult(*interpreter));
break;
}
init_tcl = 0;
/* Initialize [incr Tcl] */
Tcl_ResetResult(*interpreter);
/* NOTE: Calling "package require Itcl" here is apparently
* insufficient without other changes elsewhere. The
* Combination Editor in mged fails with an iwidgets class
* already loaded error if we don't perform Itcl_Init() here.
*/
if (init_itcl && Itcl_Init(*interpreter) == TCL_ERROR) {
if (!try_auto_path) {
Tcl_Namespace *nsp;
try_auto_path = 1;
/* Itcl_Init() leaves initialization in a bad state
* and can cause retry failures. cleanup manually.
*/
Tcl_DeleteCommand(*interpreter, "::itcl::class");
nsp = Tcl_FindNamespace(*interpreter, "::itcl", NULL, 0);
if (nsp)
Tcl_DeleteNamespace(nsp);
continue;
}
bu_log("Itcl_Init ERROR:\n%s\n", Tcl_GetStringResult(*interpreter));
break;
}
init_itcl = 0;
/* don't actually want to loop forever */
break;
} /* end iteration over Init() routines that need auto_path */
Tcl_ResetResult(*interpreter);
/* if we haven't loaded by now, load auto_path so we find our tclscripts */
if (!try_auto_path) {
/* Locate the BRL-CAD-specific Tcl scripts */
tclcad_auto_path(*interpreter);
}
/*XXX FIXME: Should not be importing Itcl into the global namespace */
/* Import [incr Tcl] commands into the global namespace. */
if (Tcl_Import(*interpreter, Tcl_GetGlobalNamespace(*interpreter), "::itcl::*", /* allowOverwrite */ 1) != TCL_OK) {
bu_log("Tcl_Import ERROR: %s\n", Tcl_GetStringResult(*interpreter));
Tcl_ResetResult(*interpreter);
}
/* Initialize libbu */
if (Bu_Init(*interpreter) == TCL_ERROR) {
bu_log("Bu_Init ERROR:\n%s\n", Tcl_GetStringResult(*interpreter));
Tcl_ResetResult(*interpreter);
}
/* Initialize libbn */
if (Bn_Init(*interpreter) == TCL_ERROR) {
bu_log("Bn_Init ERROR:\n%s\n", Tcl_GetStringResult(*interpreter));
Tcl_ResetResult(*interpreter);
}
/* Initialize librt */
if (Rt_Init(*interpreter) == TCL_ERROR) {
bu_log("Rt_Init ERROR:\n%s\n", Tcl_GetStringResult(*interpreter));
Tcl_ResetResult(*interpreter);
}
/* Initialize libged */
if (Go_Init(*interpreter) == TCL_ERROR) {
bu_log("Ged_Init ERROR:\n%s\n", Tcl_GetStringResult(*interpreter));
Tcl_ResetResult(*interpreter);
}
BU_ALLOC(view_state->vs_gvp, struct ged_view);
ged_view_init(view_state->vs_gvp);
view_state->vs_gvp->gv_callback = mged_view_callback;
view_state->vs_gvp->gv_clientData = (void *)view_state;
MAT_DELTAS_GET_NEG(view_state->vs_orig_pos, view_state->vs_gvp->gv_center);
if (gedp) {
/* release any allocated memory */
ged_free(gedp);
} else {
BU_ALLOC(gedp, struct ged);
}
GED_INIT(gedp, NULL);
/* register commands */
cmd_setup();
history_setup();
mged_global_variable_setup(*interpreter);
mged_variable_setup(*interpreter);
/* Tcl needs to write nulls onto subscripted variable names */
bu_vls_printf(&str, "%s(state)", MGED_DISPLAY_VAR);
Tcl_SetVar(*interpreter, bu_vls_addr(&str), state_str[STATE], TCL_GLOBAL_ONLY);
/* Set defaults for view status variables */
bu_vls_trunc(&str, 0);
bu_vls_printf(&str, "set mged_display(.topid_0.ur,ang) {ang=(0.00 0.00 0.00)};\
set mged_display(.topid_0.ur,aet) {az=35.00 el=25.00 tw=0.00};\
set mged_display(.topid_0.ur,size) sz=1000.000;\
set mged_display(.topid_0.ur,center) {cent=(0.000 0.000 0.000)};\
set mged_display(units) mm");
Tcl_Eval(*interpreter, bu_vls_addr(&str));
Tcl_ResetResult(*interpreter);
bu_vls_free(&str);
}
static int backupTestCmd(
ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const*objv
){
enum BackupSubCommandEnum {
BACKUP_STEP, BACKUP_FINISH, BACKUP_REMAINING, BACKUP_PAGECOUNT
};
struct BackupSubCommand {
const char *zCmd;
enum BackupSubCommandEnum eCmd;
int nArg;
const char *zArg;
} aSub[] = {
{"step", BACKUP_STEP , 1, "npage" },
{"finish", BACKUP_FINISH , 0, "" },
{"remaining", BACKUP_REMAINING , 0, "" },
{"pagecount", BACKUP_PAGECOUNT , 0, "" },
{0, 0, 0, 0}
};
sqlite3_backup *p = (sqlite3_backup *)clientData;
int iCmd;
int rc;
rc = Tcl_GetIndexFromObjStruct(
interp, objv[1], aSub, sizeof(aSub[0]), "option", 0, &iCmd
);
if( rc!=TCL_OK ){
return rc;
}
if( objc!=(2 + aSub[iCmd].nArg) ){
Tcl_WrongNumArgs(interp, 2, objv, aSub[iCmd].zArg);
return TCL_ERROR;
}
switch( aSub[iCmd].eCmd ){
case BACKUP_FINISH: {
const char *zCmdName;
Tcl_CmdInfo cmdInfo;
zCmdName = Tcl_GetString(objv[0]);
Tcl_GetCommandInfo(interp, zCmdName, &cmdInfo);
cmdInfo.deleteProc = 0;
Tcl_SetCommandInfo(interp, zCmdName, &cmdInfo);
Tcl_DeleteCommand(interp, zCmdName);
rc = sqlite3_backup_finish(p);
Tcl_SetResult(interp, (char *)sqlite3ErrName(rc), TCL_STATIC);
break;
}
case BACKUP_STEP: {
int nPage;
if( TCL_OK!=Tcl_GetIntFromObj(interp, objv[2], &nPage) ){
return TCL_ERROR;
}
rc = sqlite3_backup_step(p, nPage);
Tcl_SetResult(interp, (char *)sqlite3ErrName(rc), TCL_STATIC);
break;
}
case BACKUP_REMAINING:
Tcl_SetObjResult(interp, Tcl_NewIntObj(sqlite3_backup_remaining(p)));
break;
case BACKUP_PAGECOUNT:
Tcl_SetObjResult(interp, Tcl_NewIntObj(sqlite3_backup_pagecount(p)));
break;
}
return TCL_OK;
}
