#include #include #include #include #include #include #ifdef USE_RIVET #include "rvpgplot.h" /* This includes rivet.h (which includes tcl.h & tk.h) */ #else #include #include "tkpgplot.h" /* This includes tcl.h */ #endif #include "pgxwin.h" /* * VAX VMS includes etc.. */ #ifdef VMS #include #include typedef struct dsc$descriptor_s VMS_string; #define VMS_STRING(dsc, string) \ dsc.dsc$w_length = strlen(string); \ dsc.dsc$b_dtype = DSC$K_DTYPE_T; \ dsc.dsc$b_class = DSC$K_CLASS_S; \ dsc.dsc$a_pointer = string; #endif /* * Compose the pgplot-callable driver function name. * Allow tkdriv to be calleable by FORTRAN using the two commonest * calling conventions. Both conventions append length arguments for * each FORTRAN string at the end of the argument list, and convert the * name to lower-case, but one post-pends an underscore to the function * name (PG_PPU) while the other doesn't. Note the VMS is handled * separately below. For other calling conventions you must write a * C wrapper routine to call tkdriv() or tkdriv_(). */ #ifdef PG_PPU #ifdef RIVET #define DRIV rvdriv_ /* Rivet with PG_PPU defined */ #else #define DRIV tkdriv_ /* Normal Tk with PG_PPU defined */ #endif #else #ifdef RIVET #define DRIV rvdriv /* Rivet with PG_PPU undefined */ #else #define DRIV tkdriv /* Normal Tk with PG_PPU undefined */ #endif #endif /* * List widget defaults. Note that the macros that are prefixed * TKPG_STR_ are for use in the configSpecs resource database. These * have to be strings. */ #define TKPG_MIN_WIDTH 64 /* Minimum width (pixels) */ #define TKPG_MIN_HEIGHT 64 /* Minimum height (pixels) */ #define TKPG_DEF_WIDTH 256 /* Default width (pixels) */ #define TKPG_STR_DEF_WIDTH "256" /* String version of TKPG_DEF_WIDTH */ #define TKPG_DEF_HEIGHT 256 /* Default height (pixels) */ #define TKPG_STR_DEF_HEIGHT "256" /* String version of TKPG_DEF_HEIGHT */ #define TKPG_MIN_COLORS 2 /* Min number of colors per colormap */ #define TKPG_STR_MIN_COLORS "2" /* String version of TKPG_MIN_COLORS */ #define TKPG_DEF_COLORS 100 /* Default number of colors to try for */ #define TKPG_STR_DEF_COLORS "100" /* String version of TKPG_DEF_COLORS */ #define TKPG_MAX_COLORS 255 /* Max number of colors per colormap */ #define TKPG_DEF_HIGHLIGHT_WIDTH 2 /* Default width of traversal highlight */ #define TKPG_STR_DEF_HIGHLIGHT_WIDTH "2"/* String ver of TKPG_DEF_HIGHLIGHT_WIDTH */ #define TKPG_STR_MARGIN_DEF "20" /* The default number of pixels of */ /* extra space to allocate around the */ /* edge of the plot area. */ /* * Specify the name to prefix errors with. */ #define TKPG_IDENT "PgplotWidget" typedef struct TkPgplot TkPgplot; /* * Declare a container for a list of PGPLOT widgets. */ typedef struct { TkPgplot *head; /* The head of the list of widgets */ } TkPgplotList; /* * A context descriptor for managing parent ScrolledWindow scroll-bars. */ typedef struct { #ifdef RIVET Callback xScrollCmd; /* Rivet X-axis update-scrollbar callback */ Callback yScrollCmd; /* Rivet Y-axis update-scrollbar callback */ #else char *xScrollCmd; /* Tcl X-axis scrollbar-update command */ char *yScrollCmd; /* Tcl Y-axis scrollbar-update command */ #endif unsigned x; /* Pixmap X coordinate of top left corner of window */ unsigned y; /* Pixmap Y coordinate of top left corner of window */ } TkpgScroll; /* * This container records state-values that are modified by X events. */ typedef struct { unsigned long mask; /* Event mask registered to tkpg_EventHandler() */ int focus_acquired; /* True when we have keyboard-input focus */ int cursor_active; /* True when cursor augmentation is active */ } TkpgEvents; struct TkPgplot { #ifdef RIVET RIVET_CLASS_DECL #endif /* Widget context */ Tk_Window tkwin; /* Tk's window object */ Display *display; /* The X display of the window */ Tcl_Interp *interp; /* The application's TCL interpreter */ char buffer[81]; /* A work buffer for constructing result strings */ /* Public resource attributes */ int max_colors; /* The max number of colors needed */ int min_colors; /* The min number of colors needed */ int req_width; /* The requested widget width (pixels) */ int req_height; /* The requested widget height (pixels) */ int highlight_thickness; /* The width of the highlight border */ XColor *highlightBgColor; /* The inactive traversal highlight color */ XColor *highlightColor; /* The active traversal highlight color */ XColor *normalFg; /* Normal foreground color (color index 1) */ Tk_3DBorder border; /* 3D border structure */ int borderWidth; /* The width of the 3D border */ int relief; /* Relief of the 3D border */ char *takeFocus; /* "1" to allow focus traversal, "0" to disallow */ Cursor cursor; /* The active cursor of the window */ int share; /* True if shared colors are desired */ int padx,pady; /* Extra padding margin widths (pixels) */ /* Private attributes */ TkPgplot *next; /* The next widget of a list of PGPLOT Xt widgets */ int tkslct_id; /* The device ID returned to PGPLOT by the */ /* open-workstation driver opcode, and used for */ /* subsequent device selection via the */ /* select-plot driver opcode */ int pgslct_id; /* The device ID returned to the application by */ /* pgopen() for subsequent device selection with */ /* the pgslct() function */ char *device; /* A possible PGPLOT cpgbeg() file string */ TkpgScroll scroll; /* Used to maintain parent scroll bars */ TkpgEvents events; /* X event context */ PgxWin *pgx; /* PGPLOT generic X-window context descriptor */ }; static TkPgplot *new_TkPgplot(Tcl_Interp *interp, Tk_Window main_w, char *name, int argc, char *argv[]); static TkPgplot *del_TkPgplot(TkPgplot *tkpg); /* * Describe all recognized widget resources. */ static Tk_ConfigSpec configSpecs[] = { {TK_CONFIG_BORDER, "-background", "background", "Background", "Black", Tk_Offset(TkPgplot, border), 0}, {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL, NULL, 0, 0}, {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground", "White", Tk_Offset(TkPgplot, normalFg), 0}, {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL, NULL, 0, 0}, {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor", "", Tk_Offset(TkPgplot, cursor), TK_CONFIG_NULL_OK}, {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth", "0", Tk_Offset(TkPgplot, borderWidth), 0}, {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *) NULL, NULL, 0, 0}, {TK_CONFIG_RELIEF, "-relief", "relief", "Relief", "raised", Tk_Offset(TkPgplot, relief), 0}, {TK_CONFIG_PIXELS, "-height", "height", "Height", TKPG_STR_DEF_HEIGHT, Tk_Offset(TkPgplot, req_height), 0}, {TK_CONFIG_PIXELS, "-width", "width", "Width", TKPG_STR_DEF_WIDTH, Tk_Offset(TkPgplot, req_width), 0}, {TK_CONFIG_COLOR, "-highlightbackground", "highlightBackground", "HighlightBackground", "grey", Tk_Offset(TkPgplot, highlightBgColor), 0}, {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor", "White", Tk_Offset(TkPgplot, highlightColor), 0}, {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness", "HighlightThickness", TKPG_STR_DEF_HIGHLIGHT_WIDTH, Tk_Offset(TkPgplot, highlight_thickness), 0}, {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus", "0", Tk_Offset(TkPgplot, takeFocus), TK_CONFIG_NULL_OK}, #ifdef RIVET {TK_CONFIG_CUSTOM, "-xscrollcommand", "xScrollCommand", "ScrollCommand", 0, Tk_Offset(TkPgplot, scroll.xScrollCmd), TK_CONFIG_NULL_OK, &rivet_custom_callback_option}, #else {TK_CONFIG_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand", "", Tk_Offset(TkPgplot, scroll.xScrollCmd), TK_CONFIG_NULL_OK}, #endif #ifdef RIVET {TK_CONFIG_CUSTOM, "-yscrollcommand", "yScrollCommand", "ScrollCommand", 0, Tk_Offset(TkPgplot, scroll.yScrollCmd), TK_CONFIG_NULL_OK, &rivet_custom_callback_option}, #else {TK_CONFIG_STRING, "-yscrollcommand", "yScrollCommand", "ScrollCommand", "", Tk_Offset(TkPgplot, scroll.yScrollCmd), TK_CONFIG_NULL_OK}, #endif {TK_CONFIG_INT, "-mincolors", "minColors", "MinColors", TKPG_STR_MIN_COLORS, Tk_Offset(TkPgplot, min_colors), 0}, {TK_CONFIG_INT, "-maxcolors", "maxColors", "MaxColors", TKPG_STR_DEF_COLORS, Tk_Offset(TkPgplot, max_colors), 0}, {TK_CONFIG_BOOLEAN, "-share", "share", "Share", 0, Tk_Offset(TkPgplot, share), 0}, {TK_CONFIG_PIXELS, "-padx", "padX", "Pad", TKPG_STR_MARGIN_DEF, Tk_Offset(TkPgplot, padx), 0}, {TK_CONFIG_PIXELS, "-pady", "padY", "Pad", TKPG_STR_MARGIN_DEF, Tk_Offset(TkPgplot, pady), 0}, {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL, (char *) NULL, 0, 0} }; /* Enumerate the PGPLOT class widget lists */ #define TKPG_ACTIVE_WIDGETS 1 #define TKPG_FREE_WIDGETS 2 static TkPgplotList *tkpg_WidgetList(int type); static TkPgplot *tkpg_FindWidgetByName(char *name, int type, TkPgplot **prev); static TkPgplot *tkpg_FindWidgetByID(int tkslct_id, int type, TkPgplot **prev); static TkPgplot *tkpg_RemoveWidget(char *name, int type); static TkPgplot *tkpg_PrependWidget(TkPgplot *tkpg, int type); static TkPgplot *tkpg_CurrentWidget(char *context); static TkPgplot *tkpg_open_widget(char *name); static TkPgplot *tkpg_close_widget(char *name); static void tkpg_NewPixmap(PgxWin *pgx, unsigned width, unsigned height); static void tkpg_update_scroll_bars(TkPgplot *tkpg); static void tkpg_update_clip(TkPgplot *tkpg); static void tkpg_update_border(TkPgplot *tkpg); static int PgplotCmd(ClientData context, Tcl_Interp *interp, int argc, char *argv[]); static int tkpg_InstanceCommand(ClientData context, Tcl_Interp *interp, int argc, char *argv[]); static int tkpg_InstanceCommand_return(ClientData context, int iret); static int tkpg_Configure(TkPgplot *tkpg, Tcl_Interp *interp, int argc, char *argv[], int flags); static void tkpg_expose_handler(TkPgplot *tkpg, XEvent *event); static void tkpg_draw_focus_highlight(TkPgplot *tkpg); static void tkpg_draw_3d_border(TkPgplot *tkpg); static int tkpg_refresh_window(TkPgplot *tkpg); static void tkpg_ClrCursor(TkPgplot *tkpg); static void tkpg_EventHandler(ClientData context, XEvent *event); static void tkpg_CursorHandler(ClientData context, XEvent *event); static Tk_Window tkpg_toplevel_of_path(Tcl_Interp *interp, Tk_Window main_w, char *path); /* * Enumerate supported pgband() cursor types. */ typedef enum { TKPG_NORM_CURSOR = 0, /* Un-augmented X cursor */ TKPG_LINE_CURSOR = 1, /* Line cursor between ref and pointer */ TKPG_RECT_CURSOR = 2, /* Rectangular cursor between ref and pointer */ TKPG_YRNG_CURSOR = 3, /* Two horizontal lines, at ref.x and pointer.x */ TKPG_XRNG_CURSOR = 4, /* Two vertical lines, at ref.y and pointer.y */ TKPG_HLINE_CURSOR = 6, /* Horizontal line cursor at y=ref.y */ TKPG_VLINE_CURSOR = 5, /* Vertical line cursor at x=ref.x */ TKPG_CROSS_CURSOR = 7 /* Cross-hair cursor centered on the pointer */ } TkpgCursorMode; static int tkpg_SetCursor(TkPgplot *tkpg, TkpgCursorMode mode, float xref, float yref, int ci); #ifdef RIVET static void tkpg_FreeProc(ClientData context); #else static void tkpg_FreeProc(char *context); #endif static int tkpg_scrollbar_callback(TkPgplot *tkpg, Tcl_Interp *interp, char *widget, char *view, int argc, char *argv[]); static int tkpg_scrollbar_error(TkPgplot *tkpg, Tcl_Interp *interp, char *widget, char *view, int argc, char *argv[]); static int tkpg_tcl_setcursor(TkPgplot *tkpg, Tcl_Interp *interp, int argc, char *argv[]); static int tkpg_tcl_world(TkPgplot *tkpg, Tcl_Interp *interp, char *widget, int argc, char *argv[]); static int tkpg_tcl_pixel(TkPgplot *tkpg, Tcl_Interp *interp, char *widget, int argc, char *argv[]); static int tkpg_tcl_id(TkPgplot *tkpg, Tcl_Interp *interp, char *widget, int argc, char *argv[]); static int tkpg_tcl_device(TkPgplot *tkpg, Tcl_Interp *interp, char *widget, int argc, char *argv[]); #ifdef RIVET static void del_RvPgplot(ClientData obj); static Rivet_class_struct PgplotClassObj = { 0, "Pgplot", PgplotCmd, tkpg_InstanceCommand, del_RvPgplot, 0, configSpecs, 0, }; Rivetclass PgplotClass = &PgplotClassObj; #endif /* * The following file-scope container records the list of active and * inactive PGPLOT widgets. */ static struct { int id_counter; /* Used to give widgets unique identifiers */ TkPgplotList active_widgets; /* List of active widgets */ TkPgplotList free_widgets; /* List of unnassigned widgets */ } tkPgplotClassRec = { 0, /* id_counter */ {NULL}, /* active_widgets */ {NULL}, /* free_widgets */ }; /* * The following macro defines the event mask used by the cursor event * handler. It is here to ensure that Tk_CreateEventHandler() and * Tk_DeleteEventHandler() are presented with identical event masks. */ #define CURSOR_EVENT_MASK ((unsigned long)(EnterWindowMask | LeaveWindowMask | \ PointerMotionMask)) /* * The following macro defines the event mask normally used by the widget. */ #define NORMAL_EVENT_MASK ((unsigned long)(StructureNotifyMask | \ ExposureMask | FocusChangeMask)) /*....................................................................... * Provide a package initialization procedure. This creates the Tcl * "pgplot" widget creation command. * * Input: * interp Tcl_Interp * The TCL interpreter of the application. * Output: * return int TCL_OK - Success. * TCL_ERROR - Failure. */ #ifdef RIVET int Rvpgplot_Init(Tcl_Interp *interp) #else int Tkpgplot_Init(Tcl_Interp *interp) #endif { /* * Get the main window of the application. */ Tk_Window main_w = Tk_MainWindow(interp); /* * If Tk_Init() hasn't been called, then there won't be a main window * yet. In such cases, Tk_MainWindow() places a suitable error message * in interp->result. */ if(!main_w) return TCL_ERROR; /* * Create the TCL command that is to be used for creating PGPLOT widgets. */ Tcl_CreateCommand(interp, "pgplot", PgplotCmd, (ClientData) main_w, 0); return TCL_OK; } /*....................................................................... * This function provides the TCL command that creates a PGPLOT widget. * * Input: * context ClientData The client_data argument specified in * TkPgplot_Init() when PgplotCmd was registered. * This is the main window cast to (ClientData). * interp Tcl_Interp * The TCL intrepreter. * argc int The number of command arguments. * argv char ** The array of 'argc' command arguments. * argv[0] = "pgplot" * argv[1] = the name to give the new widget. * argv[2..argc-1] = attribute settings. * Output: * return int TCL_OK - Success. * TCL_ERROR - Failure. */ static int PgplotCmd(ClientData context, Tcl_Interp *interp, int argc, char *argv[]) { Tk_Window main_tkw = (Tk_Window)context; /* The application main window */ TkPgplot *tkpg; /* The new widget instance object */ /* * Make sure that a name for the new widget has been provided. */ if(argc < 2) { Tcl_AppendResult(interp, "Wrong number of arguments - should be \'", argv[0], " pathName \?options\?\'", NULL); return TCL_ERROR; }; /* * Allocate the widget-instance object. */ tkpg = new_TkPgplot(interp, main_tkw, argv[1], argc-2, argv+2); if(!tkpg) return TCL_ERROR; return TCL_OK; } /*....................................................................... * Create a new widget instance object. * * Input: * interp Tcl_Interp * The TCL interpreter object. * main_w Tk_Window The main window of the application. * name char * The name to give the new widget. * argc int The number of argument in argv[] * argv char ** Any configuration arguments. * Output: * return TkPgplot * The new PGPLOT widget, or NULL on error. * If NULL is returned then the context of the * error will have been recorded in the result * field of the interpreter. */ static TkPgplot *new_TkPgplot(Tcl_Interp *interp, Tk_Window main_w, char *name, int argc, char *argv[]) { TkPgplot *tkpg; /* The new widget object */ PgxWin *pgx; /* The PGPLOT X window object of the widget */ Tk_Window top_w; /* The top-level window parent of 'name' */ /* * Get the toplevel window associated with the pathname in 'name'. */ top_w = tkpg_toplevel_of_path(interp, main_w, name); if(!top_w) return NULL; /* * Allocate the container. */ tkpg = (TkPgplot *) malloc(sizeof(TkPgplot)); if(!tkpg) { Tcl_AppendResult(interp, "Insufficient memory to create ", name, NULL); return NULL; }; /* * Before attempting any operation that might fail, initialize the container * at least up to the point at which it can safely be passed to * del_TkPgplot(). */ tkpg->tkwin = NULL; tkpg->display = Tk_Display(main_w); tkpg->interp = interp; tkpg->max_colors = TKPG_DEF_COLORS; tkpg->min_colors = TKPG_MIN_COLORS; tkpg->req_width = TKPG_DEF_WIDTH; tkpg->req_height = TKPG_DEF_HEIGHT; tkpg->highlight_thickness = TKPG_DEF_HIGHLIGHT_WIDTH; tkpg->highlightBgColor = NULL; tkpg->highlightColor = NULL; tkpg->normalFg = NULL; tkpg->border = NULL; tkpg->borderWidth = 0; tkpg->relief = TK_RELIEF_RAISED; tkpg->takeFocus = NULL; tkpg->cursor = None; tkpg->share = 0; tkpg->padx = 0; tkpg->pady = 0; tkpg->next = NULL; tkpg->tkslct_id = tkPgplotClassRec.id_counter++; tkpg->pgslct_id = 0; tkpg->device = NULL; tkpg->scroll.xScrollCmd = NULL; tkpg->scroll.yScrollCmd = NULL; tkpg->scroll.x = 0; tkpg->scroll.y = 0; tkpg->events.mask = NoEventMask; tkpg->events.focus_acquired = 0; tkpg->events.cursor_active = 0; tkpg->pgx = NULL; /* * Allocate the PGPLOT-window context descriptor. */ pgx = tkpg->pgx = new_PgxWin(tkpg->display, Tk_ScreenNumber(top_w), (void *) tkpg, name, 0, tkpg_NewPixmap); if(!pgx) { Tcl_AppendResult(interp, "Unable to create Pgplot window object for: ", name, NULL); return NULL; }; /* * Compose a sample PGPLOT device-specification for use in opening this * widget to PGPLOT. */ tkpg->device = (char *) malloc(sizeof(char) * (strlen(name)+1+strlen(TK_PGPLOT_DEVICE)+1)); if(!tkpg->device) { Tcl_AppendResult(interp, "Insufficient memory for ", name, NULL); return NULL; }; sprintf(tkpg->device, "%s/%s", name, TK_PGPLOT_DEVICE); /* * Ensure that the toplevel window parent of the new window exists, * before attempting to determine its visual. */ Tk_MakeWindowExist(top_w); /* * Create the widget window from the specified path. */ tkpg->tkwin = Tk_CreateWindowFromPath(interp, main_w, name, NULL); if(!tkpg->tkwin) return del_TkPgplot(tkpg); /* * Give the widget a class name. */ Tk_SetClass(tkpg->tkwin, "Pgplot"); /* * Register an event handler. */ tkpg->events.mask = NORMAL_EVENT_MASK; Tk_CreateEventHandler(tkpg->tkwin, tkpg->events.mask, tkpg_EventHandler, (ClientData) tkpg); /* * Create the TCL command that will allow users to configure the widget. */ Tcl_CreateCommand(interp, name, tkpg_InstanceCommand, (ClientData) tkpg, 0); /* * Parse command line defaults into tkpg so that tkpg->min_colors, * tkpg->max_colors and tkpg->share are known. */ if(Tk_ConfigureWidget(interp, tkpg->tkwin, configSpecs, argc, argv, (char *) tkpg, 0) == TCL_ERROR) return del_TkPgplot(tkpg); /* * If requested, try to allocate read/write colors. * If this fails arrange to try shared colors. */ if(!tkpg->share && !pgx_window_visual(pgx, Tk_WindowId(top_w), tkpg->min_colors, tkpg->max_colors, 0)) tkpg->share = 1; /* * Allocate shared colors? */ if(tkpg->share) { if(!pgx_window_visual(pgx, Tk_WindowId(top_w), tkpg->min_colors, tkpg->max_colors, 1)) { Tcl_AppendResult(interp, "Unable to allocate any colors for ",name,NULL); return del_TkPgplot(tkpg); }; }; /* * Force Tk to create the window. */ Tk_MakeWindowExist(tkpg->tkwin); /* * Fill in details about the window in pgx. */ pgx->window = Tk_WindowId(tkpg->tkwin); /* * Create and initialize a graphical context descriptor. This is where * Line widths, line styles, fill styles, plot color etc.. are * recorded. */ { XGCValues gcv; gcv.graphics_exposures = False; pgx_start_error_watch(pgx); pgx->expose_gc = XCreateGC(pgx->display, pgx->window, (unsigned long) (GCGraphicsExposures), &gcv); if(pgx_end_error_watch(pgx) || pgx->expose_gc==NULL) { Tcl_AppendResult(interp, "Failed to allocate a graphical context for ", name, NULL); return del_TkPgplot(tkpg); }; }; /* * Parse the command-line arguments again and install the relevant * defaults into the color descriptor created by pgx_window_visual(). */ if(tkpg_Configure(tkpg, interp, argc, argv, 0)) return del_TkPgplot(tkpg); /* * If the widget has scroll-bars make sure that they agree with the * window. */ tkpg_update_scroll_bars(tkpg); tkpg_update_clip(tkpg); /* * Replace the share configuration attribute with the actual * value that was acheived. */ tkpg->share = pgx->color->readonly; /* * Prepend the new widget to the list of unassigned widgets to be * used by pgbeg(). */ tkpg_PrependWidget(tkpg, TKPG_FREE_WIDGETS); /* * Return the widget name. */ Tcl_SetResult(interp, Tk_PathName(tkpg->tkwin), TCL_STATIC); return tkpg; } /*....................................................................... * Delete a TkPgplot widget. * * Input: * tkpg TkPgplot * The widget to be deleted. * Output: * return TkPgplot * Always NULL. */ static TkPgplot *del_TkPgplot(TkPgplot *tkpg) { if(tkpg) { if(tkpg->pgx) { PgxWin *pgx = tkpg->pgx; /* * Remove the device from the appropriate list of PGPLOT widgets. */ tkpg_RemoveWidget(pgx->name, pgx->state ? TKPG_ACTIVE_WIDGETS : TKPG_FREE_WIDGETS); /* * Delete the Tcl command attached to the widget. */ Tcl_DeleteCommand(tkpg->interp, pgx->name); /* * Delete the window context descriptor. */ tkpg->pgx = del_PgxWin(tkpg->pgx); }; /* * Delete the device name string. */ if(tkpg->device) free(tkpg->device); tkpg->device = NULL; /* * Clear the cursor. */ tkpg_ClrCursor(tkpg); /* * Delete resource values. */ if(tkpg->display) Tk_FreeOptions(configSpecs, (char *) tkpg, tkpg->display, 0); /* * Remove the DestroyNotify event handler before destroying the * window. Otherwise this function would call itself recursively * and pgx would be free'd twice. */ if(tkpg->events.mask != NoEventMask) { Tk_DeleteEventHandler(tkpg->tkwin, tkpg->events.mask, tkpg_EventHandler, (ClientData) tkpg); tkpg->events.mask = NoEventMask; }; /* * Zap the window. */ if(tkpg->tkwin) { Tk_DestroyWindow(tkpg->tkwin); tkpg->tkwin = NULL; }; /* * Delete the container. */ free(tkpg); }; return NULL; } #ifdef RIVET /*....................................................................... * This is a rivet-friendly wrapper around del_TkPgplot(). */ static void del_RvPgplot(ClientData obj) { del_TkPgplot((TkPgplot *) obj); } #endif /*....................................................................... * This function is called upon by the pgxwin toolkit whenever the * pixmap used as backing store needs to be resized. * * Input: * pgx PgxWin * The pgxwin toolkit context descriptor. * width unsigned The desired new pixmap width. * height unsigned The desired new pixmap height. */ static void tkpg_NewPixmap(PgxWin *pgx, unsigned width, unsigned height) { TkPgplot *tkpg = (TkPgplot *) pgx->context; /* * Reset the scrollbars then hand the job of allocating the * pixmap back to the pgxwin toolkit. */ tkpg->scroll.x = 0; tkpg->scroll.y = 0; tkpg_update_scroll_bars(tkpg); pgx_new_pixmap(pgx, width, height); return; } /*....................................................................... * Whenever the size of a pixmap and/or window of a PGPLOT winget are * changed, this function should be called to adjust scroll bars. * * Input: * tkpg TkPgplot * The pgplot widget instance. */ static void tkpg_update_scroll_bars(TkPgplot *tkpg) { TkpgScroll *scroll = &tkpg->scroll; #ifndef RIVET char scroll_args[60]; /* Scrollbar set-command arguments */ #endif /* * Block widget deletion, so that if one of the scroll-bar callbacks * deletes the widget we won't end up using a deleted tkpg pointer. */ Tk_Preserve((ClientData)tkpg); /* * Update the horizontal scroll-bar if there is one. */ if(scroll->xScrollCmd) { double pixmap_width = pgx_pixmap_width(tkpg->pgx); double first, last; if(pixmap_width < 1.0) { first = 0.0; last = 1.0; } else { first = scroll->x / pixmap_width; last = (scroll->x + Tk_Width(tkpg->tkwin)) / pixmap_width; }; #ifdef RIVET rivet_scrollbar_update((Rivetobj)tkpg, scroll->xScrollCmd, first, last); #else sprintf(scroll_args, " %f %f", first, last); (void) Tcl_VarEval(tkpg->interp, scroll->xScrollCmd, scroll_args, NULL); #endif }; /* * Update the vertical scroll-bar if there is one. */ if(scroll->yScrollCmd) { double pixmap_height = pgx_pixmap_height(tkpg->pgx); double first, last; if(pixmap_height < 1.0) { first = 0.0; last = 1.0; } else { first = scroll->y / pixmap_height; last = (scroll->y + Tk_Height(tkpg->tkwin)) / pixmap_height; }; #ifdef RIVET rivet_scrollbar_update((Rivetobj)tkpg, scroll->yScrollCmd, first, last); #else sprintf(scroll_args, " %f %f", first, last); (void) Tcl_VarEval(tkpg->interp, scroll->yScrollCmd, scroll_args, NULL); #endif }; /* * Tell pgplot about the current scroll and pan values. */ pgx_scroll(tkpg->pgx, scroll->x, scroll->y); /* * Unblock widget deletion. */ Tk_Release((ClientData)tkpg); return; } /*....................................................................... * Update the clip-area of the window to prevent pgxwin functions from * drawing over the highlight-borders. * * Input: * tkpg TkPgplot * The pgplot widget instance. */ static void tkpg_update_clip(TkPgplot *tkpg) { (void) pgx_update_clip(tkpg->pgx, 1, Tk_Width(tkpg->tkwin), Tk_Height(tkpg->tkwin), tkpg->highlight_thickness + tkpg->borderWidth); } /*....................................................................... * Find an inactive PGPLOT widget of a given name, open it to PGPLOT, * and move it to the head of the active list of widgets. * * Input: * name char * The name of the widget to be opened. * Output: * tkpg TkPgplot * The selected widget, or NULL on error. */ static TkPgplot *tkpg_open_widget(char *name) { TkPgplot *tkpg; /* * Remove the named widget from the free-widget list. */ tkpg = tkpg_RemoveWidget(name, TKPG_FREE_WIDGETS); if(!tkpg) { if(tkpg_FindWidgetByName(name, TKPG_ACTIVE_WIDGETS, NULL)) { fprintf(stderr, "%s: Widget %s is already open.\n", TKPG_IDENT, name); } else { fprintf(stderr, "%s: Can't open non-existent widget (%s).\n", TKPG_IDENT, name ? name : "(null)"); }; return NULL; }; /* * Pre-pend the widget to the active list. */ tkpg_PrependWidget(tkpg, TKPG_ACTIVE_WIDGETS); /* * Open the connection to the PgxWin library. */ pgx_open(tkpg->pgx); if(!tkpg->pgx->state) tkpg_close_widget(name); /* * Reset the background and foreground colors to match the current * configuration options. */ pgx_set_background(tkpg->pgx, Tk_3DBorderColor(tkpg->border)); pgx_set_foreground(tkpg->pgx, tkpg->normalFg); /* * Reset its scroll-bars. */ tkpg_update_scroll_bars(tkpg); return tkpg; } /*....................................................................... * Find an active PGPLOT widget of a given name, close it to PGPLOT and * move it to the head of the inactive list of widgets. * * Input: * name char * The name of the widget. * Output: * return TkPgplot * The selected widget, or NULL if not found. */ static TkPgplot *tkpg_close_widget(char *name) { TkPgplot *tkpg; /* * Remove the widget from the active list. */ tkpg = tkpg_RemoveWidget(name, TKPG_ACTIVE_WIDGETS); if(!tkpg) { fprintf(stderr, "%s: Request to close non-existent widget (%s).\n", TKPG_IDENT, name ? name : "(null)"); return NULL; }; /* * Remove cursor handler. */ tkpg_ClrCursor(tkpg); /* * Close the connection to the PgxWin library. */ pgx_close(tkpg->pgx); /* * Invalidate the pgslct() id. The next time that the widget is opened * to PGPLOT a different value will likely be used. */ tkpg->pgslct_id = 0; /* * Prepend the widget to the free list. */ tkpg_PrependWidget(tkpg, TKPG_FREE_WIDGETS); return tkpg; } /*....................................................................... * Lookup a widget by name from a given list of widgets. * * Input: * name char * The name of the widget. * type int The enumerated name of the list to search, * from: * TKPG_ACTIVE_WIDGETS * TKPG_FREE_WIDGETS * Output: * prev TkPgplot ** *prev will either be NULL if the widget * was at the head of the list, or be the * widget in the list that immediately precedes * the specified widget. * return TkPgplot * The located widget, or NULL if not found. */ static TkPgplot *tkpg_FindWidgetByName(char *name, int type, TkPgplot **prev) { TkPgplotList *widget_list; /* The list to be searched */ widget_list = tkpg_WidgetList(type); if(widget_list && name) { TkPgplot *last = NULL; TkPgplot *node = widget_list->head; for( ; node; last = node, node = node->next) { if(strcmp(node->pgx->name, name)==0) { if(prev) *prev = last; return node; }; }; }; /* * Widget not found. */ if(prev) *prev = NULL; return NULL; } /*....................................................................... * Lookup a widget by its PGPLOT id from a given list of widgets. * * Input: * tkslct_id int The number used by PGPLOT to select the * device. * type int The enumerated name of the list to search, * from: * TKPG_ACTIVE_WIDGETS * TKPG_FREE_WIDGETS * Output: * prev TkPgplot ** *prev will either be NULL if the widget * was at the head of the list, or be the * widget in the list that immediately precedes * the specified widget. * return TkPgplot * The located widget, or NULL if not found. */ static TkPgplot *tkpg_FindWidgetByID(int tkslct_id, int type, TkPgplot **prev) { TkPgplotList *widget_list; /* The list to be searched */ widget_list = tkpg_WidgetList(type); if(widget_list) { TkPgplot *last = NULL; TkPgplot *node = widget_list->head; for( ; node; last = node, node = node->next) { if(tkslct_id == node->tkslct_id) { if(prev) *prev = last; return node; }; }; }; /* * Widget not found. */ if(prev) *prev = NULL; return NULL; } /*....................................................................... * Lookup one of the PGPLOT class widget lists by its enumerated type. * * Input: * type int The enumerated name of the list, from: * TKPG_ACTIVE_WIDGETS * TKPG_FREE_WIDGETS * Output: * return TkPgplotList * The widget list, or NULL if not recognized. */ static TkPgplotList *tkpg_WidgetList(int type) { switch(type) { case TKPG_ACTIVE_WIDGETS: return &tkPgplotClassRec.active_widgets; case TKPG_FREE_WIDGETS: return &tkPgplotClassRec.free_widgets; default: fprintf(stderr, "tkpg_WidgetList: No such list.\n"); }; return NULL; } /*....................................................................... * Remove a given widget from one of the PGPLOT class widget lists. * * Input: * name char * The name of the widget to be removed from * the list. * type int The enumerated name of the list from which to * remove the widget, from: * TKPG_ACTIVE_WIDGETS * TKPG_FREE_WIDGETS * Output: * return TkPgplot * The removed widget, or NULL if not found. */ static TkPgplot *tkpg_RemoveWidget(char *name, int type) { TkPgplotList *widget_list; /* The list to remove the widget from */ TkPgplot *tkpg = NULL; /* The widget being removed */ TkPgplot *prev; /* The widget preceding tkpg in the list */ /* * Get the widget list. */ widget_list = tkpg_WidgetList(type); if(widget_list) { tkpg = tkpg_FindWidgetByName(name, type, &prev); if(tkpg) { if(prev) { prev->next = tkpg->next; } else { widget_list->head = tkpg->next; }; tkpg->next = NULL; }; }; return tkpg; } /*....................................................................... * Prepend a PGPLOT widget to a given PGPLOT class widget list. * * Input: * tkpg TkPgplot * The widget to add to the list. * type int The enumerated name of the list to add to, from: * TKPG_ACTIVE_WIDGETS * TKPG_FREE_WIDGETS * Output: * return TkPgplot * The added widget (the same as tkpg), or NULL * on error. */ static TkPgplot *tkpg_PrependWidget(TkPgplot *tkpg, int type) { TkPgplotList *widget_list; /* The list to prepend the widget to */ /* * Get the widget list. */ widget_list = tkpg_WidgetList(type); if(widget_list) { tkpg->next = widget_list->head; widget_list->head = tkpg; }; return tkpg; } /*....................................................................... * Return the currently selected PGPLOT device. * * Input: * context char * If no TkPgplot device is currently selected * and context!=NULL then, an error message of * the form printf("%s: ...\n", context) will * be written to stderr reporting that no * device is open. * Output: * return TkPgplot * The currently selected PGPLOT device, or * NULL if no device is currently selected. */ static TkPgplot *tkpg_CurrentWidget(char *context) { TkPgplot *tkpg = tkPgplotClassRec.active_widgets.head; if(!tkpg && context) fprintf(stderr, "%s: No /%s device is currently selected.\n", context, TK_PGPLOT_DEVICE); return tkpg; } /*....................................................................... * This is the only external entry point to the tk device driver. * It is called by PGPLOT to open, perform operations on, return * information about and close tk windows. * * Input: * ifunc int * The PGPLOT operation code to be executed. * Input/output: * rbuf float * A general buffer for input/output of float values. * nbuf int * Where relevant this is used to return the number of * elements in rbuf[]. Also used on input to specify * number of pixels in the line-of-pixels primitive. * chr char * A general buffer for string I/O. * lchr int * Where relevant this is used to send and return the * number of significant characters in chr. * Input: * len int Added to the call line by the FORTRAN compiler. * This contains the declared size of chr[]. */ #ifdef VMS void DRIV(ifunc, rbuf, nbuf, chrdsc, lchr) int *ifunc; float rbuf[]; int *nbuf; struct dsc$descriptor_s *chrdsc; /* VMS FORTRAN string descriptor */ int *lchr; { int len = chrdsc->dsc$w_length; char *chr = chrdsc->dsc$a_pointer; #else void DRIV(ifunc, rbuf, nbuf, chr, lchr, len) int *ifunc, *nbuf, *lchr; int len; float rbuf[]; char *chr; { #endif /* * Get the active widget if there is one. */ TkPgplot *tkpg = tkpg_CurrentWidget(NULL); PgxWin *pgx = tkpg ? tkpg->pgx : NULL; int i; /* * Flush buffered opcodes. */ pgx_pre_opcode(pgx, *ifunc); /* * Branch on the specified PGPLOT opcode. */ switch(*ifunc) { /*--- IFUNC=1, Return device name ---------------------------------------*/ case 1: { char *dev_name = TK_PGPLOT_DEVICE " (widget_path/" TK_PGPLOT_DEVICE ")"; strncpy(chr, dev_name, len); *lchr = strlen(dev_name); for(i = *lchr; i < len; i++) chr[i] = ' '; }; break; /*--- IFUNC=2, Return physical min and max for plot device, and range of color indices -----------------------------------------*/ case 2: rbuf[0] = 0.0; rbuf[1] = -1.0; /* Report no effective max plot width */ rbuf[2] = 0.0; rbuf[3] = -1.0; /* Report no effective max plot height */ rbuf[4] = 0.0; rbuf[5] = (pgx && !pgx->bad_device) ? pgx->color->ncol-1 : 1; *nbuf = 6; break; /*--- IFUNC=3, Return device resolution ---------------------------------*/ case 3: pgx_get_resolution(pgx, &rbuf[0], &rbuf[1]); rbuf[2] = 1.0; /* Device coordinates per pixel */ *nbuf = 3; break; /*--- IFUNC=4, Return misc device info ----------------------------------*/ case 4: chr[0] = 'I'; /* Interactive device */ chr[1] = 'X'; /* Cursor is available and opcode 27 is desired */ chr[2] = 'N'; /* No dashed lines */ chr[3] = 'A'; /* Area fill available */ chr[4] = 'T'; /* Thick lines */ chr[5] = 'R'; /* Rectangle fill available */ chr[6] = 'P'; /* Line of pixels available */ chr[7] = 'N'; /* Don't prompt on pgend */ chr[8] = 'Y'; /* Can return color representation */ chr[9] = 'N'; /* Not used */ chr[10]= 'S'; /* Area-scroll available */ *lchr = 11; break; /*--- IFUNC=5, Return default file name ---------------------------------*/ case 5: chr[0] = '\0'; /* Default name is "" */ *lchr = 0; break; /*--- IFUNC=6, Return default physical size of plot ---------------------*/ case 6: pgx_def_size(pgx, Tk_Width(tkpg->tkwin), Tk_Height(tkpg->tkwin), rbuf, nbuf); break; /*--- IFUNC=7, Return misc defaults -------------------------------------*/ case 7: rbuf[0] = 1.0; *nbuf = 1; break; /*--- IFUNC=8, Select plot ----------------------------------------------*/ case 8: { TkPgplot *new_tkpg = tkpg_FindWidgetByID((int)(rbuf[1]+0.5), TKPG_ACTIVE_WIDGETS, NULL); if(new_tkpg) { new_tkpg->pgslct_id = (int) (rbuf[0]+0.5); tkpg_RemoveWidget(new_tkpg->pgx->name, TKPG_ACTIVE_WIDGETS); tkpg_PrependWidget(new_tkpg, TKPG_ACTIVE_WIDGETS); } else { fprintf(stderr, "%s: [Select plot] No such open device.\n", TKPG_IDENT); }; }; break; /*--- IFUNC=9, Open workstation -----------------------------------------*/ case 9: /* * Assign the returned device unit number and success indicator. * Assume failure to open until the workstation is open. */ rbuf[0] = rbuf[1] = 0.0; *nbuf = 2; /* * Prepare the display name. */ if(*lchr >= len) { fprintf(stderr, "%s: Widget name too long.\n", TKPG_IDENT); return; } else { chr[*lchr] = '\0'; }; /* * Get the requested widget from the free widget list. */ tkpg = tkpg_open_widget(chr); if(!tkpg) return; rbuf[0] = tkpg->tkslct_id; /* The number used to select this device */ rbuf[1] = 1.0; *nbuf = 2; break; /*--- IFUNC=10, Close workstation ---------------------------------------*/ case 10: /* * Remove the device from the list of open devices. */ if(pgx) tkpg_close_widget(pgx->name); break; /*--- IFUNC=11, Begin picture -------------------------------------------*/ case 11: pgx_begin_picture(pgx, rbuf); break; /*--- IFUNC=12, Draw line -----------------------------------------------*/ case 12: pgx_draw_line(pgx, rbuf); break; /*--- IFUNC=13, Draw dot ------------------------------------------------*/ case 13: pgx_draw_dot(pgx, rbuf); break; /*--- IFUNC=14, End picture ---------------------------------------------*/ case 14: break; /*--- IFUNC=15, Select color index --------------------------------------*/ case 15: pgx_set_ci(pgx, (int) (rbuf[0] + 0.5)); break; /*--- IFUNC=16, Flush buffer. -------------------------------------------*/ case 16: pgx_flush(pgx); break; /*--- IFUNC=17, Read cursor. --------------------------------------------*/ case 17: if(tkpg) tkpg_ClrCursor(tkpg); pgx_read_cursor(pgx, rbuf, chr, nbuf, lchr); break; /*--- IFUNC=18, Erase alpha screen. -------------------------------------*/ /* (Not implemented: no alpha screen) */ case 18: break; /*--- IFUNC=19, Set line style. -----------------------------------------*/ /* (Not implemented: should not be called) */ case 19: break; /*--- IFUNC=20, Polygon fill. -------------------------------------------*/ case 20: pgx_poly_fill(pgx, rbuf); break; /*--- IFUNC=21, Set color representation. -------------------------------*/ case 21: { int ci = (int)(rbuf[0]+0.5); pgx_set_rgb(pgx, ci, rbuf[1],rbuf[2],rbuf[3]); if(ci==0) tkpg_update_border(tkpg); }; break; /*--- IFUNC=22, Set line width. -----------------------------------------*/ case 22: pgx_set_lw(pgx, rbuf[0]); break; /*--- IFUNC=23, Escape --------------------------------------------------*/ /* (Not implemented: ignored) */ case 23: break; /*--- IFUNC=24, Rectangle Fill. -----------------------------------------*/ case 24: pgx_rect_fill(pgx, rbuf); break; /*--- IFUNC=25, ---------------------------------------------------------*/ /* (Not implemented: ignored) */ case 25: break; /*--- IFUNC=26, Line of pixels ------------------------------------------*/ case 26: pgx_pix_line(pgx, rbuf, nbuf); break; /*--- IFUNC=27, World-coordinate scaling --------------------------------*/ case 27: pgx_set_world(pgx, rbuf); break; /*--- IFUNC=29, Query color representation ------------------------------*/ case 29: pgx_get_rgb(pgx, rbuf, nbuf); break; /*--- IFUNC=30, Scroll rectangle ----------------------------------------*/ case 30: pgx_scroll_rect(pgx, rbuf); break; /*--- IFUNC=?, ----------------------------------------------------------*/ default: fprintf(stderr, "%s: Ignoring unimplemented opcode=%d.\n", TKPG_IDENT, *ifunc); *nbuf = -1; break; }; return; } /*....................................................................... * This function services TCL commands for a given widget. * * Input: * context ClientData The tkpg widget cast to (ClientData). * interp Tcl_Interp * The TCL intrepreter. * argc int The number of command arguments. * argv char ** The array of 'argc' command arguments. * Output: * return int TCL_OK - Success. * TCL_ERROR - Failure. */ static int tkpg_InstanceCommand(ClientData context, Tcl_Interp *interp, int argc, char *argv[]) { TkPgplot *tkpg = (TkPgplot *) context; char *widget; /* The name of the widget */ char *command; /* The name of the command */ /* * Get the name of the widget. */ widget = argv[0]; /* * Get the name of the command. */ if(argc < 2) { Tcl_AppendResult(interp, "Missing arguments to ", widget, " command.", NULL); return TCL_ERROR; }; command = argv[1]; /* * Prevent untimely deletion of the widget while this function runs. * Note that following this statement you must return via * tkpg_InstanceCommand_return() to ensure that Tk_Release() gets called. */ Tk_Preserve(context); /* * Check for recognized command names. */ if(strcmp(command, "xview") == 0) { /* X-axis scroll-bar update */ return tkpg_InstanceCommand_return(context, tkpg_scrollbar_callback(tkpg, interp, widget, command, argc-2, argv+2)); } else if(strcmp(command, "yview") == 0) { /* Y-axis scroll-bar update */ return tkpg_InstanceCommand_return(context, tkpg_scrollbar_callback(tkpg, interp, widget, command, argc-2, argv+2)); } else if(strcmp(command, "configure") == 0) { /* Configure widget */ /* * Check the number of configure arguments. */ switch(argc - 2) { case 0: /* Return the values of all configuration options */ return tkpg_InstanceCommand_return(context, Tk_ConfigureInfo(interp, tkpg->tkwin, configSpecs, (char *) tkpg, NULL, 0)); break; case 1: /* Return the value of a single given configuration option */ return tkpg_InstanceCommand_return(context, Tk_ConfigureInfo(interp, tkpg->tkwin, configSpecs, (char *) tkpg, argv[2], 0)); break; default: /* Change one of more of the configuration options */ return tkpg_InstanceCommand_return(context, tkpg_Configure(tkpg, interp, argc-2, argv+2, TK_CONFIG_ARGV_ONLY)); break; }; } else if(strcmp(command, "cget") == 0) { /* Get a configuration value */ if(argc != 3) { Tcl_AppendResult(interp, "Wrong number of arguments to \"", widget, " cget\" command", NULL); return tkpg_InstanceCommand_return(context, TCL_ERROR); } else { return tkpg_InstanceCommand_return(context, Tk_ConfigureValue(interp, tkpg->tkwin, configSpecs, (char *) tkpg, argv[2], 0)); }; } else if(strcmp(command, "setcursor") == 0) { /* Augment the cursor */ return tkpg_InstanceCommand_return(context, tkpg_tcl_setcursor(tkpg, interp, argc - 2, argv + 2)); } else if(strcmp(command, "clrcursor") == 0) { /* Clear cursor augmentation */ tkpg_ClrCursor(tkpg); return tkpg_InstanceCommand_return(context, TCL_OK); } else if(strcmp(command, "world") == 0) { /* Pixel to world coordinates */ return tkpg_InstanceCommand_return(context, tkpg_tcl_world(tkpg, interp, widget, argc-2, argv+2)); } else if(strcmp(command, "pixel") == 0) { /* World to pixel coordinates */ return tkpg_InstanceCommand_return(context, tkpg_tcl_pixel(tkpg, interp, widget, argc-2, argv+2)); } else if(strcmp(command, "id") == 0) { /* PGPLOT id of widget */ return tkpg_InstanceCommand_return(context, tkpg_tcl_id(tkpg, interp, widget, argc-2, argv+2)); } else if(strcmp(command, "device") == 0) { /* PGPLOT name for the widget */ return tkpg_InstanceCommand_return(context, tkpg_tcl_device(tkpg, interp, widget, argc-2, argv+2)); }; /* * Unknown command name. */ Tcl_AppendResult(interp, "Unknown command \"", widget, " ", command, "\"", NULL); return tkpg_InstanceCommand_return(context, TCL_ERROR); } /*....................................................................... * This is a private cleanup-return function of tkpg_InstanceCommand(). * It should be used to return from said function after Tk_Preserve() has * been called. It calls Tk_Release() on the widget to unblock deletion * and returns the specified error code. * * Input: * context ClientData The tkpg widget cast to (ClientData). * iret int TCL_OK or TCL_ERROR. * Output: * return int The value of iret. */ static int tkpg_InstanceCommand_return(ClientData context, int iret) { Tk_Release(context); return iret; } /*....................................................................... * This function is services TCL commands for a given widget. * * Input: * tkpg TkPgplot * The widget record to be configured. * interp Tcl_Interp * The TCL intrepreter. * argc int The number of configuration arguments. * argv char ** The array of 'argc' configuration arguments. * flags int The flags argument of Tk_ConfigureWidget(): * 0 - No flags. * TK_CONFIG_ARGV - Override the X defaults * database and the configSpecs * defaults. * Output: * return int TCL_OK - Success. * TCL_ERROR - Failure. */ static int tkpg_Configure(TkPgplot *tkpg, Tcl_Interp *interp, int argc, char *argv[], int flags) { /* * Get the X-window pgplot object. */ PgxWin *pgx = tkpg->pgx; /* * Install the new defaults in tkpg. */ if(Tk_ConfigureWidget(interp, tkpg->tkwin, configSpecs, argc, argv, (char *) tkpg, flags) == TCL_ERROR) return TCL_ERROR; /* * Install the background color in PGPLOT color-index 0. */ pgx_set_background(pgx, Tk_3DBorderColor(tkpg->border)); /* * Install the foreground color in PGPLOT color-index 1. */ pgx_set_foreground(pgx, tkpg->normalFg); /* * Install changes to window attributes. */ { XSetWindowAttributes attr; /* The attribute-value container */ unsigned long mask = 0; /* The set of attributes that have changed */ attr.background_pixel = pgx->color->pixel[0]; mask |= CWBackPixel; attr.colormap = pgx->color->cmap; mask |= CWColormap; attr.border_pixel = pgx->color->pixel[0]; mask |= CWBorderPixel; attr.do_not_propagate_mask = ButtonPressMask | ButtonReleaseMask | KeyPressMask | KeyReleaseMask; mask |= CWDontPropagate; Tk_ChangeWindowAttributes(tkpg->tkwin, mask, &attr); }; /* * Tell Tk what window size we want. */ Tk_GeometryRequest(tkpg->tkwin, tkpg->req_width, tkpg->req_height); /* * Tell pgxwin that the clip margin may have changed. */ tkpg_update_clip(tkpg); /* * Update the optional window margins. */ pgx_set_margin(pgx, tkpg->padx, tkpg->pady); /* * Refresh the window. */ tkpg_refresh_window(tkpg); return TCL_OK; } /*....................................................................... * This is the main X event callback for Pgplot widgets. * * Input: * context ClientData The tkpg widget cast to (ClientData). * event XEvent * The event that triggered the callback. */ static void tkpg_EventHandler(ClientData context, XEvent *event) { TkPgplot *tkpg = (TkPgplot *) context; /* * Determine what type of event triggered this call. */ switch(event->type) { case ConfigureNotify: /* The window has been resized */ tkpg->scroll.x = 0; tkpg->scroll.y = 0; tkpg_update_clip(tkpg); tkpg_update_scroll_bars(tkpg); tkpg_refresh_window(tkpg); break; case DestroyNotify: /* The window has been destroyed */ /* * Delete the cursor event handler to prevent further use by user. */ tkpg_ClrCursor(tkpg); /* * Delete the main event handler to prevent prolonged use. */ Tk_DeleteEventHandler(tkpg->tkwin, tkpg->events.mask, tkpg_EventHandler, (ClientData) tkpg); /* * Tell del_TkPgplot() that we have already deleted the event mask. */ tkpg->events.mask = NoEventMask; /* * Force the functions in pgxwin.c to discard subsequent graphics. */ if(tkpg->pgx) tkpg->pgx->window = None; /* * Queue deletion of tkpg until all references to the widget have been * completed. */ Tk_EventuallyFree(context, tkpg_FreeProc); break; case FocusIn: /* Keyboard-input focus has been acquired */ tkpg->events.focus_acquired = 1; tkpg_draw_focus_highlight(tkpg); break; case FocusOut: /* Keyboard-input focus has been lost */ tkpg->events.focus_acquired = 0; tkpg_draw_focus_highlight(tkpg); break; case Expose: /* Redraw the specified area */ tkpg_expose_handler(tkpg, event); break; }; return; } /*....................................................................... * The expose-event handler for PGPLOT widgets. * * Input: * tkpg TkPgplot * The Tk Pgplot widget. * event XEvent The expose event that invoked the callback. */ static void tkpg_expose_handler(TkPgplot *tkpg, XEvent *event) { /* * Re-draw the focus-highlight border. */ tkpg_draw_focus_highlight(tkpg); /* * Re-draw the 3D borders. */ tkpg_draw_3d_border(tkpg); /* * Re-draw the damaged area. */ pgx_expose(tkpg->pgx, event); return; } /*....................................................................... * Re-draw the focus highlight border if it has a finite size. * * Input: * tkpg TkPgplot * The Tk Pgplot widget. */ static void tkpg_draw_focus_highlight(TkPgplot *tkpg) { Window w = Tk_WindowId(tkpg->tkwin); /* * Re-draw the focus-highlight border. */ if(tkpg->highlight_thickness != 0) { GC gc = Tk_GCForColor(tkpg->events.focus_acquired ? tkpg->highlightColor : tkpg->highlightBgColor, w); Tk_DrawFocusHighlight(tkpg->tkwin, gc, tkpg->highlight_thickness, w); }; return; } /*....................................................................... * Re-draw the 3D border if necessary. * * Input: * tkpg TkPgplot * The Tk Pgplot widget. */ static void tkpg_draw_3d_border(TkPgplot *tkpg) { Tk_Window tkwin = tkpg->tkwin; Window w = Tk_WindowId(tkwin); /* * Re-draw the focus-highlight border. */ if(tkpg->border && tkpg->borderWidth > 0) { int margin = tkpg->highlight_thickness; Tk_Draw3DRectangle(tkwin, w, tkpg->border, margin, margin, Tk_Width(tkwin) - 2*margin, Tk_Height(tkwin) - 2*margin, tkpg->borderWidth, tkpg->relief); }; return; } /*....................................................................... * Augment the cursor of a given widget. * * Input: * tkpg TkPgplot * The PGPLOT widget to connect a cursor to. * mode TkpgCursorMode The type of cursor augmentation. * xref,yref float The world-coordinate reference point for band-type * cursors. * ci int The color index with which to plot the cursor, * or -1 to select the current foreground color. * Output: * return int TCL_OK or TCL_ERROR. */ static int tkpg_SetCursor(TkPgplot *tkpg, TkpgCursorMode mode, float xref, float yref, int ci) { PgxWin *pgx = tkpg->pgx; float rbuf[2]; /* * Remove any existing cursor augmentation. */ tkpg_ClrCursor(tkpg); /* * Mark the cursor as active. */ tkpg->events.cursor_active = 1; /* * Convert xref, yref from world coordinates to device coordinates. */ rbuf[0] = xref; rbuf[1] = yref; pgx_world2dev(pgx, rbuf); /* * Raise the cursor. */ if(pgx_set_cursor(pgx, ci, (int)mode, 0, rbuf, rbuf)) { Tcl_AppendResult(tkpg->interp, "Unable to display cursor.\n", NULL); tkpg_ClrCursor(tkpg); return TCL_ERROR; }; /* * If the pointer is currently in the window, record its position * and draw the cursor. */ if(pgx_locate_cursor(pgx)) pgx_draw_cursor(pgx); /* * Create an event handler to handle asychronous cursor input. */ Tk_CreateEventHandler(tkpg->tkwin, CURSOR_EVENT_MASK, tkpg_CursorHandler, (ClientData) tkpg); return TCL_OK; } /*....................................................................... * This is the X event callback for Pgplot cursor events. It is called * only when the cursor augmentation has been established by * tkpg_SetCursor() and not cleared by tkpg_ClrCursor(). * * Input: * context ClientData The tkpg widget cast to (ClientData). * event XEvent * The event that triggered the callback. */ static void tkpg_CursorHandler(ClientData context, XEvent *event) { TkPgplot *tkpg = (TkPgplot *) context; PgxWin *pgx = tkpg->pgx; float rbuf[2]; char key; /* * Handle the event. Note that button-press and keyboard events * have not been selected so the return values are irrelevent. */ (void) pgx_cursor_event(pgx, event, rbuf, &key); /* * Handle errors. */ if(pgx->bad_device) tkpg_ClrCursor(tkpg); return; } /*....................................................................... * Clear the cursor of a given widget. * * tkpg TkPgplot * The widget to disconnect the cursor from. */ static void tkpg_ClrCursor(TkPgplot *tkpg) { if(tkpg) { PgxWin *pgx = tkpg->pgx; /* * Do nothing if the cursor is inactive. */ if(tkpg->events.cursor_active) { /* * Remove the current event handler. */ Tk_DeleteEventHandler(tkpg->tkwin, CURSOR_EVENT_MASK, tkpg_CursorHandler, (ClientData) tkpg); /* * Reset the cursor context to its inactive state. */ tkpg->events.cursor_active = 0; /* * Erase the cursor. */ pgx_erase_cursor(pgx); pgx_set_cursor(pgx, 0, TKPG_NORM_CURSOR, 0, NULL, NULL); }; }; return; } /*....................................................................... * Augment the cursor as specified in the arguments of the setcursor * widget command. * * Input: * tkpg TkPgplot * The widget record to be configured. * interp Tcl_Interp * The TCL intrepreter. * argc int The number of configuration arguments. * argv char ** The array of 'argc' configuration arguments. * [0] The type of cursor augmentation, from: * norm - Un-augmented X cursor * line - Line cursor between ref and pointer * rect - Rectangle between ref and pointer * yrng - Horizontal lines at ref.x & pointer.x * xrng - Vertical lines at ref.y & pointer.y * hline - Horizontal line cursor at y=ref.y * vline - Vertical line cursor at x=ref.x * cross - Pointer centered cross-hair * [1] The X-axis world coordinate at which * to anchor rect,yrng and xrng cursors. * [2] The Y-axis world coordinate at which * to anchor rect,yrng and xrng cursors. * [3] The color index of the cursor. * flags int The flags argument of Tk_ConfigureWidget(): * 0 - No flags. * TK_CONFIG_ARGV - Override the X defaults * database and the configSpecs * defaults. * Output: * return int TCL_OK - Success. * TCL_ERROR - Failure. */ static int tkpg_tcl_setcursor(TkPgplot *tkpg, Tcl_Interp *interp, int argc, char *argv[]) { TkpgCursorMode mode; /* Cursor augmentation mode */ double xref,yref; /* The X and Y reference positions of the cursor */ int ci; /* The color index used to draw the cursor */ int found = 0; /* True once the mode has been identified */ int i; /* * List the correspondence between cursor-mode names and pgband() mode * enumerators. */ struct { TkpgCursorMode mode; char *name; } modes[] = { {TKPG_NORM_CURSOR, "norm"}, /* Un-augmented X cursor */ {TKPG_LINE_CURSOR, "line"}, /* Line cursor between ref and pointer */ {TKPG_RECT_CURSOR, "rect"}, /* Rectangle between ref and pointer */ {TKPG_YRNG_CURSOR, "yrng"}, /* Horizontal lines at ref.x & pointer.x */ {TKPG_XRNG_CURSOR, "xrng"}, /* Vertical lines at ref.y & pointer.y */ {TKPG_HLINE_CURSOR, "hline"},/* Horizontal line cursor at y=ref.y */ {TKPG_VLINE_CURSOR, "vline"},/* Vertical line cursor at x=ref.x */ {TKPG_CROSS_CURSOR, "cross"},/* Pointer centered cross-hair */ }; /* * Check that we have the expected number of arguments. */ if(argc != 4) { Tcl_AppendResult(interp, "Wrong number of arguments. Should be: \"", tkpg->pgx->name, " setcursor mode x y ci", NULL); return TCL_ERROR; }; /* * Make sure that the widget is currently open to PGPLOT. */ if(tkpg->pgslct_id == 0) { Tcl_AppendResult(interp, tkpg->pgx->name, " setcursor: Widget not open to PGPLOT.", NULL); return TCL_ERROR; }; /* * Lookup the cursor mode. */ mode = TKPG_NORM_CURSOR; for(i=0; !found && idevice; } /*....................................................................... * Return the pgslct_id of the given Rivet pgplot widget. This can then * be used with the cpgslct() function to select the widget as the currently * active widget. * * Input: * widget Rivetobj A rivet pgplot widget. * Output: * return int The PGPLOT device-id. This will be 0 if the widget * is not currently open to PGPLOT. */ int rvp_device_id(Rivetobj widget) { TkPgplot *tkpg = (TkPgplot *) widget; return tkpg->pgslct_id; } /*....................................................................... * Convert from X window pixel coordinates to PGPLOT world coordinates. * * Input: * widget Rivetobj A rivet pgplot widget. * px, py int The X-window pixel coordinates to be converted. * wx, wy float * The corresponding PGPLOT world coordinates are * assigned to the variables pointed to by wx and wy. * Output: * return int 0 - OK. * 1 - Error. */ int rvp_xwin2world(Rivetobj widget, int px, int py, float *wx, float *wy) { TkPgplot *tkpg = (TkPgplot *) widget; float rbuf[2]; /* * Convert from pixels to world coordinates. */ if(pgx_win2dev(tkpg->pgx, px, py, rbuf) || pgx_dev2world(tkpg->pgx, rbuf)) return 1; /* * Assign the return values. */ *wx = rbuf[0]; *wy = rbuf[1]; return 0; } /*....................................................................... * Convert from PGPLOT world coordinates to X window pixel coordinates. * * Input: * widget Rivetobj A rivet pgplot widget. * wx, wy float The PGPLOT world coordinates to be converted. * px, py int * The corresponding X-window pixel coordinates are * assigned to the variables pointed to by px and py. * Output: * return int 0 - OK. * 1 - Error. */ int rvp_world2xwin(Rivetobj widget, float wx, float wy, int *px, int *py) { TkPgplot *tkpg = (TkPgplot *) widget; float rbuf[2]; /* * Convert from world coordinates to pixel coordinates. */ rbuf[0] = wx; rbuf[1] = wy; if(pgx_world2dev(tkpg->pgx, rbuf) || pgx_dev2win(tkpg->pgx, rbuf, px, py)) return 1; return 0; } #endif /*....................................................................... * Refresh the contents of the window. * * Input: * tkpg TkPgplot * The widget record to be configured. * Output: * return int 0 - OK. * 1 - Error. */ static int tkpg_refresh_window(TkPgplot *tkpg) { if(Tk_IsMapped(tkpg->tkwin)) { tkpg_draw_focus_highlight(tkpg); tkpg_draw_3d_border(tkpg); return pgx_scroll(tkpg->pgx, tkpg->scroll.x, tkpg->scroll.y); }; return 0; } /*....................................................................... * Whenever the color representation of the background color is changed * via PGPLOT, this function is called to update the Tk 3D border. * * Input: * tkpg TkPgplot * The associated PGPLOT widget. */ static void tkpg_update_border(TkPgplot *tkpg) { XColor *bg; /* The new background color */ char cname[20]; /* The color as a string of the form #rrrrggggbbbb */ Tk_3DBorder bd; /* The new Tk border */ /* * Get the PGPLOT background color. */ bg = &tkpg->pgx->color->xcolor[0]; /* * Tk_Get3DBorder requires a standard X color resource string. */ sprintf(cname, "#%4.4hx%4.4hx%4.4hx", bg->red, bg->green, bg->blue); bd = Tk_Get3DBorder(tkpg->interp, tkpg->tkwin, cname); if(bd) { /* * Replace the previous border with the new one. */ if(tkpg->border) Tk_Free3DBorder(tkpg->border); tkpg->border = bd; tkpg_draw_3d_border(tkpg); } else { fprintf(stderr, "Tk_Get3DBorder failed: %s\n", tkpg->interp->result); }; } /*....................................................................... * Respond to an xview or yview scrollbar command. * * Input: * tkpg TkPgplot * The widget record to be configured. * interp Tcl_Interp * The TCL intrepreter. * widget char * The name of the PGPLOT widget. * view char * "xview" or "yview". * argc int The number of configuration arguments. * argv char ** The array of 'argc' configuration arguments. * Output: * return int TCL_OK - Success. * TCL_ERROR - Failure. */ static int tkpg_scrollbar_callback(TkPgplot *tkpg, Tcl_Interp *interp, char *widget, char *view, int argc, char *argv[]) { int window_size; /* The size of the window along the direction of motion */ int pixmap_size; /* The size of the pixmap along the direction of motion */ int new_start_pos;/* The new pixmap coord of the top|left of the window */ int old_start_pos;/* The old pixmap coord of the top|left of the window */ /* * Fill in the current scroll-statistics along the requested direction. */ if(*view == 'x') { window_size = Tk_Width(tkpg->tkwin); pixmap_size = pgx_pixmap_width(tkpg->pgx); old_start_pos = tkpg->scroll.x; } else { window_size = Tk_Height(tkpg->tkwin); pixmap_size = pgx_pixmap_height(tkpg->pgx); old_start_pos = tkpg->scroll.y; }; /* * The first argument specifies what form of scrollbar command has * been received (see 'man scrollbar' for details). */ if(argc < 1) { return tkpg_scrollbar_error(tkpg, interp, widget, view, argc, argv); /* * The moveto command requests a new start position as a * fraction of the pixmap size. */ } else if(strcmp(argv[0], "moveto")==0) { double fractional_position; if(argc != 2) return tkpg_scrollbar_error(tkpg, interp, widget, view, argc, argv); /* * Read the fractional position. */ if(Tcl_GetDouble(interp, argv[1], &fractional_position) == TCL_ERROR) return TCL_ERROR; new_start_pos = fractional_position * pixmap_size; /* * The "scroll" command specifies an increment to move the pixmap by * and the units to which the increment refers. */ } else if(strcmp(argv[0], "scroll")==0) { int scroll_increment; if(argc != 3) return tkpg_scrollbar_error(tkpg, interp, widget, view, argc, argv); /* * Read the scroll-increment. */ if(Tcl_GetInt(interp, argv[1], &scroll_increment) == TCL_ERROR) return TCL_ERROR; /* * The unit of the increment can either be "units", which in our case * translates to a single pixel, or "pages", which corresponds to the * width/height of the window. */ if(strcmp(argv[2], "units")==0) { new_start_pos = old_start_pos + scroll_increment; } else if(strcmp(argv[2], "pages")==0) { int page_size = window_size - 2 * (tkpg->highlight_thickness + tkpg->borderWidth); if(page_size < 0) page_size = 0; new_start_pos = old_start_pos + scroll_increment * page_size; } else { return tkpg_scrollbar_error(tkpg, interp, widget, view, argc, argv); }; } else { Tcl_AppendResult(interp, "Unknown xview command \"", argv[0], "\"", NULL); return TCL_ERROR; }; /* * Keep the pixmap visible. */ if(new_start_pos < 0 || window_size > pixmap_size) { new_start_pos = 0; } else if(new_start_pos + window_size > pixmap_size) { new_start_pos = pixmap_size - window_size; }; /* * Record the top left corner of the new scrolling-area. */ if(*view == 'x') tkpg->scroll.x = new_start_pos; else tkpg->scroll.y = new_start_pos; /* * Update the scrolled area and the scrollbar slider. */ tkpg_update_scroll_bars(tkpg); return TCL_OK; } /*....................................................................... * This is a private error-return function of tkpg_scrollbar_callback(). * * Input: * tkpg TkPgplot * The widget record. * interp Tcl_Interp * The TCL intrepreter. * widget char * The name of the PGPLOT widget. * view char * "xview" or "yview". * argc int The number of arguments in argv. * argv char ** The array of 'argc' configuration arguments. * Output: * return int TCL_ERROR and the context of the error * is recorded in interp->result. */ static int tkpg_scrollbar_error(TkPgplot *tkpg, Tcl_Interp *interp, char *widget, char *view, int argc, char *argv[]) { int i; Tcl_AppendResult(interp, "Bad command: ", widget, " ", view, NULL); for(i=0; i\" or \"scroll -1|1 units|pages\"", NULL); return TCL_ERROR; } /*....................................................................... * Implement the Tcl world function. This converts an X-window * pixel coordinate to the corresponding PGPLOT world coordinate. * * Input: * tkpg TkPgplot * The widget record. * interp Tcl_Interp * The TCL intrepreter. * widget char * The name of the PGPLOT widget. * argc int The number of configuration arguments. * argv char ** The array of 'argc' configuration arguments. * [0] The coordinate axes to convert, from: * "x" - Convert an X-axis coord. * "y" - Convert a Y-axis coord. * "xy" - Convert a an X Y axis pair. * [1] An X-axis pixel coordinate if [0][0] is * 'x'. * A Y-axis pixel coordinate if [0][0] is * 'y'. * [2] This is only expected if [0]=="xy". It * should then contain the Y-axis * coordinate to be converted. * Output: * return int TCL_OK - Success. * TCL_ERROR - Failure. */ static int tkpg_tcl_world(TkPgplot *tkpg, Tcl_Interp *interp, char *widget, int argc, char *argv[]) { int xpix, ypix; /* The input X window coordinate */ float rbuf[2]; /* The conversion buffer */ char *axis; /* The axis specification string */ enum {BAD_AXIS, X_AXIS, Y_AXIS, XY_AXIS}; /* Enumerated axis type */ int axtype; /* The decoded axis type */ char *usage = " world [x ]|[y ]|[xy ]"; /* * Check that an axis specification argument has been provided. */ if(argc < 1) { Tcl_AppendResult(interp, "Usage: ", widget, usage, NULL); return TCL_ERROR; }; /* * Decode the axis type and check the expected argument count. */ axis = argv[0]; axtype = BAD_AXIS; switch(*axis++) { case 'x': switch(*axis++) { case 'y': if(*axis == '\0' && argc == 3) axtype = XY_AXIS; break; case '\0': if(argc == 2) axtype = X_AXIS; break; }; break; case 'y': if(*axis == '\0' && argc == 2) axtype = Y_AXIS; break; }; /* * Unrecognised axis description? */ if(axtype == BAD_AXIS) { Tcl_AppendResult(interp, "Usage: ", widget, usage, NULL); return TCL_ERROR; }; /* * Get the pixel coordinates to be converted. */ switch(axtype) { case X_AXIS: if(Tcl_GetInt(interp, argv[1], &xpix) == TCL_ERROR) return TCL_ERROR; ypix = 0; break; case Y_AXIS: xpix = 0; if(Tcl_GetInt(interp, argv[1], &ypix) == TCL_ERROR) return TCL_ERROR; break; case XY_AXIS: if(Tcl_GetInt(interp, argv[1], &xpix) == TCL_ERROR || Tcl_GetInt(interp, argv[2], &ypix) == TCL_ERROR) return TCL_ERROR; break; }; /* * Convert the pixel coordinates to world coordinates. */ pgx_win2dev(tkpg->pgx, xpix, ypix, rbuf); pgx_dev2world(tkpg->pgx, rbuf); /* * Write the world coordinate(s) into the reply string. */ switch(axtype) { case X_AXIS: Tcl_PrintDouble(interp, rbuf[0], tkpg->buffer); Tcl_AppendResult(interp, tkpg->buffer, NULL); break; case Y_AXIS: Tcl_PrintDouble(interp, rbuf[1], tkpg->buffer); Tcl_AppendResult(interp, tkpg->buffer, NULL); break; case XY_AXIS: Tcl_PrintDouble(interp, rbuf[0], tkpg->buffer); Tcl_AppendResult(interp, tkpg->buffer, NULL); Tcl_PrintDouble(interp, rbuf[1], tkpg->buffer); Tcl_AppendResult(interp, tkpg->buffer, NULL); break; }; return TCL_OK; } /*....................................................................... * Implement the Tcl pixel function. This converts PGPLOT world * coordinates to X-window pixel coordinates. * * Input: * tkpg TkPgplot * The widget record. * interp Tcl_Interp * The TCL intrepreter. * widget char * The name of the PGPLOT widget. * argc int The number of configuration arguments. * argv char ** The array of 'argc' configuration arguments. * [0] The coordinate axes to convert, from: * "x" - Convert an X-axis coord. * "y" - Convert a Y-axis coord. * "xy" - Convert a an X Y axis pair. * [1] An X-axis world coordinate if [0][0] is * 'x'. * A Y-axis world coordinate if [0][0] is * 'y'. * [2] This is only expected if [0]=="xy". It * should then contain the Y-axis * coordinate to be converted. * Output: * return int TCL_OK - Success. * TCL_ERROR - Failure. */ static int tkpg_tcl_pixel(TkPgplot *tkpg, Tcl_Interp *interp, char *widget, int argc, char *argv[]) { double wx, wy; /* The world X and Y coordinates to be converted */ int xpix, ypix; /* The output X window coordinate */ float rbuf[2]; /* The conversion buffer */ char *axis; /* The axis specification string */ enum {BAD_AXIS, X_AXIS, Y_AXIS, XY_AXIS}; /* Enumerated axis type */ int axtype; /* The decoded axis type */ char *usage = " pixel [x ]|[y ]|[xy ]"; /* * Check that an axis specification argument has been provided. */ if(argc < 1) { Tcl_AppendResult(interp, "Usage: ", widget, usage, NULL); return TCL_ERROR; }; /* * Decode the axis type and check the expected argument count. */ axis = argv[0]; axtype = BAD_AXIS; switch(*axis++) { case 'x': switch(*axis++) { case 'y': if(*axis == '\0' && argc == 3) axtype = XY_AXIS; break; case '\0': if(argc == 2) axtype = X_AXIS; break; }; break; case 'y': if(*axis == '\0' && argc == 2) axtype = Y_AXIS; break; }; /* * Unrecognised axis description? */ if(axtype == BAD_AXIS) { Tcl_AppendResult(interp, "Usage: ", widget, usage, NULL); return TCL_ERROR; }; /* * Get the pixel coordinates to be converted. */ switch(axtype) { case X_AXIS: if(Tcl_GetDouble(interp, argv[1], &wx) == TCL_ERROR) return TCL_ERROR; wy = 0; break; case Y_AXIS: wx = 0; if(Tcl_GetDouble(interp, argv[1], &wy) == TCL_ERROR) return TCL_ERROR; break; case XY_AXIS: if(Tcl_GetDouble(interp, argv[1], &wx) == TCL_ERROR || Tcl_GetDouble(interp, argv[2], &wy) == TCL_ERROR) return TCL_ERROR; break; }; /* * Convert the world coordinate to pixel coordinates. */ rbuf[0] = wx; rbuf[1] = wy; pgx_world2dev(tkpg->pgx, rbuf); pgx_dev2win(tkpg->pgx, rbuf, &xpix, &ypix); /* * Write the pixel coordinate(s) into the reply string. */ switch(axtype) { case X_AXIS: sprintf(tkpg->buffer, "%d", xpix); Tcl_AppendResult(interp, tkpg->buffer, NULL); break; case Y_AXIS: sprintf(tkpg->buffer, "%d", ypix); Tcl_AppendResult(interp, tkpg->buffer, NULL); break; case XY_AXIS: sprintf(tkpg->buffer, "%d %d", xpix, ypix); Tcl_AppendResult(interp, tkpg->buffer, NULL); break; }; return TCL_OK; } /*....................................................................... * Implement the Tcl "return PGPLOT id" function. * * Input: * tkpg TkPgplot * The widget record. * interp Tcl_Interp * The TCL intrepreter. * widget char * The name of the PGPLOT widget. * argc int The number of configuration arguments. * argv char ** The array of 'argc' configuration arguments. * (None are expected). * Output: * return int TCL_OK - Success. * TCL_ERROR - Failure. */ static int tkpg_tcl_id(TkPgplot *tkpg, Tcl_Interp *interp, char *widget, int argc, char *argv[]) { /* * There shouldn't be any arguments. */ if(argc != 0) { Tcl_AppendResult(interp, "Usage: ", widget, " id", NULL); return TCL_ERROR; }; /* * Return the id in the Tcl result string. */ sprintf(tkpg->buffer, "%d", tkpg->pgslct_id); Tcl_AppendResult(interp, tkpg->buffer, NULL); return TCL_OK; } /*....................................................................... * Implement the Tcl "return PGPLOT device specifier" function. * * Input: * tkpg TkPgplot * The widget record. * interp Tcl_Interp * The TCL intrepreter. * widget char * The name of the PGPLOT widget. * argc int The number of configuration arguments. * argv char ** The array of 'argc' configuration arguments. * (None are expected). * Output: * return int TCL_OK - Success. * TCL_ERROR - Failure. */ static int tkpg_tcl_device(TkPgplot *tkpg, Tcl_Interp *interp, char *widget, int argc, char *argv[]) { /* * There shouldn't be any arguments. */ if(argc != 0) { Tcl_AppendResult(interp, "Usage: ", widget, " device", NULL); return TCL_ERROR; }; /* * Return the device specifier in the Tcl result string. */ Tcl_AppendResult(interp, tkpg->device, NULL); return TCL_OK; } /*....................................................................... * Return the toplevel window ID of a given tk pathname. * * Input: * interp Tcl_Interp * The TCL intrepreter. * main_w Tk_Window The main window of the application. * path char * The tk path name of a window. * Output: * return Tk_Window The top-level window of the path, or NULL if * it doesn't exist. In the latter case an error * message will have been appended to interp->result. */ static Tk_Window tkpg_toplevel_of_path(Tcl_Interp *interp, Tk_Window main_w, char *path) { char *endp; /* The element in path[] following the first path component */ char *first; /* A copy of the first component of the pathname */ int length; /* The length of the first component of the pathname */ Tk_Window w; /* The Tk window of the first component of the pathname */ /* * The first character of the path should be a dot. */ if(!path || *path == '\0' || *path != '.') { Tcl_AppendResult(interp, "Unknown window: ", path ? path : "(null)", NULL); return NULL; }; /* * Find the end of the first component of the pathname. */ for(endp=path+1; *endp && *endp != '.'; endp++) ; length = endp - path; /* * Make a copy of the name of the first component of the path name. */ first = malloc(length + 1); if(!first) { Tcl_AppendResult(interp, "Ran out of memory while finding toplevel window.", NULL); return NULL; }; strncpy(first, path, length); first[length] = '\0'; /* * Lookup the corresponding window. */ w = Tk_NameToWindow(interp, first, main_w); /* * Discard the copy. */ free(first); /* * If the window doesn't exist, Tk_NameToWindow() is documented to place * an error message in interp->result, so just return the error condition. */ if(!w) return NULL; /* * If the looked up window is a toplevel window return it, otherwise * the toplevel for the specified path must be the main window. */ return Tk_IsTopLevel(w) ? w : main_w; }