myappinit.c

很不错的tcl编程实例

/* 
 * tkAppInit.c --
 *
 *	Provides a default version of the Tcl_AppInit procedure for
 *	use in wish and similar Tk-based applications.
 *
 * Copyright (c) 1993 The Regents of the University of California.
 * Copyright (c) 1994 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
#The original file is modified to include extensions and user defined
#commands  forthe AGOCG Tcl/Tk cookbook.

# Authors

# Lakshmi Sastry
# Computing and Information Systems Department
# Rutherford Appleton Laboratory, Chilton, Didcot. OX11 0QX
# [e-mail]

#                         and

# Venkat VSS Sastry
# Department of Applied Mathematics and Operational Research
# Cranfield University, RMCS Shrivenham, Swindon, SN6 8LA
# [e-mail]

# Permission to use, copy, modify, and distribute this
# software and its documentation for any purpose and without
# fee is hereby granted, provided that this copyright
# notice appears in all copies.
  
# The authors, RAL, RMCS Shrivenham, Cranfield University and AGOCG
# make no representations about the suitability of this
# software for any purpose.  It is provided "as is" without
# express or implied warranty. Likewise they accept no responsibility
# whatsoever for any public domain software modules used (which are
# hereby acknowledged) in this software 

*/

#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 routines for the PHIGS & X part */

#include <X11/Intrinsic.h>
#include <X11/StringDefs.h>
#include <X11/Xatom.h>
#include <phigs/phigs.h>

/*PHIGS identifier */
#define WS_ID		(Pint) 1

Pconnid_x_drawable conn_id;

/*procedures defined in phigscbs.c */

extern int rotate_boxProc();
extern int redrawProc();

extern int MakeCubeProc();
extern int ChColProc();
extern int CleanupAndQuitProc();
int done;
Tk_Window mainwin, win;

/*This procedure sets up the PHIGS workstation to the Tk canvas widget
and does some house keeping */

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;

win = Tk_NameToWindow(interp, (char *)argv[1], (Tk_Window) mainwin);
dsp= Tk_Display(win);
winid = Tk_WindowId(win);


mask = PXPHIGS_INFO_FLAGS_NO_MON;
xphigs_info.flags.no_monitor =1;


conn_id.display = dsp;
conn_id.drawable_id = winid;

popen_xphigs (PDEF_ERR_FILE,PDEF_MEM_SIZE,mask,&xphigs_info);

win_attrs.backing_store = NotUseful;
XChangeWindowAttributes( dsp,winid, CWBackingStore, &win_attrs);


Tk_CreateEventHandler(win, ExposureMask|StructureNotifyMask, 
	(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

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AppInit --
 *
 *	This procedure performs application-specific initialization.
 *	Most applications, especially those that incorporate additional
 *	packages, will have their own version of this procedure.
 *
 * Results:
 *	Returns a standard Tcl completion code, and leaves an error
 *	message in interp->result if an error occurs.
 *
 * Side effects:
 *	Depends on the startup script.
 *
 *----------------------------------------------------------------------
 */


int
Tcl_AppInit(interp)
    Tcl_Interp *interp;		/* Interpreter for application. */
{
    
int done =0;
    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;
}

/*
 *----------------------------------------------------------------------
 *
 * 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. */
}