Tcl/Tk Cookbook - Tcl/Tk and C Tcl/Tk Cookbook - Tcl/Tk and C
Template
The template for this script is tkAppInit.c in the Tcl/Tk source distribution ( look under the directory in which the Tk source code is placed - something like ~pdsrc/TclTk/tk4.0). Make a copy of tkAppInit.c into your current working directory. Call it myTclInit.c (This source along with the Makefile template etc. are under ~cookbook/code/ch6)
In the script below, bold letters are used to highlight customised program code and italics is used for our inserted comments in the code given below:
#ifndef lint static char sccsid[] = "@(#) tkAppInit.c 1.12 94/12/17 16:30:56"; #endif /* not lint */ #include "tcl.h" #include "tk.h" /*Include files for PHIGS & X */ #include <X11/Intrinsic.h> #include <X11/StringDefs.h> #include <X11/Xatom.h> #include <phigs/phigs.h>/*Pconnid_x_drawable is a structure that holds the id of the X window within which the PHIGS workstation will be opened*/
Pconnid_x_drawable conn_id;/*Procedures defined in phigscbs.c */ /*A PHIGS based C procedure defined in phigscbs.c to create a cube and a simple text message*/
extern int MakeCubeProc();
/*A PHIGS based C procedure defined in phigscbs.c that applies the PHIGS transformation matrix to rotate the object through a given degree and and posts the structure (object). The Angle of rotation is input by the user by moving a Tk scale widget. Editing the 3D structure and updating the workstation is handled by PHIGS. */
extern int rotate_boxProc();
/*A PHIGS based C procedure defined in phigscbs.c to redraw all structures whenever either an expose events happens or when the state of the PHIGS workststion is changed for instance when a structure is posted. Updating the workstation is handled by PHIGS.*/
extern int redrawProc();
/*A PHIGS based C procedure defined in phigscbs.c to change the colour of the displayed 3D object to that chosen from the Tk menu entry. Editing the 3D structure and updating the workstation is handled by PHIGS.*/
extern int ChColProc();
/*A PHIGS based C procedure defined in phigscbs.c to close the PHIGS workstion and close PHIGS and exit the application when the user selects the Tk Quit button.*/
extern int CleanupAndQuitProc();
Tk_Window is a Tk token that represents a window. This token is returned whenever a new Tk window is created. You can use this to query information about or manipulate a Tk window.
The procedure "Tcl_AppInit" defined after the procedure below, calls "Tk_CreateMainWindow" to create the application's main window.
Tk_Window mainwin, win;
/*This procedure sets up the PHIGS workstation to the Tk canvas widget and does some house keeping. This procedure is registered with the Tcl/Tk interpreter via the user command SetupPhigs. SetupPhigs is passed one argument - the pathname of the canvas widget. */
int SetupPhigsProc (ClientData clientdata, Tcl_Interp *interp,
int argc, char *argv[])
{
Window winid;
Pxphigs_info xphigs_info;
unsigned long mask;
XSetWindowAttributes win_attrs;
Display *dsp;
When this procedure is invoked, the pathname of the canvas widget is passed
as argv[1]. Tk_NameToWindow returns the token for the canvas widget which is
in the same application as "mainwin".
This "win" token is used to assign the necessary connection identifiers for the canvas widget to PHIGS.
Tk_Display takes a Tk_Window token as argument and returns a pointer to the structure Display - the X display of the canvas widget.
Tk_WindowId returns the X identifier for the canvas window.
win = Tk_NameToWindow(interp, (char *)argv[1], (Tk_Window) mainwin); dsp= Tk_Display(win); winid = Tk_WindowId(win); conn_id.display = dsp; conn_id.drawable_id = winid;Tell PHIGS not to monitor the colourmap etc. and open the PHIGS workstation with appropriate monitoring permissions.
mask = PXPHIGS_INFO_FLAGS_NO_MON; xphigs_info.flags.no_monitor =1; popen_xphigs (PDEF_ERR_FILE,PDEF_MEM_SIZE,mask,&xphigs_info); win_attrs.backing_store = NotUseful; XChangeWindowAttributes( dsp,winid, CWBackingStore, &win_attrs);Tk_CreateEventHandler is used to invoke a particular procedure to be invoked when a particular event selected by the given mask occurs in the window given by the first argument.
Tk_CreateEventHandler(win, ExposureMask, (Tk_EventProc *) redrawProc,NULL); return 0; }
/*
* The following variable is a special hack that is needed in order for
* Sun shared libraries to be used for Tcl.
*/
#ifdef NEED_MATHERR
extern int matherr();
int *tclDummyMathPtr = (int *) matherr;
#endif
int
Tcl_AppInit(interp)
Tcl_Interp *interp; /* Interpreter for application. */
{
mainwin = Tk_MainWindow(interp);
if (Tcl_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
if (Tk_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
/*
* Call the init procedures for included packages. Each call should
* look like this:
*
* if (Mod_Init(interp) == TCL_ERROR) {
* return TCL_ERROR;
* }
*
* where "Mod" is the name of the module.
*/
/*
* Call Tcl_CreateCommand for application-specific commands, if
* they weren't already created by the init procedures called above.
*/
Tcl_CreateCommand(interp, "SetupPhigs",
(Tcl_CmdProc *)SetupPhigsProc,(ClientData )NULL,
(Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(interp, "ChCol",
(Tcl_CmdProc *) ChColProc,(ClientData )NULL,
(Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(interp, "CleanupAndQuit",
(Tcl_CmdProc *) CleanupAndQuitProc,(ClientData )NULL,
(Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(interp, "rotate_box",
(Tcl_CmdProc *) rotate_boxProc,(ClientData )NULL,
(Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(interp, "MakeCube",
(Tcl_CmdProc *) MakeCubeProc,(ClientData )NULL,
(Tcl_CmdDeleteProc *) NULL);
/*
* Specify a user-specific startup file to invoke if the application
* is run interactively. Typically the startup file is "~/.apprc"
* where "app" is the name of the application. If this line is deleted
* then no user-specific startup file will be run under any conditions.
*/
tcl_RcFileName ="~/.myapprc";
return TCL_OK;
}
Tcl_CreateCommand registers a user defined command with the Tcl interpreter
interp in which the command will be used. The second argument to Tcl_CreateCommand is the name of the command that will be used in Tcl/Tk
scripts. The third argument is the command procedure. The clientData is used to pass on address of objects associated with the command and deleteProc
spoecifies the procedure to be invoked when the command is deleted. It is
used to free the object associated with the command as the clientData.
In this example we have created five commands which can be used in the Tcl script which is parsed with this version of the Tcl interpreter.
Note that tcl_RcFileName is required to be set to run any startup files.
/*
*----------------------------------------------------------------------
*
* main --
*
* This is the main program for the application.
*
* Results:
* None: Tk_Main never returns here, so this procedure never
* returns either.
*
* Side effects:
* Whatever the application does.
*
*----------------------------------------------------------------------
*/
int
main(argc, argv)
int argc; /* Number of command-line arguments. */
char **argv; /* Values of command-line arguments. */
{
Tk_Main(argc, argv,Tcl_AppInit);
return 0; /* Needed only to prevent compiler warning. */
}
