diff options
author | joye <joye> | 2013-08-27 18:44:24 (GMT) |
---|---|---|
committer | joye <joye> | 2013-08-27 18:44:24 (GMT) |
commit | 48974a09f23839821ca95f228fc0f3f53bb1cefa (patch) | |
tree | 9d5cfa1305ef57b69c9b1dd09dc3ffe536c0777d /src/bltInt.C | |
parent | 05d8c009040abfcb5f62644fbb99c8ff453d4519 (diff) | |
download | blt-48974a09f23839821ca95f228fc0f3f53bb1cefa.zip blt-48974a09f23839821ca95f228fc0f3f53bb1cefa.tar.gz blt-48974a09f23839821ca95f228fc0f3f53bb1cefa.tar.bz2 |
*** empty log message ***
Diffstat (limited to 'src/bltInt.C')
-rw-r--r-- | src/bltInt.C | 375 |
1 files changed, 375 insertions, 0 deletions
diff --git a/src/bltInt.C b/src/bltInt.C new file mode 100644 index 0000000..ac4640c --- /dev/null +++ b/src/bltInt.C @@ -0,0 +1,375 @@ + +/* + * bltCoreInit.c -- + * + * This module initials the non-Tk command of the BLT toolkit, registering the + * commands with the TCL interpreter. + * + * Copyright 1991-2004 George A Howlett. + * + * Permission is hereby granted, free of charge, to any person obtaining + * a copy of this software and associated documentation files (the + * "Software"), to deal in the Software without restriction, including + * without limitation the rights to use, copy, modify, merge, publish, + * distribute, sublicense, and/or sell copies of the Software, and to + * permit persons to whom the Software is furnished to do so, subject to + * the following conditions: + * + * The above copyright notice and this permission notice shall be + * included in all copies or substantial portions of the Software. + * + * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, + * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF + * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND + * NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE + * LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION + * OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION + * WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + */ + +#include "bltInt.h" +#include "bltNsUtil.h" +#include "bltArrayObj.h" +#include "bltMath.h" + +#ifndef BLT_LIBRARY +# ifdef WIN32 +# define BLT_LIBRARY "c:/Program Files/Tcl/lib/blt"##BLT_VERSION +# else +# define BLT_LIBRARY "unknown" +# endif +#endif + +#if (_TCL_VERSION >= _VERSION(8,5,0)) +#define TCL_VERSION_LOADED TCL_PATCH_LEVEL +#else +#define TCL_VERSION_LOADED TCL_VERSION +#endif + +static double bltNaN; + +BLT_EXTERN Tcl_AppInitProc Blt_core_Init; +BLT_EXTERN Tcl_AppInitProc Blt_core_SafeInit; + +static Tcl_MathProc MinMathProc, MaxMathProc; +static char libPath[1024] = +{ + BLT_LIBRARY +}; + +/* + * Script to set the BLT library path in the variable global "blt_library" + * + * Checks the usual locations for a file (bltGraph.pro) from the BLT library. + * The places searched in order are + * + * $BLT_LIBRARY + * $BLT_LIBRARY/blt2.4 + * $BLT_LIBRARY/.. + * $BLT_LIBRARY/../blt2.4 + * $blt_libPath + * $blt_libPath/blt2.4 + * $blt_libPath/.. + * $blt_libPath/../blt2.4 + * $tcl_library + * $tcl_library/blt2.4 + * $tcl_library/.. + * $tcl_library/../blt2.4 + * $env(TCL_LIBRARY) + * $env(TCL_LIBRARY)/blt2.4 + * $env(TCL_LIBRARY)/.. + * $env(TCL_LIBRARY)/../blt2.4 + * + * The TCL variable "blt_library" is set to the discovered path. If the file + * wasn't found, no error is returned. The actual usage of $blt_library is + * purposely deferred so that it can be set from within a script. + */ + +/* FIXME: Change this to a namespace procedure in 3.0 */ + +static char initScript[] = +{"\n\ +global blt_library blt_libPath blt_version tcl_library env\n\ +set blt_library {}\n\ +set path {}\n\ +foreach var { env(BLT_LIBRARY) blt_libPath tcl_library env(TCL_LIBRARY) } { \n\ + if { ![info exists $var] } { \n\ + continue \n\ + } \n\ + set path [set $var] \n\ + if { [file readable [file join $path bltGraph.pro]] } { \n\ + set blt_library $path\n\ + break \n\ + } \n\ + set path [file join $path blt$blt_version ] \n\ + if { [file readable [file join $path bltGraph.pro]] } { \n\ + set blt_library $path\n\ + break \n\ + } \n\ + set path [file dirname [set $var]] \n\ + if { [file readable [file join $path bltGraph.pro]] } { \n\ + set blt_library $path\n\ + break \n\ + } \n\ + set path [file join $path blt$blt_version ] \n\ + if { [file readable [file join $path bltGraph.pro]] } { \n\ + set blt_library $path\n\ + break \n\ + } \n\ +} \n\ +if { $blt_library != \"\" } { \n\ + global auto_path \n\ + lappend auto_path $blt_library \n\ +}\n\ +unset var path\n\ +\n" +}; + + +static Tcl_AppInitProc *cmdProcs[] = +{ +#ifndef NO_BASE64 + Blt_Base64CmdInitProc, +#endif +#ifndef NO_BGEXEC + Blt_BgexecCmdInitProc, +#endif +#ifndef NO_PTYEXEC + Blt_PtyExecCmdInitProc, +#endif +#ifndef NO_CRC32 + Blt_Crc32CmdInitProc, +#endif +#ifndef NO_CSV + Blt_CsvCmdInitProc, +#endif +#ifndef NO_DATATABLE + Blt_TableCmdInitProc, +#endif +#ifndef NO_DDE + Blt_DdeCmdInitProc, +#endif +#ifndef NO_DEBUG + Blt_DebugCmdInitProc, +#endif +#ifndef NO_SPLINE + Blt_SplineCmdInitProc, +#endif +#ifndef NO_TREE + Blt_TreeCmdInitProc, +#endif +#ifndef NO_VECTOR + Blt_VectorCmdInitProc, +#endif +#ifndef NO_WATCH + Blt_WatchCmdInitProc, +#endif + (Tcl_AppInitProc *) NULL +}; + +double +Blt_NaN(void) +{ + return bltNaN; +} + +static double +MakeNaN(void) +{ + union DoubleValue { + unsigned int words[2]; + double value; + } result; + +#ifdef WORDS_BIGENDIAN + result.words[0] = 0x7ff80000; + result.words[1] = 0x00000000; +#else + result.words[0] = 0x00000000; + result.words[1] = 0x7ff80000; +#endif + return result.value; +} + +/* ARGSUSED */ +static int +MinMathProc( + ClientData clientData, /* Not used. */ + Tcl_Interp *interp, /* Not used. */ + Tcl_Value *argsPtr, + Tcl_Value *resultPtr) +{ + Tcl_Value *op1Ptr, *op2Ptr; + + op1Ptr = argsPtr, op2Ptr = argsPtr + 1; + if ((op1Ptr->type == TCL_INT) && (op2Ptr->type == TCL_INT)) { + resultPtr->intValue = MIN(op1Ptr->intValue, op2Ptr->intValue); + resultPtr->type = TCL_INT; + } else { + double a, b; + + a = (op1Ptr->type == TCL_INT) + ? (double)op1Ptr->intValue : op1Ptr->doubleValue; + b = (op2Ptr->type == TCL_INT) + ? (double)op2Ptr->intValue : op2Ptr->doubleValue; + resultPtr->doubleValue = MIN(a, b); + resultPtr->type = TCL_DOUBLE; + } + return TCL_OK; +} + +/*ARGSUSED*/ +static int +MaxMathProc( + ClientData clientData, /* Not used. */ + Tcl_Interp *interp, /* Not used. */ + Tcl_Value *argsPtr, + Tcl_Value *resultPtr) +{ + Tcl_Value *op1Ptr, *op2Ptr; + + op1Ptr = argsPtr, op2Ptr = argsPtr + 1; + if ((op1Ptr->type == TCL_INT) && (op2Ptr->type == TCL_INT)) { + resultPtr->intValue = MAX(op1Ptr->intValue, op2Ptr->intValue); + resultPtr->type = TCL_INT; + } else { + double a, b; + + a = (op1Ptr->type == TCL_INT) + ? (double)op1Ptr->intValue : op1Ptr->doubleValue; + b = (op2Ptr->type == TCL_INT) + ? (double)op2Ptr->intValue : op2Ptr->doubleValue; + resultPtr->doubleValue = MAX(a, b); + resultPtr->type = TCL_DOUBLE; + } + return TCL_OK; +} + +static int +SetLibraryPath(Tcl_Interp *interp) +{ + Tcl_DString dString; + const char *value; + + Tcl_DStringInit(&dString); + Tcl_DStringAppend(&dString, libPath, -1); +#ifdef WIN32 + { + HKEY key; + DWORD result; +# ifndef BLT_REGISTRY_KEY +# define BLT_REGISTRY_KEY "Software\\BLT\\" BLT_VERSION "\\" TCL_VERSION +# endif + result = RegOpenKeyEx( + HKEY_LOCAL_MACHINE, /* Parent key. */ + BLT_REGISTRY_KEY, /* Path to sub-key. */ + 0, /* Reserved. */ + KEY_READ, /* Security access mask. */ + &key); /* Resulting key.*/ + + if (result == ERROR_SUCCESS) { + DWORD size; + + /* Query once to get the size of the string needed */ + result = RegQueryValueEx(key, "BLT_LIBRARY", NULL, NULL, NULL, + &size); + if (result == ERROR_SUCCESS) { + Tcl_DStringSetLength(&dString, size); + /* And again to collect the string. */ + RegQueryValueEx(key, "BLT_LIBRARY", NULL, NULL, + (LPBYTE)Tcl_DStringValue(&dString), &size); + RegCloseKey(key); + } + } + } +#endif /* WIN32 */ + value = Tcl_SetVar(interp, "blt_libPath", Tcl_DStringValue(&dString), + TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG); + Tcl_DStringFree(&dString); + if (value == NULL) { + return TCL_ERROR; + } + return TCL_OK; +} + + +/*LINTLIBRARY*/ +int +Blt_core_Init(Tcl_Interp *interp) /* Interpreter to add extra commands */ +{ + Tcl_AppInitProc **p; + Tcl_Namespace *nsPtr; + Tcl_ValueType args[2]; + const char *result; + const int isExact = 1; + +#ifdef USE_TCL_STUBS + if (Tcl_InitStubs(interp, TCL_VERSION_LOADED, isExact) == NULL) { + return TCL_ERROR; + }; +#endif + Blt_AllocInit(NULL, NULL, NULL); + + /* + * Check that the versions of TCL that have been loaded are the same ones + * that BLT was compiled against. + */ + if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION_LOADED, isExact) == NULL) { + return TCL_ERROR; + } + + /* Set the "blt_version", "blt_patchLevel", and "blt_libPath" Tcl + * variables. We'll use them in the following script. */ + + result = Tcl_SetVar(interp, "blt_version", BLT_VERSION, TCL_GLOBAL_ONLY); + if (result == NULL) { + return TCL_ERROR; + } + result = Tcl_SetVar(interp, "blt_patchLevel", BLT_PATCH_LEVEL, + TCL_GLOBAL_ONLY); + if (result == NULL) { + return TCL_ERROR; + } + if (SetLibraryPath(interp) != TCL_OK) { + return TCL_ERROR; + } + if (Tcl_Eval(interp, initScript) != TCL_OK) { + return TCL_ERROR; + } + + + nsPtr = Tcl_FindNamespace(interp, "::blt", (Tcl_Namespace *)NULL, 0); + if (nsPtr == NULL) { + nsPtr = Tcl_CreateNamespace(interp, "::blt", NULL, NULL); + if (nsPtr == NULL) { + return TCL_ERROR; + } + } + /* Initialize the BLT commands that only require Tcl. */ + for (p = cmdProcs; *p != NULL; p++) { + if ((**p) (interp) != TCL_OK) { + Tcl_DeleteNamespace(nsPtr); + return TCL_ERROR; + } + } + args[0] = args[1] = TCL_EITHER; + Tcl_CreateMathFunc(interp, "min", 2, args, MinMathProc, (ClientData)0); + Tcl_CreateMathFunc(interp, "max", 2, args, MaxMathProc, (ClientData)0); + Blt_RegisterArrayObj(); + bltNaN = MakeNaN(); + if (Tcl_PkgProvide(interp, "blt_core", BLT_VERSION) != TCL_OK) { + return TCL_ERROR; + } + return TCL_OK; +} + +/*LINTLIBRARY*/ +int +Blt_core_SafeInit(Tcl_Interp *interp) /* Interpreter to add extra commands */ +{ + return Blt_core_Init(interp); +} + +#ifdef USE_DLL +# include "bltWinDll.c" +#endif |