Exemple #1
0
/*
  Function : Cximage_Init

  Description :	The Init function that will be called when the extension is loaded to your tk shell

  Arguments   :	Tcl_Interp *interp    :	This is the interpreter from which the load was made and to
  which we'll add the new command


  Return value : TCL_OK in case everything is ok, or TCL_ERROR in case there is an error (Tk version < 8.3)

  Comments     : hummmm... not much, it's simple :)

*/
int Tkcximage_Init (Tcl_Interp *interp ) {

    int i;

    INITLOGS(); //
    LOG("---------------------------------"); //

    //Check Tcl version is 8.3 or higher
    if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
        return TCL_ERROR;
    }

    LOG("Tcl stub initialized"); //

    //Check TK version is 8.3 or higher
    if (Tk_InitStubs(interp, TK_VERSION, 1) == NULL) {
        return TCL_ERROR;
    }

    LOG("Tk stub initialized"); //


    LOG("Creating commands"); //

    // Create the wrapping commands in the CxImage namespace linked to custom functions with a NULL clientdata and
    // no deleteproc inside the current interpreter
    Tcl_CreateObjCommand(interp, "::CxImage::Convert", Tk_Convert,
                         (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
    Tcl_CreateObjCommand(interp, "::CxImage::Resize", Tk_Resize,
                         (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
    Tcl_CreateObjCommand(interp, "::CxImage::Colorize", Tk_Colorize,
                         (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
    Tcl_CreateObjCommand(interp, "::CxImage::Thumbnail", Tk_Thumbnail,
                         (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
    Tcl_CreateObjCommand(interp, "::CxImage::IsAnimated", Tk_IsAnimated,
                         (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);

#if ANIMATE_GIFS
    Tcl_CreateObjCommand(interp, "::CxImage::StopAnimation", Tk_DisableAnimation,
                         (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
    Tcl_CreateObjCommand(interp, "::CxImage::StartAnimation", Tk_EnableAnimation,
                         (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
    Tcl_CreateObjCommand(interp, "::CxImage::NumberOfFrames", Tk_NumberOfFrames,
                         (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
    Tcl_CreateObjCommand(interp, "::CxImage::JumpToFrame", Tk_JumpToFrame,
                         (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
    if (PlaceHook(interp) != TCL_OK) return TCL_ERROR;
#endif

    LOG("Adding format : "); //
    for (i = 0; i < AVAILABLE_FORMATS; i++) {
        Tk_CreatePhotoImageFormat(&cximageFormats[i]);
        APPENDLOG(cximageFormats[i].name); //
    }

    // end of Initialisation
    return TCL_OK;
}
Exemple #2
0
/*LINTLIBRARY*/
int
Blt_x_Init(Tcl_Interp *interp) /* Interpreter to add extra commands */
{
    Tcl_Namespace *nsPtr;
    Tcl_AppInitProc **p;
    const int isExact = 1;

#ifdef USE_TCL_STUBS
    if (Tcl_InitStubs(interp, TCL_VERSION_LOADED, isExact) == NULL) {
	return TCL_ERROR;
    };
#endif
    if (Tcl_PkgRequire(interp, "blt_core", BLT_VERSION, isExact) == NULL) {
	return TCL_ERROR;
    }

#if (_TCL_VERSION >= _VERSION(8,1,0)) 
#ifdef USE_TK_STUBS
    if (Tk_InitStubs(interp, TK_VERSION_LOADED, isExact) == NULL) {
	return TCL_ERROR;
    };
#endif
    if (Tcl_PkgPresent(interp, "Tk", TK_VERSION_LOADED, isExact) == NULL) {
	return TCL_OK;
    } 
#else
    if (Tcl_PkgRequire(interp, "Tk", TK_VERSION_LOADED, isExact) == NULL) {
	Tcl_ResetResult(interp);
	return TCL_OK;
    } 
#endif
    nsPtr = Tcl_CreateNamespace(interp, "::blt::tk", NULL, NULL);
    if (nsPtr == NULL) {
	return TCL_ERROR;
    }
    nsPtr = Tcl_FindNamespace(interp, "::blt", NULL, TCL_LEAVE_ERR_MSG);
    if (nsPtr == NULL) {
	return TCL_ERROR;
    }
    Blt_RegisterPictureImageType(interp);
    Blt_RegisterEpsCanvasItem();
    Blt_InitXRandrConfig(interp);

    /* Initialize the BLT commands that only use Tk. */
    for (p = cmdProcs; *p != NULL; p++) {
	if ((**p) (interp) != TCL_OK) {
	    Tcl_DeleteNamespace(nsPtr);
	    return TCL_ERROR;
	}
    }
    if (Tcl_PkgProvide(interp, "blt_extra", BLT_VERSION) != TCL_OK) {
	return TCL_ERROR;
    }
    return TCL_OK;
}
Exemple #3
0
int Viewimage_Init(Tcl_Interp *interp) {
	/* initialize the stub table interface */
	if (Tcl_InitStubs(interp,"8.1",0)==NULL) {
		return TCL_ERROR;
	}
	if (Tk_InitStubs(interp,"8.1",0)==NULL) {
		return TCL_ERROR;
	}
	if (Tcl_PkgRequire(interp,"Tk","8.1",0)==NULL) {
		return TCL_ERROR;
	}
	if (Tcl_PkgRequire(interp,"mvthimage","1.0",0)==NULL) {
		return TCL_ERROR;
	}
	
	/* initialize the new, alternative image context handling code */
	MvthImageState_Init(interp);

	/* Initialize the Tcl script for viewing images in a Tk window.*/
	char buff[1024];
	snprintf(buff,sizeof(buff),"%s/viewimage.tcl",TCLSCRIPTDIR);
	fprintf(stdout,"viewimage.tcl should be located at: %s\n",buff);
	Tcl_EvalFile(interp,buff);
	Tcl_VarEval(interp,
			"puts stdout {viewimage Copyright (C) 2009 Sam Bromley};",
			"puts stdout {This software comes with ABSOLUTELY NO WARRANTY.};",
			"puts stdout {This is free software, and you are welcome to};",
			"puts stdout {redistribute it under certain conditions.};",
			"puts stdout {For details, see the GNU Lesser Public License V.3 <http://www.gnu.org/licenses>.};",
			NULL);
	Tcl_VarEval(interp,
			"proc miexpand {w} {"
				"foreach {wo ho do bo} [mi size $w] break;"
				"set c [::viewimage::canvasNameFromImg $w];"
				"set wi [winfo width $c];"
				"set hi [winfo height $c];"
				"set wi [expr {$wi-3}];"
				"set hi [expr {$hi-3}];"
				"if {$wi<=0} {set wi 10};"
				"if {$hi<=0} {set hi 10};"
				"mi size $w [list $wi $hi $bo];"
				"xblitimage $w;"
			"}",NULL);
	/* Declare that we provide the buriedtargets package */
	Tcl_PkgProvide(interp,"viewimage","1.0");
	return TCL_OK;
}
Exemple #4
0
// the initialization function which installs the adapter factory
int DLLEXPORT Alsa_pcm_Init(Tcl_Interp *interp) {
  // tcl stubs and tk stubs are needed for dynamic loading,
  // you must have this set as a compiler option
#ifdef USE_TCL_STUBS
  if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
	Tcl_SetResult(interp, "Tcl_InitStubs failed",TCL_STATIC);
	return TCL_ERROR;
  }
#endif
#ifdef USE_TK_STUBS
  if (Tk_InitStubs(interp, TCL_VERSION, 1) == NULL) {
	Tcl_SetResult(interp, "Tk_InitStubs failed",TCL_STATIC);
	return TCL_ERROR;
  }
#endif
  Tcl_PkgProvide(interp, "alsa::pcm", "0.0.1");
  Tcl_CreateObjCommand(interp, "alsa::pcm", alsa_pcm, NULL, NULL);
  return TCL_OK;
}
int DLLEXPORT
Tkvideo_Init(Tcl_Interp *interp)
{
    int r = TCL_OK;
#ifdef USE_TCL_STUBS
    if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL)
        return TCL_ERROR;
#endif
#ifdef USE_TK_STUBS
    if (Tk_InitStubs(interp, TK_VERSION, 0) == NULL)
        return TCL_ERROR;
#endif
    r = VideopInit(interp);
    if (r == TCL_OK) {
        Tcl_CreateObjCommand(interp, "tkvideo", VideoObjCmd, NULL, NULL);
        r = Tcl_PkgProvide(interp, PACKAGE_NAME, PACKAGE_VERSION); 
    }
    return r;
}
Exemple #6
0
TOGL_EXTERN int
Index_Init(Tcl_Interp *interp)
{
    /* 
     * Initialize Tcl, Tk, and the Togl widget module.
     */
#ifdef USE_TCL_STUBS
    if (Tcl_InitStubs(interp, "8.1", 0) == NULL) {
        return TCL_ERROR;
    }
#endif
#ifdef USE_TK_STUBS
    if (Tk_InitStubs(interp, "8.1", 0) == NULL) {
        return TCL_ERROR;
    }
#endif

    if (Togl_Init(interp) == TCL_ERROR) {
        return TCL_ERROR;
    }

    /* 
     * Specify the C callback functions for widget creation, display,
     * and reshape.
     */
    Togl_CreateFunc(create_cb);
    Togl_DisplayFunc(display_cb);
    Togl_ReshapeFunc(reshape_cb);
    Togl_TimerFunc(timer_cb);

    /* 
     * Make a new Togl widget command so the Tcl code can set a C variable.
     */
    /* NONE */

    /* 
     * Call Tcl_CreateCommand for application-specific commands, if
     * they weren't already created by the init procedures called above.
     */
    return TCL_OK;
}
Exemple #7
0
PyObject *install(PyObject *s, PyObject *arg) {
    Tcl_Interp *trp = get_interpreter(arg);
    if(!trp) {
        PyErr_SetString(PyExc_TypeError, "get_interpreter() returned NULL");
        return NULL;
    }
    if (Tcl_InitStubs(trp, "8.1", 0) == NULL) 
    {
        PyErr_SetString(PyExc_RuntimeError, "Tcl_InitStubs returned NULL");
        return NULL;
    }
    if (Tk_InitStubs(trp, "8.1", 0) == NULL) 
    {
        PyErr_SetString(PyExc_RuntimeError, "Tk_InitStubs returned NULL");
        return NULL;
    }
    if (Tcl_PkgPresent(trp, "Togl", TOGL_VERSION, 0)) {
        Py_INCREF(Py_None);
        return Py_None;
    }
    if (Tcl_PkgProvide(trp, "Togl", TOGL_VERSION) != TCL_OK) {
        PyErr_Format(PyExc_RuntimeError, "Tcl_PkgProvide failed: %s", Tcl_GetStringResult(trp));
        return NULL;
    }

    Tcl_CreateCommand(trp, "togl", (Tcl_CmdProc *)Togl_Cmd,
                      (ClientData) Tk_MainWindow(trp), NULL);

    if(first_time) {
        Tcl_InitHashTable(&CommandTable, TCL_STRING_KEYS);
        first_time = 0;
    }

    Py_INCREF(Py_None);
    return Py_None;
}
Exemple #8
0
/* need to reference an entry point to fool Sun's ld */
void tkstubs_dummy() {Tk_InitStubs(0, 0, 0);}
Exemple #9
0
static int
Initialize (
    Tcl_Interp *interp)
{
    Tcl_Namespace *nsPtr;
    ItclObjectInfo *infoPtr;

    if (Tcl_InitStubs(interp, "8.6", 0) == NULL) {
        return TCL_ERROR;
    }
    if (Tk_InitStubs(interp, "8.6", 0) == NULL) {
        return TCL_ERROR;
    }
    if (Itcl_InitStubs(interp, "4.0.0", 0) == NULL) {
        return TCL_ERROR;
    }

    infoPtr = (ItclObjectInfo *)Tcl_GetAssocData(interp,
            ITCL_INTERP_DATA, NULL);
    nsPtr = Tcl_CreateNamespace(interp, "::itcl::widget", NULL, NULL);
    if (nsPtr == NULL) {
        Tcl_Panic("Itcl: cannot create namespace: \"%s\" \n", "::itcl::widget");
    }
    nsPtr = Tcl_CreateNamespace(interp, ITCL_WIDGETS_NAMESPACE, NULL, NULL);
    if (nsPtr == NULL) {
        Tcl_Panic("Itcl: cannot create namespace: \"%s\" \n",
	        "::itcl::widget::internal");
    }

#if 0 /* This doesn't compile ???? */
    infoPtr->windgetInfoPtr = (ItclWidgetInfo *)ckalloc(sizeof(ItclWidgetInfo));
    infoPtr->windgetInfoPtr->initObjectOpts = ItclWidgetInitObjectOptions;
    infoPtr->windgetInfoPtr->hullAndOptsInst = HullAndOptionsInstall;
    infoPtr->windgetInfoPtr->delegationInst = DelegationInstall;
    infoPtr->windgetInfoPtr->componentInst = InstallComponent;
#endif

    /*
     *  Create "itcl::builtin" namespace for commands that
     *  are automatically built into class definitions.
     */
    if (Itcl_WidgetBiInit(interp, infoPtr) != TCL_OK) {
        return TCL_ERROR;
    }

    if (ItclWidgetInfoInit(interp, infoPtr) != TCL_OK) {
        return TCL_ERROR;
    }

    /*
     *  Set up the variables containing version info.
     */

    Tcl_SetVar(interp, "::itcl::widget::version", ITCL_VERSION, TCL_NAMESPACE_ONLY);
    Tcl_SetVar(interp, "::itcl::widget::patchLevel", ITCL_PATCH_LEVEL,
            TCL_NAMESPACE_ONLY);


    /*
     *  Package is now loaded.
     */

    return Tcl_PkgProvide(interp, "itclwidget", ITCL_PATCH_LEVEL);
}
Exemple #10
0
int Tkpath_Init(Tcl_Interp *interp)		/* Tcl interpreter. */
{
        
#if defined(USE_TCL_STUBS)
    if (Tcl_InitStubs(interp, TKPATH_REQUIRE, 0) == NULL) {
	return TCL_ERROR;
    }
#endif
    if (Tcl_PkgRequire(interp, "Tcl", TKPATH_REQUIRE, 0) == NULL) {
	return TCL_ERROR;
    }
#if defined(USE_TK_STUBS)
    if (Tk_InitStubs(interp, TKPATH_REQUIRE, 0) == NULL) {
	return TCL_ERROR;
    }
#endif
    if (Tcl_PkgRequire(interp, "Tk", TKPATH_REQUIRE, 0) == NULL) {
	return TCL_ERROR;
    }
    if (Tcl_CreateNamespace(interp, "::tkp", NULL, NULL) == NULL) {
	Tcl_ResetResult(interp);
    }
    Tcl_CreateObjCommand(interp, "::tkp::canvas", Tk_PathCanvasObjCmd,
	    (ClientData) Tk_MainWindow(interp), NULL);

    gInterp = interp;

    /*
     * Link the ::tkp::antialias variable to control antialiasing. 
     */
    if (Tcl_LinkVar(interp, "::tkp::antialias",
            (char *) &gAntiAlias, TCL_LINK_BOOLEAN) != TCL_OK) {
        Tcl_ResetResult(interp);
    }
    
    /*
     * With gSurfaceCopyPremultiplyAlpha true we ignore the "premultiply alpha"
     * and use RGB as is. Else we need to divide each RGB with alpha
     * to get "true" values.
     */
    if (Tcl_LinkVar(interp, "::tkp::premultiplyalpha",
            (char *) &gSurfaceCopyPremultiplyAlpha, TCL_LINK_BOOLEAN) != TCL_OK) {
        Tcl_ResetResult(interp);
    }    
    if (Tcl_LinkVar(interp, "::tkp::depixelize",
            (char *) &gDepixelize, TCL_LINK_BOOLEAN) != TCL_OK) {
        Tcl_ResetResult(interp);
    }    
    Tcl_CreateObjCommand(interp, "::tkp::pixelalign",
            PixelAlignObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);

    /*
     * Make separate gradient objects, similar to SVG.
     */
    PathGradientInit(interp);
    SurfaceInit(interp);

    /*
     * Style object.
     */
    PathStyleInit(interp);

    return Tcl_PkgProvide(interp, "tkpath", TKPATH_PATCHLEVEL);
}