/* 
 * tkAppInit.c --
 *
 *	Provides a default version of the Tcl_AppInit procedure for
 *	use in wish and similar Tk-based applications.
 *
 * Copyright (c) 1993 by Sven Delmas
 * All rights reserved.
 * See the file COPYRIGHT for the copyright notes.
 *
 *
 * Copyright (c) 1993 The Regents of the University of California.
 * All rights reserved.
 *
 * Permission is hereby granted, without written agreement and without
 * license or royalty fees, to use, copy, modify, and distribute this
 * software and its documentation for any purpose, provided that the
 * above copyright notice and the following two paragraphs appear in
 * all copies of this software.
 * 
 * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
 * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
 * OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
 * CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 *
 * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
 * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
 * AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
 * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
 * PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
 */

/* This is a modified main.c from the tk wish program.
 * The "lineto", "dot" commands have been modified
 * to draw on a pixmap instead of the main window.
 * The commands "erase", "pixresize", "foreground", and "background"
 * have been added.
 */

#ifndef lint
static char *AtFSid = "$Header: pixmapDemo.c[3.0] Wed Jan 12 16:31:12 1994 garfield@garfield frozen $";
#endif /* not lint */

#include "tk.h"

#if (TK_MAJOR_VERSION >= 3) && (TK_MINOR_VERSION >= 3)
/*
 * The following variable is a special hack that allows applications
 * to be linked using the procedure "main" from the Tk library.  The
 * variable generates a reference to "main", which causes main to
 * be brought in from the library (and all of Tk and Tcl with it).
 */

extern int main();
int *tclDummyMainPtr = (int *) main;

int x, y;
Tk_Window myW;
GC myGC;
Pixmap myPixmap;
#else
#include "tkConfig.h"
#include "tkInt.h"

/*
 * Declarations for library procedures:
 */
extern int isatty();

/*
 * Command used to initialize wish:
 */
char initCmd[] = "source $tk_library/wish.tcl";

Tk_Window myW;			/* NULL means window has been deleted. */
GC myGC;
Pixmap myPixmap;
Tk_TimerToken timeToken = 0;
int idleHandler = 0;
Tcl_Interp *interp;
int x, y;
Tcl_CmdBuf buffer;
int tty;

/*
 * Information for testing out command-line options:
 */

int synchronize = 0;
char *fileName = NULL;
char *name = NULL;
char *display = NULL;
char *geometry = NULL;

Tk_ArgvInfo argTable[] = {
    {"-file", TK_ARGV_STRING, (char *) NULL, (char *) &fileName,
	"File from which to read commands"},
    {"-geometry", TK_ARGV_STRING, (char *) NULL, (char *) &geometry,
	"Initial geometry for window"},
    {"-display", TK_ARGV_STRING, (char *) NULL, (char *) &display,
	"Display to use"},
    {"-name", TK_ARGV_STRING, (char *) NULL, (char *) &name,
	"Name to use for application"},
    {"-sync", TK_ARGV_CONSTANT, (char *) 1, (char *) &synchronize,
	"Use synchronous mode for display server"},
    {(char *) NULL, TK_ARGV_END, (char *) NULL, (char *) NULL,
	(char *) NULL}
};
#endif

void DefineAndGetPixmap( interp, lenx, leny)
    Tcl_Interp *interp;			/* Current interpreter. */
    int		lenx, leny;
{
    Tk_Uid pixname = Tk_GetUid("thepixmap");

#if defined(TK_MAJOR_VERSION) || defined(TK_MAJOR_NUMBER)
    if ( Tk_DefinePixmap(interp, pixname, NULL, NULL, NULL, None,
			 lenx, leny, 0, "xpm3") != TCL_OK ) {
	fprintf(stderr, "Tk_DefinePixmap: %s\n", interp->result);
	exit(1);
    }
#else
    if ( Tk_DefinePixmap(interp, pixname, NULL, NULL, NULL, None,
			 lenx, leny, 0) != TCL_OK ) {
	fprintf(stderr, "Tk_DefinePixmap: %s\n", interp->result);
	exit(1);
    }
#endif
    if ( (myPixmap = Tk_GetPixmap(interp, myW, pixname)) == None ) {
	fprintf(stderr, "Tk_GetPixmap: %s\n", interp->result);
	exit(1);
    }
}

	/* ARGSUSED */
int
DotCmd(dummy, interp, argc, argv)
    ClientData dummy;			/* Not used. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int argc;				/* Number of arguments. */
    char **argv;			/* Argument strings. */
{
    int x, y;

    if (argc != 3) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" x y\"", (char *) NULL);
	return TCL_ERROR;
    }
    x = strtol(argv[1], (char **) NULL, 0);
    y = strtol(argv[2], (char **) NULL, 0);
    XDrawPoint(Tk_Display(myW), myPixmap,
	    myGC, x, y);
    return TCL_OK;
}

	/* ARGSUSED */
int
MovetoCmd(dummy, interp, argc, argv)
    ClientData dummy;			/* Not used. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int argc;				/* Number of arguments. */
    char **argv;			/* Argument strings. */
{
  
    if (argc != 3) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" x y\"", (char *) NULL);
	return TCL_ERROR;
    }
    x = strtol(argv[1], (char **) NULL, 0);
    y = strtol(argv[2], (char **) NULL, 0);
    return TCL_OK;
}

	/* ARGSUSED */
int
LinetoCmd(dummy, interp, argc, argv)
    ClientData dummy;			/* Not used. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int argc;				/* Number of arguments. */
    char **argv;			/* Argument strings. */
{
    int newX, newY;

    if (argc != 3) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" x y\"", (char *) NULL);
	return TCL_ERROR;
    }
    newX = strtol(argv[1], (char **) NULL, 0);
    newY = strtol(argv[2], (char **) NULL, 0);
    XDrawLine(Tk_Display(myW), myPixmap,
	    myGC, x, y, newX, newY);
    x = newX;
    y = newY;
    return TCL_OK;
}

void UndefineAndFreePixmap( interp)
    Tcl_Interp *interp;			/* Current interpreter. */
{
    Tk_Uid pixname = Tk_GetUid("thepixmap");

    if ( Tk_UndefinePixmap(interp, pixname, myW) != TCL_OK ) {
	fprintf(stderr, "Tk_UndefinePixmap: %s\n", interp->result);
	exit(1);
    }
#if defined(TK_MAJOR_VERSION) || defined(TK_MAJOR_NUMBER)
    Tk_FreePixmap(Tk_Display(myW), myPixmap);
#else
    Tk_FreePixmap(myPixmap);
#endif
}

	/* ARGSUSED */
int
PixresizeCmd(dummy, interp, argc, argv)
    ClientData dummy;			/* Not used. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int argc;				/* Number of arguments. */
    char **argv;			/* Argument strings. */
{
    int	lenx, leny;

    if (argc != 3) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" x y\"", (char *) NULL);
	return TCL_ERROR;
    }
    lenx = strtol(argv[1], (char **) NULL, 0);
    leny = strtol(argv[2], (char **) NULL, 0);
    UndefineAndFreePixmap(interp);
    DefineAndGetPixmap(interp, lenx, leny);

    return TCL_OK;
}

	/* ARGSUSED */
int
EraseCmd(dummy, interp, argc, argv)
    ClientData dummy;			/* Not used. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int argc;				/* Number of arguments. */
    char **argv;			/* Argument strings. */
{
    unsigned int	lenx, leny;

#if defined(TK_MAJOR_VERSION) || defined(TK_MAJOR_NUMBER)
    Tk_SizeOfPixmap( Tk_Display(myW), myPixmap, &lenx, &leny);
#else
    Tk_SizeOfPixmap( myPixmap, &lenx, &leny);
#endif
    XFillRectangle(Tk_Display(myW), myPixmap, myGC, 0,0, lenx, leny);
    return TCL_OK;
}

	/* ARGSUSED */
int
ForegroundCmd(dummy, interp, argc, argv)
    ClientData dummy;			/* Not used. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int argc;				/* Number of arguments. */
    char **argv;			/* Argument strings. */
{
    static XColor *pColor;
    XGCValues gcvals;

    if (argc != 2) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" color\"", (char *) NULL);
	return TCL_ERROR;
    }
    if ( pColor != NULL ) {
	Tk_FreeColor(pColor);
	pColor = NULL;
    }
    if ( (pColor = Tk_GetColor(interp,myW,NULL,Tk_GetUid(argv[1]))) == NULL )
	return TCL_ERROR;
    gcvals.foreground = pColor->pixel;
    XChangeGC(Tk_Display(myW), myGC, GCForeground, &gcvals);
    return TCL_OK;
}

	/* ARGSUSED */
int
BackgroundCmd(dummy, interp, argc, argv)
    ClientData dummy;			/* Not used. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int argc;				/* Number of arguments. */
    char **argv;			/* Argument strings. */
{
    static XColor *pColor;
    XGCValues gcvals;

    if (argc != 2) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" color\"", (char *) NULL);
	return TCL_ERROR;
    }
    if ( pColor != NULL ) {
	Tk_FreeColor(pColor);
	pColor = NULL;
    }
    if ( (pColor = Tk_GetColor(interp,myW,NULL,Tk_GetUid(argv[1]))) == NULL )
	return TCL_ERROR;
    gcvals.background = pColor->pixel;
    XChangeGC(Tk_Display(myW), myGC, GCBackground, &gcvals);
    return TCL_OK;
}

#if (TK_MAJOR_VERSION >= 3) && (TK_MINOR_VERSION >= 3)
/*
 *----------------------------------------------------------------------
 *
 * 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. */
{
    Tk_Window main;
    XGCValues gcvals;
    Window rootWin;

    main = Tk_MainWindow(interp);

    /*
     * Call the init procedures for included packages.  Each call should
     * look like this:
     *
     * if (Mod_Init(interp) == TCL_ERROR) {
     *     return TCL_ERROR;
     * }
     *
     * where "Mod" is the name of the module.
     */

    if (Tcl_Init(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }
    if (Tk_Init(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }

    /*
     * Call Tcl_CreateCommand for application-specific commands, if
     * they weren't already created by the init procedures called above.
     */
    myW = main;
    rootWin = XDefaultRootWindow(Tk_Display(myW));
    myGC = XCreateGC(Tk_Display(myW), rootWin, 0, &gcvals);
    Tk_MakeWindowExist(myW);
    DefineAndGetPixmap(interp, 30, 20);
    Tcl_CreateCommand(interp, "dot", DotCmd, (ClientData) myW,
		      (void (*)()) NULL);
    Tcl_CreateCommand(interp, "lineto", LinetoCmd, (ClientData) myW,
		      (void (*)()) NULL);
    Tcl_CreateCommand(interp, "moveto", MovetoCmd, (ClientData) myW,
		      (void (*)()) NULL);
    Tcl_CreateCommand(interp, "foreground", ForegroundCmd,
		      (ClientData) myW, (void (*)()) NULL);
    Tcl_CreateCommand(interp, "background", BackgroundCmd,
		      (ClientData) myW, (void (*)()) NULL);
    Tcl_CreateCommand(interp, "erase", EraseCmd,
		      (ClientData) myW, (void (*)()) NULL);
    Tcl_CreateCommand(interp, "pixresize", PixresizeCmd,
			  (ClientData) myW, (void (*)()) 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 = "~/.wishrc";
    return TCL_OK;
}

#else
    /* ARGSUSED */
void
StdinProc(clientData, mask)
    ClientData clientData;		/* Not used. */
    int mask;
{
    char line[200];
    static int gotPartial = 0;
    char *cmd;
    int result;

    if (mask & TK_READABLE) {
	if (fgets(line, 200, stdin) == NULL) {
	    if (!gotPartial) {
		if (tty) {
		    Tcl_Eval(interp, "destroy .", 0, (char **) NULL);
		    exit(0);
		} else {
		    Tk_DeleteFileHandler(0);
		}
		return;
	    } else {
		line[0] = 0;
	    }
	}
	cmd = Tcl_AssembleCmd(buffer, line);
	if (cmd == NULL) {
	    gotPartial = 1;
	    return;
	}
	gotPartial = 0;
	result = Tcl_RecordAndEval(interp, cmd, 0);
	if (*interp->result != 0) {
	    if ((result != TCL_OK) || (tty)) {
		printf("%s\n", interp->result);
	    }
	}
	if (tty) {
	    printf("wish: ");
	    fflush(stdout);
	}
    }
}

	/* ARGSUSED */
static void
StructureProc(clientData, eventPtr)
    ClientData clientData;	/* Information about window. */
    XEvent *eventPtr;		/* Information about event. */
{
    if (eventPtr->type == DestroyNotify) {
	myW = NULL;
    }
}

/*
 * Procedure to map initial window.  This is invoked as a do-when-idle
 * handler.  Wait for all other when-idle handlers to be processed
 * before mapping the window, so that the window's correct geometry
 * has been determined.
 */

	/* ARGSUSED */
static void
DelayedMap(clientData)
    ClientData clientData;	/* Not used. */
{

    while (Tk_DoOneEvent(TK_IDLE_EVENTS) != 0) {
	/* Empty loop body. */
    }
    if (myW == NULL) {
	return;
    }
    Tk_MapWindow(myW);
}

int
main(argc, argv)
    int argc;
    char **argv;
{
    char *args, *p, *msg;
    char buf[20];
    int result;
    Tk_3DBorder border;

    interp = Tcl_CreateInterp();
#ifdef TCL_MEM_DEBUG
    Tcl_InitMemory(interp);
#endif
    if (Tk_ParseArgv(interp, (Tk_Window) NULL, &argc, argv, argTable, 0)
	    != TCL_OK) {
	fprintf(stderr, "%s\n", interp->result);
	exit(1);
    }
    if (name == NULL) {
	if (fileName != NULL) {
	    p = fileName;
	} else {
	    p = argv[0];
	}
	name = strrchr(p, '/');
	if (name != NULL) {
	    name++;
	} else {
	    name = p;
	}
    }
    myW = Tk_CreateMainWindow(interp, display, name);
    if (myW == NULL) {
	fprintf(stderr, "%s\n", interp->result);
	exit(1);
    }
    Tk_SetClass(myW, "Tk");
    Tk_CreateEventHandler(myW, StructureNotifyMask, StructureProc,
	    (ClientData) NULL);

    Tk_DoWhenIdle(DelayedMap, (ClientData) NULL);
    tty = isatty(0);

    args = Tcl_Merge(argc-1, argv+1);
    Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);
    ckfree(args);
    sprintf(buf, "%d", argc-1);
    Tcl_SetVar(interp, "argc", buf, TCL_GLOBAL_ONLY);

    if (synchronize) {
	XSynchronize(Tk_Display(myW), True);
    }
    Tk_GeometryRequest(myW, 200, 200);
    border = Tk_Get3DBorder(interp, myW, None, "#4eee94");
    if (border == NULL) {
	Tcl_SetResult(interp, (char *) NULL, TCL_STATIC);
	Tk_SetWindowBackground(myW, WhitePixelOfScreen(Tk_Screen(myW)));
    } else {
	Tk_SetBackgroundFromBorder(myW, border);
    }
    XSetForeground(Tk_Display(myW), DefaultGCOfScreen(Tk_Screen(myW)),
	    BlackPixelOfScreen(Tk_Screen(myW)));
    Tcl_CreateCommand(interp, "dot", DotCmd, (ClientData) myW,
	    (void (*)()) NULL);
    Tcl_CreateCommand(interp, "lineto", LinetoCmd, (ClientData) myW,
	    (void (*)()) NULL);
    Tcl_CreateCommand(interp, "moveto", MovetoCmd, (ClientData) myW,
	    (void (*)()) NULL);

    /***** BEGIN new code for pixmap demo ******/
    {
	XGCValues gcvals;
	Window rootWin = XDefaultRootWindow(Tk_Display(myW));
    	myGC = XCreateGC(Tk_Display(myW), rootWin, 0, &gcvals);
	Tk_MakeWindowExist(myW);
	DefineAndGetPixmap(interp, 30, 20);
        Tcl_CreateCommand(interp, "foreground", ForegroundCmd,
	    (ClientData) myW, (void (*)()) NULL);
        Tcl_CreateCommand(interp, "background", BackgroundCmd,
            (ClientData) myW, (void (*)()) NULL);
        Tcl_CreateCommand(interp, "erase", EraseCmd,
            (ClientData) myW, (void (*)()) NULL);
        Tcl_CreateCommand(interp, "pixresize", PixresizeCmd,
            (ClientData) myW, (void (*)()) NULL);
    }
    /***** END new code for pixmap demo ******/

    if (geometry != NULL) {
	Tcl_SetVar(interp, "geometry", geometry, TCL_GLOBAL_ONLY);
    }
    result = Tcl_Eval(interp, initCmd, 0, (char **) NULL);
    if (result != TCL_OK) {
	goto error;
    }
    if (fileName != NULL) {
	result = Tcl_VarEval(interp, "source ", fileName, (char *) NULL);
	if (result != TCL_OK) {
	    goto error;
	}
	tty = 0;
    } else {
	tty = isatty(0);
	Tk_CreateFileHandler(0, TK_READABLE, StdinProc, (ClientData) 0);
	if (tty) {
	    printf("wish: ");
	}
    }
    fflush(stdout);
    buffer = Tcl_CreateCmdBuf();
    (void) Tcl_Eval(interp, "update", 0, (char **) NULL);

    Tk_MainLoop();
    Tcl_DeleteInterp(interp);
    Tcl_DeleteCmdBuf(buffer);
    exit(0);

error:
    msg = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
    if (msg == NULL) {
	msg = interp->result;
    }
    fprintf(stderr, "%s\n", msg);
    Tcl_Eval(interp, "destroy .", 0, (char **) NULL);
    exit(1);
    return 0;
}

#endif

/* eof */

