/*
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;
}
/*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;
}
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;
}
// 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;
}
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;
}
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;
}
/* need to reference an entry point to fool Sun's ld */
void tkstubs_dummy() {Tk_InitStubs(0, 0, 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);
}
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);
}
