1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
|
/*
* 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 "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 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"
};
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;
}
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_Namespace *nsPtr;
const char *result;
const int isExact = 1;
if(
#ifdef USE_TCL_STUBS
Tcl_InitStubs(interp, TCL_VERSION_LOADED, isExact)
#else
Tcl_PkgRequire(interp, "Tcl", TCL_VERSION_LOADED, isExact)
#endif
== 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;
}
}
if (Blt_VectorCmdInitProc(interp) != TCL_OK)
return TCL_ERROR;
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);
}
|