PLplot
5.10.0
|
00001 // Copyright 1994, 1995 00002 // Maurice LeBrun mjl@dino.ph.utexas.edu 00003 // Institute for Fusion Studies University of Texas at Austin 00004 // 00005 // Copyright (C) 2004 Joao Cardoso 00006 // Copyright (C) 2004 Andrew Ross 00007 // 00008 // This file is part of PLplot. 00009 // 00010 // PLplot is free software; you can redistribute it and/or modify 00011 // it under the terms of the GNU Library General Public License as published 00012 // by the Free Software Foundation; either version 2 of the License, or 00013 // (at your option) any later version. 00014 // 00015 // PLplot is distributed in the hope that it will be useful, 00016 // but WITHOUT ANY WARRANTY; without even the implied warranty of 00017 // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 00018 // GNU Library General Public License for more details. 00019 // 00020 // You should have received a copy of the GNU Library General Public License 00021 // along with PLplot; if not, write to the Free Software 00022 // Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 00023 // 00024 //-------------------------------------------------------------------------- 00025 // 00026 // This module implements a Tcl command set for interpretively calling 00027 // PLplot functions. Each Tcl command is responsible for calling the 00028 // appropriate underlying function in the C API. Can be used with any 00029 // driver, in principle. 00030 // 00031 00032 #include "plplotP.h" 00033 #include "pltcl.h" 00034 #include "plplot_parameters.h" 00035 #ifndef __WIN32__ 00036 #ifdef PL_HAVE_UNISTD_H 00037 #include <unistd.h> 00038 #endif 00039 #else 00040 #ifdef _MSC_VER 00041 #define getcwd _getcwd 00042 #include <direct.h> 00043 #endif 00044 #endif 00045 00046 #include "tclgen.h" 00047 00048 // PLplot/Tcl API handlers. Prototypes must come before Cmds struct 00049 00050 static int loopbackCmd( ClientData, Tcl_Interp *, int, const char ** ); 00051 static int plcolorbarCmd( ClientData, Tcl_Interp *, int, const char ** ); 00052 static int plcontCmd( ClientData, Tcl_Interp *, int, const char ** ); 00053 static int pllegendCmd( ClientData, Tcl_Interp *, int, const char ** ); 00054 static int plmeshCmd( ClientData, Tcl_Interp *, int, const char ** ); 00055 static int plmeshcCmd( ClientData, Tcl_Interp *, int, const char ** ); 00056 static int plot3dCmd( ClientData, Tcl_Interp *, int, const char ** ); 00057 static int plot3dcCmd( ClientData, Tcl_Interp *, int, const char ** ); 00058 static int plsurf3dCmd( ClientData, Tcl_Interp *, int, const char ** ); 00059 static int plsetoptCmd( ClientData, Tcl_Interp *, int, const char ** ); 00060 static int plshadeCmd( ClientData, Tcl_Interp *, int, const char ** ); 00061 static int plshadesCmd( ClientData, Tcl_Interp *, int, const char ** ); 00062 static int plmapCmd( ClientData, Tcl_Interp *, int, const char ** ); 00063 static int plmeridiansCmd( ClientData, Tcl_Interp *, int, const char ** ); 00064 static int plstransformCmd( ClientData, Tcl_Interp *, int, const char ** ); 00065 static int plsvectCmd( ClientData, Tcl_Interp *, int, const char ** ); 00066 static int plvectCmd( ClientData, Tcl_Interp *, int, const char ** ); 00067 static int plranddCmd( ClientData, Tcl_Interp *, int, const char ** ); 00068 static int plgriddataCmd( ClientData, Tcl_Interp *, int, const char ** ); 00069 static int plimageCmd( ClientData, Tcl_Interp *, int, const char ** ); 00070 static int plimagefrCmd( ClientData, Tcl_Interp *, int, const char ** ); 00071 static int plstripcCmd( ClientData, Tcl_Interp *, int, const char ** ); 00072 static int plslabelfuncCmd( ClientData, Tcl_Interp *, int, const char ** ); 00073 void mapform( PLINT n, PLFLT *x, PLFLT *y ); 00074 void labelform( PLINT axis, PLFLT value, char *string, PLINT string_length, PLPointer data ); 00075 PLFLT tclMatrix_feval( PLINT i, PLINT j, PLPointer p ); 00076 00077 // 00078 // The following structure defines all of the commands in the PLplot/Tcl 00079 // core, and the C procedures that execute them. 00080 // 00081 00082 typedef struct Command 00083 { 00084 int ( *proc )( void *, struct Tcl_Interp *, int, const char ** ); // Procedure to process command. 00085 ClientData clientData; // Arbitrary value to pass to proc. 00086 int *deleteProc; // Procedure to invoke when deleting 00087 // command. 00088 ClientData deleteData; // Arbitrary value to pass to deleteProc 00089 // (usually the same as clientData). 00090 } Command; 00091 00092 typedef struct 00093 { 00094 const char *name; 00095 int ( *proc )( void *, struct Tcl_Interp *, int, const char ** ); 00096 } CmdInfo; 00097 00098 // Built-in commands, and the procedures associated with them 00099 00100 static CmdInfo Cmds[] = { 00101 { "loopback", loopbackCmd }, 00102 #include "tclgen_s.h" 00103 { "plcolorbar", plcolorbarCmd }, 00104 { "plcont", plcontCmd }, 00105 { "pllegend", pllegendCmd }, 00106 { "plmap", plmapCmd }, 00107 { "plmeridians", plmeridiansCmd }, 00108 { "plstransform", plstransformCmd }, 00109 { "plmesh", plmeshCmd }, 00110 { "plmeshc", plmeshcCmd }, 00111 { "plot3d", plot3dCmd }, 00112 { "plot3dc", plot3dcCmd }, 00113 { "plsurf3d", plsurf3dCmd }, 00114 { "plsetopt", plsetoptCmd }, 00115 { "plshade", plshadeCmd }, 00116 { "plshades", plshadesCmd }, 00117 { "plsvect", plsvectCmd }, 00118 { "plvect", plvectCmd }, 00119 { "plrandd", plranddCmd }, 00120 { "plgriddata", plgriddataCmd }, 00121 { "plimage", plimageCmd }, 00122 { "plimagefr", plimagefrCmd }, 00123 { "plstripc", plstripcCmd }, 00124 { "plslabelfunc", plslabelfuncCmd }, 00125 { NULL, NULL } 00126 }; 00127 00128 // Hash table and associated flag for directing control 00129 00130 static int cmdTable_initted; 00131 static Tcl_HashTable cmdTable; 00132 00133 // Variables for holding error return info from PLplot 00134 00135 static PLINT pl_errcode; 00136 static char errmsg[160]; 00137 00138 // Library initialization 00139 00140 #ifndef PL_LIBRARY 00141 #define PL_LIBRARY "" 00142 #endif 00143 00144 extern PLDLLIMPORT char * plplotLibDir; 00145 00146 #if ( !defined ( MAC_TCL ) && !defined ( __WIN32__ ) ) 00147 // 00148 // Use an extended search for installations on Unix where we 00149 // have very likely installed plplot so that plplot.tcl is 00150 // in /usr/local/plplot/lib/plplot5.1.0/tcl 00151 // 00152 #define PLPLOT_EXTENDED_SEARCH 00153 #endif 00154 00155 // Static functions 00156 00157 // Evals the specified command, aborting on an error. 00158 00159 static int 00160 tcl_cmd( Tcl_Interp *interp, const char *cmd ); 00161 00162 //-------------------------------------------------------------------------- 00163 // Append_Cmdlist 00164 // 00165 // Generates command list from Cmds, storing as interps result. 00166 //-------------------------------------------------------------------------- 00167 00168 static void 00169 Append_Cmdlist( Tcl_Interp *interp ) 00170 { 00171 static int inited = 0; 00172 static const char** namelist; 00173 int i, j, ncmds = sizeof ( Cmds ) / sizeof ( CmdInfo ); 00174 00175 if ( !inited ) 00176 { 00177 namelist = (const char **) malloc( (size_t) ncmds * sizeof ( char * ) ); 00178 00179 for ( i = 0; i < ncmds; i++ ) 00180 namelist[i] = Cmds[i].name; 00181 00182 // Sort the list, couldn't get qsort to do it for me for some reason, grrr. 00183 00184 for ( i = 0; i < ncmds - 1; i++ ) 00185 for ( j = i + 1; j < ncmds - 1; j++ ) 00186 { 00187 if ( strcmp( namelist[i], namelist[j] ) > 0 ) 00188 { 00189 const char *t = namelist[i]; 00190 namelist[i] = namelist[j]; 00191 namelist[j] = t; 00192 } 00193 } 00194 00195 inited = 1; 00196 } 00197 00198 for ( i = 0; i < ncmds; i++ ) 00199 Tcl_AppendResult( interp, " ", namelist[i], (char *) NULL ); 00200 } 00201 00202 //-------------------------------------------------------------------------- 00203 // plTclCmd_Init 00204 // 00205 // Sets up command hash table for use with plframe to PLplot Tcl API. 00206 // 00207 // Right now all API calls are allowed, although some of these may not 00208 // make much sense when used with a widget. 00209 //-------------------------------------------------------------------------- 00210 00211 static void 00212 plTclCmd_Init( Tcl_Interp * PL_UNUSED( interp ) ) 00213 { 00214 register Command *cmdPtr; 00215 register CmdInfo *cmdInfoPtr; 00216 00217 // Register our error variables with PLplot 00218 00219 plsError( &pl_errcode, errmsg ); 00220 00221 // Initialize hash table 00222 00223 Tcl_InitHashTable( &cmdTable, TCL_STRING_KEYS ); 00224 00225 // Create the hash table entry for each command 00226 00227 for ( cmdInfoPtr = Cmds; cmdInfoPtr->name != NULL; cmdInfoPtr++ ) 00228 { 00229 int new; 00230 Tcl_HashEntry *hPtr; 00231 00232 hPtr = Tcl_CreateHashEntry( &cmdTable, cmdInfoPtr->name, &new ); 00233 if ( new ) 00234 { 00235 cmdPtr = (Command *) ckalloc( sizeof ( Command ) ); 00236 cmdPtr->proc = cmdInfoPtr->proc; 00237 cmdPtr->clientData = (ClientData) NULL; 00238 cmdPtr->deleteProc = NULL; 00239 cmdPtr->deleteData = (ClientData) NULL; 00240 Tcl_SetHashValue( hPtr, cmdPtr ); 00241 } 00242 } 00243 } 00244 00245 //-------------------------------------------------------------------------- 00246 // plTclCmd 00247 // 00248 // Front-end to PLplot/Tcl API for use from Tcl commands (e.g. plframe). 00249 // 00250 // This command is called by the plframe widget to process subcommands 00251 // of the "cmd" plframe widget command. This is the plframe's direct 00252 // plotting interface to the PLplot library. This routine can be called 00253 // from other commands that want a similar capability. 00254 // 00255 // In a widget-based application, a PLplot "command" doesn't make much 00256 // sense by itself since it isn't connected to a specific widget. 00257 // Instead, you have widget commands. This allows arbitrarily many 00258 // widgets and requires a slightly different syntax than if there were 00259 // only a single output device. That is, the widget name (and in this 00260 // case, the "cmd" widget command, after that comes the subcommand) 00261 // must come first. The plframe widget checks first for one of its 00262 // internal subcommands, those specifically designed for use with the 00263 // plframe widget. If not found, control comes here. 00264 //-------------------------------------------------------------------------- 00265 00266 int 00267 plTclCmd( char *cmdlist, Tcl_Interp *interp, int argc, const char **argv ) 00268 { 00269 register Tcl_HashEntry *hPtr; 00270 int result = TCL_OK; 00271 00272 pl_errcode = 0; errmsg[0] = '\0'; 00273 00274 // Create hash table on first call 00275 00276 if ( !cmdTable_initted ) 00277 { 00278 cmdTable_initted = 1; 00279 plTclCmd_Init( interp ); 00280 } 00281 00282 // no option -- return list of available PLplot commands 00283 00284 if ( argc == 0 ) 00285 { 00286 Tcl_AppendResult( interp, cmdlist, (char *) NULL ); 00287 Append_Cmdlist( interp ); 00288 return TCL_OK; 00289 } 00290 00291 // Pick out the desired command 00292 00293 hPtr = Tcl_FindHashEntry( &cmdTable, argv[0] ); 00294 if ( hPtr == NULL ) 00295 { 00296 Tcl_AppendResult( interp, "bad option \"", argv[0], 00297 "\" to \"cmd\": must be one of ", 00298 cmdlist, (char *) NULL ); 00299 Append_Cmdlist( interp ); 00300 result = TCL_ERROR; 00301 } 00302 else 00303 { 00304 register Command *cmdPtr = (Command *) Tcl_GetHashValue( hPtr ); 00305 result = ( *cmdPtr->proc )( cmdPtr->clientData, interp, argc, argv ); 00306 if ( result == TCL_OK ) 00307 { 00308 if ( pl_errcode != 0 ) 00309 { 00310 result = TCL_ERROR; 00311 Tcl_AppendResult( interp, errmsg, (char *) NULL ); 00312 } 00313 } 00314 } 00315 00316 return result; 00317 } 00318 00319 //-------------------------------------------------------------------------- 00320 // loopbackCmd 00321 // 00322 // Loop-back command for Tcl interpreter. Main purpose is to enable a 00323 // compatible command syntax whether you are executing directly through a 00324 // Tcl interpreter or a plframe widget. I.e. the syntax is: 00325 // 00326 // <widget> cmd <PLplot command> (widget command) 00327 // loopback cmd <PLplot command> (pltcl command) 00328 // 00329 // This routine is essentially the same as plTclCmd but without some of 00330 // the window dressing required by the plframe widget. 00331 //-------------------------------------------------------------------------- 00332 00333 static int 00334 loopbackCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp, 00335 int argc, const char **argv ) 00336 { 00337 register Tcl_HashEntry *hPtr; 00338 int result = TCL_OK; 00339 00340 argc--; argv++; 00341 if ( argc == 0 || ( strcmp( argv[0], "cmd" ) != 0 ) ) 00342 { 00343 Tcl_AppendResult( interp, "bad option \"", argv[0], 00344 "\" to \"loopback\": must be ", 00345 "\"cmd ?options?\" ", (char *) NULL ); 00346 return TCL_ERROR; 00347 } 00348 00349 // Create hash table on first call 00350 00351 if ( !cmdTable_initted ) 00352 { 00353 cmdTable_initted = 1; 00354 plTclCmd_Init( interp ); 00355 } 00356 00357 // no option -- return list of available PLplot commands 00358 00359 argc--; argv++; 00360 if ( argc == 0 ) 00361 { 00362 Append_Cmdlist( interp ); 00363 return TCL_OK; 00364 } 00365 00366 // Pick out the desired command 00367 00368 hPtr = Tcl_FindHashEntry( &cmdTable, argv[0] ); 00369 if ( hPtr == NULL ) 00370 { 00371 Tcl_AppendResult( interp, "bad option \"", argv[0], 00372 "\" to \"loopback cmd\": must be one of ", 00373 (char *) NULL ); 00374 Append_Cmdlist( interp ); 00375 result = TCL_ERROR; 00376 } 00377 else 00378 { 00379 register Command *cmdPtr = (Command *) Tcl_GetHashValue( hPtr ); 00380 result = ( *cmdPtr->proc )( cmdPtr->clientData, interp, argc, argv ); 00381 } 00382 00383 return result; 00384 } 00385 00386 //-------------------------------------------------------------------------- 00387 // PlbasicInit 00388 // 00389 // Used by Pltcl_Init, Pltk_Init(.c), and Plplotter_Init(.c). Ensures we have been correctly loaded 00390 // into a Tcl/Tk interpreter, that the plplot.tcl startup file can be 00391 // found and sourced, and that the Matrix library can be found and used, 00392 // and that it correctly exports a stub table. 00393 //-------------------------------------------------------------------------- 00394 00395 int 00396 PlbasicInit( Tcl_Interp *interp ) 00397 { 00398 int debug = plsc->debug; 00399 const char *libDir = NULL; 00400 static char initScript[] = 00401 "tcl_findLibrary plplot " PLPLOT_VERSION " \"\" plplot.tcl PL_LIBRARY pllibrary"; 00402 #ifdef PLPLOT_EXTENDED_SEARCH 00403 static char initScriptExtended[] = 00404 "tcl_findLibrary plplot " PLPLOT_VERSION "/tcl \"\" plplot.tcl PL_LIBRARY pllibrary"; 00405 #endif 00406 00407 #ifdef USE_TCL_STUBS 00408 // 00409 // We hard-wire 8.1 here, rather than TCL_VERSION, TK_VERSION because 00410 // we really don't mind which version of Tcl, Tk we use as long as it 00411 // is 8.1 or newer. Otherwise if we compiled against 8.2, we couldn't 00412 // be loaded into 8.1 00413 // 00414 Tcl_InitStubs( interp, "8.1", 0 ); 00415 #endif 00416 00417 #if 1 00418 if ( Matrix_Init( interp ) != TCL_OK ) 00419 { 00420 if ( debug ) 00421 fprintf( stderr, "error in matrix init\n" ); 00422 return TCL_ERROR; 00423 } 00424 #else 00425 00426 // 00427 // This code is really designed to be used with a stubified Matrix 00428 // extension. It is not well tested under a non-stubs situation 00429 // (which is in any case inferior). The USE_MATRIX_STUBS define 00430 // is made in pltcl.h, and should be removed only with extreme caution. 00431 // 00432 #ifdef USE_MATRIX_STUBS 00433 if ( Matrix_InitStubs( interp, "0.1", 0 ) == NULL ) 00434 { 00435 if ( debug ) 00436 fprintf( stderr, "error in matrix stubs init\n" ); 00437 return TCL_ERROR; 00438 } 00439 #else 00440 Tcl_PkgRequire( interp, "Matrix", "0.1", 0 ); 00441 #endif 00442 #endif 00443 00444 Tcl_SetVar( interp, "plversion", PLPLOT_VERSION, TCL_GLOBAL_ONLY ); 00445 00446 if ( strcmp( PLPLOT_ITCL_VERSION, "4.0.0" ) >= 0 ) 00447 Tcl_SetVar( interp, "pl_itcl_package_name", "Itcl 4", TCL_GLOBAL_ONLY ); 00448 else if ( strcmp( PLPLOT_ITCL_VERSION, "3.0.0" ) >= 0 ) 00449 Tcl_SetVar( interp, "pl_itcl_package_name", "Itcl 3", TCL_GLOBAL_ONLY ); 00450 else 00451 // Mark invalid package name in such a way as to cause an error 00452 // when, for example, itcl has been disabled by PLplot, yet one 00453 // of the PLplot Tcl scripts attempts to load Itcl. 00454 Tcl_SetVar( interp, "pl_itcl_package_name", "Itcl(because_not_found_by_PLplot)", TCL_GLOBAL_ONLY ); 00455 00456 if ( strcmp( PLPLOT_ITK_VERSION, "4.0.0" ) >= 0 ) 00457 Tcl_SetVar( interp, "pl_itk_package_name", "Itk 4", TCL_GLOBAL_ONLY ); 00458 else if ( strcmp( PLPLOT_ITK_VERSION, "3.0.0" ) >= 0 ) 00459 Tcl_SetVar( interp, "pl_itk_package_name", "Itk 3", TCL_GLOBAL_ONLY ); 00460 else 00461 // Mark invalid package name in such a way as to cause an error 00462 // when, for example, itk has been disabled by PLplot, yet one 00463 // of the PLplot Tcl scripts attempts to load Itk. 00464 Tcl_SetVar( interp, "pl_itk_package_name", "Itk(because_not_found_by_PLplot)", TCL_GLOBAL_ONLY ); 00465 00466 if ( strcmp( PLPLOT_IWIDGETS_VERSION, "4.1.0" ) >= 0 ) 00467 Tcl_SetVar( interp, "pl_iwidgets_package_name", "Iwidgets 4", TCL_GLOBAL_ONLY ); 00468 else if ( strcmp( PLPLOT_IWIDGETS_VERSION, "4.0.0" ) >= 0 ) 00469 Tcl_SetVar( interp, "pl_iwidgets_package_name", "-exact Iwidgets " PLPLOT_IWIDGETS_VERSION, TCL_GLOBAL_ONLY ); 00470 else 00471 // Mark invalid package name in such a way as to cause an error 00472 // when, for example, itk has been disabled by PLplot, yet one 00473 // of the PLplot Tcl scripts attempts to load Iwidgets. 00474 Tcl_SetVar( interp, "pl_iwidgets_package_name", "Iwidgets(because_not_found_by_PLplot)", TCL_GLOBAL_ONLY ); 00475 00476 00477 // Begin search for init script 00478 // Each search begins with a test of libDir, so rearrangement is easy. 00479 // If search is successful, both libDir (C) and pllibrary (tcl) are set 00480 00481 // if we are in the build tree, search there 00482 if ( plInBuildTree() ) 00483 { 00484 if ( debug ) 00485 fprintf( stderr, "trying BUILD_DIR\n" ); 00486 libDir = BUILD_DIR "/bindings/tcl"; 00487 Tcl_SetVar( interp, "pllibrary", libDir, TCL_GLOBAL_ONLY ); 00488 if ( Tcl_Eval( interp, initScript ) != TCL_OK ) 00489 { 00490 libDir = NULL; 00491 Tcl_UnsetVar( interp, "pllibrary", TCL_GLOBAL_ONLY ); 00492 Tcl_ResetResult( interp ); 00493 } 00494 } 00495 00496 // Tcl extension dir and/or PL_LIBRARY 00497 if ( libDir == NULL ) 00498 { 00499 if ( debug ) 00500 fprintf( stderr, "trying init script\n" ); 00501 if ( Tcl_Eval( interp, initScript ) != TCL_OK ) 00502 { 00503 // This unset is needed for Tcl < 8.4 support. 00504 Tcl_UnsetVar( interp, "pllibrary", TCL_GLOBAL_ONLY ); 00505 // Clear the result to get rid of the error message 00506 Tcl_ResetResult( interp ); 00507 } 00508 else 00509 libDir = Tcl_GetVar( interp, "pllibrary", TCL_GLOBAL_ONLY ); 00510 } 00511 00512 #ifdef TCL_DIR 00513 // Install directory 00514 if ( libDir == NULL ) 00515 { 00516 if ( debug ) 00517 fprintf( stderr, "trying TCL_DIR\n" ); 00518 libDir = TCL_DIR; 00519 Tcl_SetVar( interp, "pllibrary", libDir, TCL_GLOBAL_ONLY ); 00520 if ( Tcl_Eval( interp, initScript ) != TCL_OK ) 00521 { 00522 libDir = NULL; 00523 Tcl_UnsetVar( interp, "pllibrary", TCL_GLOBAL_ONLY ); 00524 Tcl_ResetResult( interp ); 00525 } 00526 } 00527 #endif 00528 00529 #ifdef PLPLOT_EXTENDED_SEARCH 00530 // Unix extension directory 00531 if ( libDir == NULL ) 00532 { 00533 if ( debug ) 00534 fprintf( stderr, "trying extended init script\n" ); 00535 if ( Tcl_Eval( interp, initScriptExtended ) != TCL_OK ) 00536 { 00537 // This unset is needed for Tcl < 8.4 support. 00538 Tcl_UnsetVar( interp, "pllibrary", TCL_GLOBAL_ONLY ); 00539 // Clear the result to get rid of the error message 00540 Tcl_ResetResult( interp ); 00541 } 00542 else 00543 libDir = Tcl_GetVar( interp, "pllibrary", TCL_GLOBAL_ONLY ); 00544 } 00545 00546 // Last chance, current directory 00547 if ( libDir == NULL ) 00548 { 00549 Tcl_DString ds; 00550 if ( debug ) 00551 fprintf( stderr, "trying curdir\n" ); 00552 if ( Tcl_Access( "plplot.tcl", 0 ) != 0 ) 00553 { 00554 if ( debug ) 00555 fprintf( stderr, "couldn't find plplot.tcl in curdir\n" ); 00556 return TCL_ERROR; 00557 } 00558 00559 // It seems to be here. Set pllibrary & eval plplot.tcl "by hand" 00560 libDir = Tcl_GetCwd( interp, &ds ); 00561 if ( libDir == NULL ) 00562 { 00563 if ( debug ) 00564 fprintf( stderr, "couldn't get curdir\n" ); 00565 return TCL_ERROR; 00566 } 00567 libDir = plstrdup( libDir ); 00568 Tcl_DStringFree( &ds ); 00569 Tcl_SetVar( interp, "pllibrary", libDir, TCL_GLOBAL_ONLY ); 00570 00571 if ( Tcl_EvalFile( interp, "plplot.tcl" ) != TCL_OK ) 00572 { 00573 if ( debug ) 00574 fprintf( stderr, "error evalling plplot.tcl\n" ); 00575 return TCL_ERROR; 00576 } 00577 } 00578 #endif 00579 00580 if ( libDir == NULL ) 00581 { 00582 if ( debug ) 00583 fprintf( stderr, "libdir NULL at end of search\n" ); 00584 return TCL_ERROR; 00585 } 00586 00587 // Used by init code in plctrl.c 00588 plplotLibDir = plstrdup( libDir ); 00589 00590 // wait_until -- waits for a specific condition to arise 00591 // Can be used with either Tcl-DP or TK 00592 00593 Tcl_CreateCommand( interp, "wait_until", (Tcl_CmdProc *) plWait_Until, 00594 (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL ); 00595 00596 // Define the flags as variables in the PLPLOT namespace 00597 set_plplot_parameters( interp ); 00598 00599 return TCL_OK; 00600 } 00601 00602 //-------------------------------------------------------------------------- 00603 // Pltcl_Init 00604 // 00605 // Initialization routine for extended tclsh's. 00606 // Sets up auto_path, creates the matrix command and numerous commands for 00607 // interfacing to PLplot. Should not be used in a widget-based system. 00608 //-------------------------------------------------------------------------- 00609 00610 int 00611 Pltcl_Init( Tcl_Interp *interp ) 00612 { 00613 register CmdInfo *cmdInfoPtr; 00614 // This must be before any other Tcl related calls 00615 if ( PlbasicInit( interp ) != TCL_OK ) 00616 { 00617 Tcl_AppendResult( interp, "Could not find plplot.tcl - please set \ 00618 environment variable PL_LIBRARY to the directory containing that file", 00619 (char *) NULL ); 00620 00621 return TCL_ERROR; 00622 } 00623 00624 // Register our error variables with PLplot 00625 00626 plsError( &pl_errcode, errmsg ); 00627 00628 // PLplot API commands 00629 00630 for ( cmdInfoPtr = Cmds; cmdInfoPtr->name != NULL; cmdInfoPtr++ ) 00631 { 00632 Tcl_CreateCommand( interp, cmdInfoPtr->name, cmdInfoPtr->proc, 00633 (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL ); 00634 } 00635 00636 // We really need this so the TEA based 'make install' can 00637 // properly determine the package we have installed 00638 00639 Tcl_PkgProvide( interp, "Pltcl", PLPLOT_VERSION ); 00640 return TCL_OK; 00641 } 00642 00643 //-------------------------------------------------------------------------- 00644 // plWait_Until 00645 // 00646 // Tcl command -- wait until the specified condition is satisfied. 00647 // Processes all events while waiting. 00648 // 00649 // This command is more capable than tkwait, and has the added benefit 00650 // of working with Tcl-DP as well. Example usage: 00651 // 00652 // wait_until {[info exists foobar]} 00653 // 00654 // Note the [info ...] command must be protected by braces so that it 00655 // isn't actually evaluated until passed into this routine. 00656 //-------------------------------------------------------------------------- 00657 00658 int 00659 plWait_Until( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp, int PL_UNUSED( argc ), const char **argv ) 00660 { 00661 int result = 0; 00662 00663 dbug_enter( "plWait_Until" ); 00664 00665 for (;; ) 00666 { 00667 if ( Tcl_ExprBoolean( interp, argv[1], &result ) ) 00668 { 00669 fprintf( stderr, "wait_until command \"%s\" failed:\n\t %s\n", 00670 argv[1], Tcl_GetStringResult( interp ) ); 00671 break; 00672 } 00673 if ( result ) 00674 break; 00675 00676 Tcl_DoOneEvent( 0 ); 00677 } 00678 return TCL_OK; 00679 } 00680 00681 //-------------------------------------------------------------------------- 00682 // pls_auto_path 00683 // 00684 // Sets up auto_path variable. 00685 // Directories are added to the FRONT of autopath. Therefore, they are 00686 // searched in reverse order of how they are listed below. 00687 // 00688 // Note: there is no harm in adding extra directories, even if they don't 00689 // actually exist (aside from a slight increase in processing time when 00690 // the autoloaded proc is first found). 00691 //-------------------------------------------------------------------------- 00692 00693 int 00694 pls_auto_path( Tcl_Interp *interp ) 00695 { 00696 int debug = plsc->debug; 00697 char *buf, *ptr = NULL, *dn; 00698 int return_code = TCL_OK; 00699 #ifdef DEBUG 00700 char *path; 00701 #endif 00702 00703 buf = (char *) malloc( 256 * sizeof ( char ) ); 00704 00705 // Add TCL_DIR 00706 00707 #ifdef TCL_DIR 00708 if ( debug ) 00709 fprintf( stderr, "adding %s to auto_path\n", TCL_DIR ); 00710 Tcl_SetVar( interp, "dir", TCL_DIR, TCL_GLOBAL_ONLY ); 00711 if ( tcl_cmd( interp, "set auto_path [linsert $auto_path 0 $dir]" ) == TCL_ERROR ) 00712 { 00713 return_code = TCL_ERROR; 00714 goto finish; 00715 } 00716 #ifdef DEBUG 00717 path = Tcl_GetVar( interp, "auto_path", 0 ); 00718 fprintf( stderr, "auto_path is %s\n", path ); 00719 #endif 00720 #endif 00721 00722 // Add $HOME/tcl 00723 00724 if ( ( dn = getenv( "HOME" ) ) != NULL ) 00725 { 00726 plGetName( dn, "tcl", "", &ptr ); 00727 Tcl_SetVar( interp, "dir", ptr, 0 ); 00728 if ( tcl_cmd( interp, "set auto_path [linsert $auto_path 0 $dir]" ) == TCL_ERROR ) 00729 { 00730 return_code = TCL_ERROR; 00731 goto finish; 00732 } 00733 #ifdef DEBUG 00734 fprintf( stderr, "adding %s to auto_path\n", ptr ); 00735 path = Tcl_GetVar( interp, "auto_path", 0 ); 00736 fprintf( stderr, "auto_path is %s\n", path ); 00737 #endif 00738 } 00739 00740 // Add PL_TCL_ENV = $(PL_TCL) 00741 00742 #if defined ( PL_TCL_ENV ) 00743 if ( ( dn = getenv( PL_TCL_ENV ) ) != NULL ) 00744 { 00745 plGetName( dn, "", "", &ptr ); 00746 Tcl_SetVar( interp, "dir", ptr, 0 ); 00747 if ( tcl_cmd( interp, "set auto_path [linsert $auto_path 0 $dir]" ) == TCL_ERROR ) 00748 { 00749 return_code = TCL_ERROR; 00750 goto finish; 00751 } 00752 #ifdef DEBUG 00753 fprintf( stderr, "adding %s to auto_path\n", ptr ); 00754 path = Tcl_GetVar( interp, "auto_path", 0 ); 00755 fprintf( stderr, "auto_path is %s\n", path ); 00756 #endif 00757 } 00758 #endif // PL_TCL_ENV 00759 00760 // Add PL_HOME_ENV/tcl = $(PL_HOME_ENV)/tcl 00761 00762 #if defined ( PL_HOME_ENV ) 00763 if ( ( dn = getenv( PL_HOME_ENV ) ) != NULL ) 00764 { 00765 plGetName( dn, "tcl", "", &ptr ); 00766 Tcl_SetVar( interp, "dir", ptr, 0 ); 00767 if ( tcl_cmd( interp, "set auto_path [linsert $auto_path 0 $dir]" ) == TCL_ERROR ) 00768 { 00769 return_code = TCL_ERROR; 00770 goto finish; 00771 } 00772 #ifdef DEBUG 00773 fprintf( stderr, "adding %s to auto_path\n", ptr ); 00774 path = Tcl_GetVar( interp, "auto_path", 0 ); 00775 fprintf( stderr, "auto_path is %s\n", path ); 00776 #endif 00777 } 00778 #endif // PL_HOME_ENV 00779 00780 // Add cwd 00781 00782 if ( getcwd( buf, 256 ) == 0 ) 00783 { 00784 Tcl_SetResult( interp, "Problems with getcwd in pls_auto_path", TCL_STATIC ); 00785 { 00786 return_code = TCL_ERROR; 00787 goto finish; 00788 } 00789 } 00790 Tcl_SetVar( interp, "dir", buf, 0 ); 00791 if ( tcl_cmd( interp, "set auto_path [linsert $auto_path 0 $dir]" ) == TCL_ERROR ) 00792 { 00793 return_code = TCL_ERROR; 00794 goto finish; 00795 } 00796 //** see if plserver was invoked in the build tree ** 00797 if ( plInBuildTree() ) 00798 { 00799 Tcl_SetVar( interp, "dir", BUILD_DIR "/bindings/tk", TCL_GLOBAL_ONLY ); 00800 if ( tcl_cmd( interp, "set auto_path [linsert $auto_path 0 $dir]" ) == TCL_ERROR ) 00801 { 00802 return_code = TCL_ERROR; 00803 goto finish; 00804 } 00805 } 00806 00807 #ifdef DEBUG 00808 fprintf( stderr, "adding %s to auto_path\n", buf ); 00809 path = Tcl_GetVar( interp, "auto_path", 0 ); 00810 fprintf( stderr, "auto_path is %s\n", path ); 00811 #endif 00812 00813 finish: free_mem( buf ); 00814 free_mem( ptr ); 00815 00816 return return_code; 00817 } 00818 00819 //-------------------------------------------------------------------------- 00820 // tcl_cmd 00821 // 00822 // Evals the specified command, aborting on an error. 00823 //-------------------------------------------------------------------------- 00824 00825 static int 00826 tcl_cmd( Tcl_Interp *interp, const char *cmd ) 00827 { 00828 int result; 00829 00830 result = Tcl_VarEval( interp, cmd, (char **) NULL ); 00831 if ( result != TCL_OK ) 00832 { 00833 fprintf( stderr, "TCL command \"%s\" failed:\n\t %s\n", 00834 cmd, Tcl_GetStringResult( interp ) ); 00835 } 00836 return result; 00837 } 00838 00839 //-------------------------------------------------------------------------- 00840 // PLplot API Calls 00841 // 00842 // Any call that results in something actually being plotted must be 00843 // followed by by a call to plflush(), to make sure all output from 00844 // that command is finished. Devices that have text/graphics screens 00845 // (e.g. Tek4xxx and emulators) implicitly switch to the graphics screen 00846 // before graphics commands, so a plgra() is not necessary in this case. 00847 // Although if you switch to the text screen via user control (instead of 00848 // using pltext()), the device will get confused. 00849 //-------------------------------------------------------------------------- 00850 00851 static char buf[200]; 00852 00853 #include "tclgen.c" 00854 00855 //-------------------------------------------------------------------------- 00856 // plcontCmd 00857 // 00858 // Processes plcont Tcl command. 00859 // 00860 // The C function is: 00861 // void 00862 // c_plcont(PLFLT **f, PLINT nx, PLINT ny, PLINT kx, PLINT lx, 00863 // PLINT ky, PLINT ly, PLFLT *clevel, PLINT nlevel, 00864 // void (*pltr) (PLFLT, PLFLT, PLFLT *, PLFLT *, PLPointer), 00865 // PLPointer pltr_data); 00866 // 00867 // Since f will be specified by a Tcl Matrix, nx and ny are redundant, and 00868 // are automatically eliminated. Same for nlevel, since clevel will be a 1-d 00869 // Tcl Matrix. Since most people plot the whole data set, we will allow kx, 00870 // lx and ky, ly to be defaulted--either you specify all four, or none of 00871 // them. We allow three ways of specifying the coordinate transforms: 1) 00872 // Nothing, in which case we will use the identity mapper pltr0 2) pltr1, in 00873 // which case the next two args must be 1-d Tcl Matricies 3) pltr2, in which 00874 // case the next two args must be 2-d Tcl Matricies. Finally, a new 00875 // paramater is allowed at the end to specify which, if either, of the 00876 // coordinates wrap on themselves. Can be 1 or x, or 2 or y. Nothing or 0 00877 // specifies that neither coordinate wraps. 00878 // 00879 // So, the new call from Tcl is: 00880 // plcont f [kx lx ky ly] clev [pltr x y] [wrap] 00881 // 00882 //-------------------------------------------------------------------------- 00883 00884 static int tclmateval_modx, tclmateval_mody; 00885 00886 PLFLT tclMatrix_feval( PLINT i, PLINT j, PLPointer p ) 00887 { 00888 tclMatrix *matPtr = (tclMatrix *) p; 00889 00890 i = i % tclmateval_modx; 00891 j = j % tclmateval_mody; 00892 00893 // printf( "tclMatrix_feval: i=%d j=%d f=%f\n", i, j, 00894 // matPtr->fdata[I2D(i,j)] ); 00895 // 00896 return matPtr->fdata[I2D( i, j )]; 00897 } 00898 00899 static int 00900 plcontCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp, 00901 int argc, const char *argv[] ) 00902 { 00903 tclMatrix *matPtr, *matf, *matclev; 00904 PLINT nx, ny, kx = 0, lx = 0, ky = 0, ly = 0, nclev; 00905 const char *pltrname = "pltr0"; 00906 tclMatrix *mattrx = NULL, *mattry = NULL; 00907 PLFLT **z, **zused, **zwrapped; 00908 00909 int arg3_is_kx = 1, i, j; 00910 void ( *pltr )( PLFLT, PLFLT, PLFLT *, PLFLT *, PLPointer ); 00911 PLPointer pltr_data = NULL; 00912 PLcGrid cgrid1; 00913 PLcGrid2 cgrid2; 00914 00915 int wrap = 0; 00916 00917 if ( argc < 3 ) 00918 { 00919 Tcl_AppendResult( interp, "wrong # args: see documentation for ", 00920 argv[0], (char *) NULL ); 00921 return TCL_ERROR; 00922 } 00923 00924 matf = Tcl_GetMatrixPtr( interp, argv[1] ); 00925 if ( matf == NULL ) 00926 return TCL_ERROR; 00927 00928 if ( matf->dim != 2 ) 00929 { 00930 Tcl_SetResult( interp, "Must use 2-d data.", TCL_STATIC ); 00931 return TCL_ERROR; 00932 } 00933 else 00934 { 00935 nx = matf->n[0]; 00936 ny = matf->n[1]; 00937 tclmateval_modx = nx; 00938 tclmateval_mody = ny; 00939 00940 // convert matf to 2d-array so can use standard wrap approach 00941 // from now on in this code. 00942 plAlloc2dGrid( &z, nx, ny ); 00943 for ( i = 0; i < nx; i++ ) 00944 { 00945 for ( j = 0; j < ny; j++ ) 00946 { 00947 z[i][j] = tclMatrix_feval( i, j, matf ); 00948 } 00949 } 00950 } 00951 00952 // Now check the next argument. If it is all digits, then it must be kx, 00953 // otherwise it is the name of clev. 00954 00955 for ( i = 0; i < (int) strlen( argv[2] ) && arg3_is_kx; i++ ) 00956 if ( !isdigit( argv[2][i] ) ) 00957 arg3_is_kx = 0; 00958 00959 if ( arg3_is_kx ) 00960 { 00961 // Check that there are enough args 00962 if ( argc < 7 ) 00963 { 00964 Tcl_SetResult( interp, "plcont, bogus syntax", TCL_STATIC ); 00965 return TCL_ERROR; 00966 } 00967 00968 // Peel off the ones we need 00969 kx = atoi( argv[3] ); 00970 lx = atoi( argv[4] ); 00971 ky = atoi( argv[5] ); 00972 ly = atoi( argv[6] ); 00973 00974 // adjust argc, argv to reflect our consumption 00975 argc -= 6, argv += 6; 00976 } 00977 else 00978 { 00979 argc -= 2, argv += 2; 00980 } 00981 00982 // The next argument has to be clev 00983 00984 if ( argc < 1 ) 00985 { 00986 Tcl_SetResult( interp, "plcont, bogus syntax", TCL_STATIC ); 00987 return TCL_ERROR; 00988 } 00989 00990 matclev = Tcl_GetMatrixPtr( interp, argv[0] ); 00991 if ( matclev == NULL ) 00992 return TCL_ERROR; 00993 nclev = matclev->n[0]; 00994 00995 if ( matclev->dim != 1 ) 00996 { 00997 Tcl_SetResult( interp, "clev must be 1-d matrix.", TCL_STATIC ); 00998 return TCL_ERROR; 00999 } 01000 01001 argc--, argv++; 01002 01003 // Now handle trailing optional parameters, if any 01004 01005 if ( argc >= 3 ) 01006 { 01007 // There is a pltr spec, parse it. 01008 pltrname = argv[0]; 01009 mattrx = Tcl_GetMatrixPtr( interp, argv[1] ); 01010 if ( mattrx == NULL ) 01011 return TCL_ERROR; 01012 mattry = Tcl_GetMatrixPtr( interp, argv[2] ); 01013 if ( mattry == NULL ) 01014 return TCL_ERROR; 01015 01016 argc -= 3, argv += 3; 01017 } 01018 01019 if ( argc ) 01020 { 01021 // There is a wrap spec, get it. 01022 wrap = atoi( argv[0] ); 01023 01024 // Hmm, I said the the doc they could also say x or y, have to come back 01025 // to this... 01026 01027 argc--, argv++; 01028 } 01029 01030 // There had better not be anything else on the command line by this point. 01031 01032 if ( argc ) 01033 { 01034 Tcl_SetResult( interp, "plcont, bogus syntax, too many args.", TCL_STATIC ); 01035 return TCL_ERROR; 01036 } 01037 01038 // Now we need to set up the data for contouring. 01039 01040 if ( !strcmp( pltrname, "pltr0" ) ) 01041 { 01042 pltr = pltr0; 01043 zused = z; 01044 01045 // wrapping is only supported for pltr2. 01046 if ( wrap ) 01047 { 01048 Tcl_SetResult( interp, "Must use pltr2 if want wrapping.", TCL_STATIC ); 01049 return TCL_ERROR; 01050 } 01051 } 01052 else if ( !strcmp( pltrname, "pltr1" ) ) 01053 { 01054 pltr = pltr1; 01055 cgrid1.xg = mattrx->fdata; 01056 cgrid1.nx = nx; 01057 cgrid1.yg = mattry->fdata; 01058 cgrid1.ny = ny; 01059 zused = z; 01060 01061 // wrapping is only supported for pltr2. 01062 if ( wrap ) 01063 { 01064 Tcl_SetResult( interp, "Must use pltr2 if want wrapping.", TCL_STATIC ); 01065 return TCL_ERROR; 01066 } 01067 01068 if ( mattrx->dim != 1 || mattry->dim != 1 ) 01069 { 01070 Tcl_SetResult( interp, "Must use 1-d coord arrays with pltr1.", TCL_STATIC ); 01071 return TCL_ERROR; 01072 } 01073 01074 pltr_data = &cgrid1; 01075 } 01076 else if ( !strcmp( pltrname, "pltr2" ) ) 01077 { 01078 // printf( "plcont, setting up for pltr2\n" ); 01079 if ( !wrap ) 01080 { 01081 // printf( "plcont, no wrapping is needed.\n" ); 01082 plAlloc2dGrid( &cgrid2.xg, nx, ny ); 01083 plAlloc2dGrid( &cgrid2.yg, nx, ny ); 01084 cgrid2.nx = nx; 01085 cgrid2.ny = ny; 01086 zused = z; 01087 01088 matPtr = mattrx; 01089 for ( i = 0; i < nx; i++ ) 01090 for ( j = 0; j < ny; j++ ) 01091 cgrid2.xg[i][j] = mattrx->fdata[ I2D( i, j ) ]; 01092 01093 matPtr = mattry; 01094 for ( i = 0; i < nx; i++ ) 01095 for ( j = 0; j < ny; j++ ) 01096 cgrid2.yg[i][j] = mattry->fdata[ I2D( i, j ) ]; 01097 } 01098 else if ( wrap == 1 ) 01099 { 01100 plAlloc2dGrid( &cgrid2.xg, nx + 1, ny ); 01101 plAlloc2dGrid( &cgrid2.yg, nx + 1, ny ); 01102 plAlloc2dGrid( &zwrapped, nx + 1, ny ); 01103 cgrid2.nx = nx + 1; 01104 cgrid2.ny = ny; 01105 zused = zwrapped; 01106 01107 matPtr = mattrx; 01108 for ( i = 0; i < nx; i++ ) 01109 for ( j = 0; j < ny; j++ ) 01110 cgrid2.xg[i][j] = mattrx->fdata[ I2D( i, j ) ]; 01111 01112 matPtr = mattry; 01113 for ( i = 0; i < nx; i++ ) 01114 { 01115 for ( j = 0; j < ny; j++ ) 01116 { 01117 cgrid2.yg[i][j] = mattry->fdata[ I2D( i, j ) ]; 01118 zwrapped[i][j] = z[i][j]; 01119 } 01120 } 01121 01122 for ( j = 0; j < ny; j++ ) 01123 { 01124 cgrid2.xg[nx][j] = cgrid2.xg[0][j]; 01125 cgrid2.yg[nx][j] = cgrid2.yg[0][j]; 01126 zwrapped[nx][j] = zwrapped[0][j]; 01127 } 01128 01129 // z not used in executable path after this so free it before 01130 // nx value is changed. 01131 plFree2dGrid( z, nx, ny ); 01132 01133 nx++; 01134 } 01135 else if ( wrap == 2 ) 01136 { 01137 plAlloc2dGrid( &cgrid2.xg, nx, ny + 1 ); 01138 plAlloc2dGrid( &cgrid2.yg, nx, ny + 1 ); 01139 plAlloc2dGrid( &zwrapped, nx, ny + 1 ); 01140 cgrid2.nx = nx; 01141 cgrid2.ny = ny + 1; 01142 zused = zwrapped; 01143 01144 matPtr = mattrx; 01145 for ( i = 0; i < nx; i++ ) 01146 for ( j = 0; j < ny; j++ ) 01147 cgrid2.xg[i][j] = mattrx->fdata[ I2D( i, j ) ]; 01148 01149 matPtr = mattry; 01150 for ( i = 0; i < nx; i++ ) 01151 { 01152 for ( j = 0; j < ny; j++ ) 01153 { 01154 cgrid2.yg[i][j] = mattry->fdata[ I2D( i, j ) ]; 01155 zwrapped[i][j] = z[i][j]; 01156 } 01157 } 01158 01159 for ( i = 0; i < nx; i++ ) 01160 { 01161 cgrid2.xg[i][ny] = cgrid2.xg[i][0]; 01162 cgrid2.yg[i][ny] = cgrid2.yg[i][0]; 01163 zwrapped[i][ny] = zwrapped[i][0]; 01164 } 01165 01166 // z not used in executable path after this so free it before 01167 // ny value is changed. 01168 plFree2dGrid( z, nx, ny ); 01169 01170 ny++; 01171 } 01172 else 01173 { 01174 Tcl_SetResult( interp, "Invalid wrap specifier, must be <empty>, 0, 1, or 2.", TCL_STATIC ); 01175 return TCL_ERROR; 01176 } 01177 01178 pltr = pltr2; 01179 pltr_data = &cgrid2; 01180 } 01181 else 01182 { 01183 Tcl_AppendResult( interp, 01184 "Unrecognized coordinate transformation spec:", 01185 pltrname, ", must be pltr0 pltr1 or pltr2.", 01186 (char *) NULL ); 01187 return TCL_ERROR; 01188 } 01189 if ( !arg3_is_kx ) 01190 { 01191 // default values must be set here since nx, ny can change with wrap. 01192 kx = 1; lx = nx; 01193 ky = 1; ly = ny; 01194 } 01195 01196 // printf( "plcont: nx=%d ny=%d kx=%d lx=%d ky=%d ly=%d\n", 01197 // nx, ny, kx, lx, ky, ly ); 01198 // printf( "plcont: nclev=%d\n", nclev ); 01199 // 01200 01201 // contour the data. 01202 01203 plcont( (const PLFLT * const *) zused, nx, ny, 01204 kx, lx, ky, ly, 01205 matclev->fdata, nclev, 01206 pltr, pltr_data ); 01207 01208 // Now free up any space which got allocated for our coordinate trickery. 01209 01210 // zused points to either z or zwrapped. In both cases the allocated size 01211 // was nx by ny. Now free the allocated space, and note in the case 01212 // where zused points to zwrapped, the separate z space has been freed by 01213 // previous wrap logic. 01214 plFree2dGrid( zused, nx, ny ); 01215 01216 if ( pltr == pltr1 ) 01217 { 01218 // Hmm, actually, nothing to do here currently, since we just used the 01219 // Tcl Matrix data directly, rather than allocating private space. 01220 } 01221 else if ( pltr == pltr2 ) 01222 { 01223 // printf( "plcont, freeing space for grids used in pltr2\n" ); 01224 plFree2dGrid( cgrid2.xg, nx, ny ); 01225 plFree2dGrid( cgrid2.yg, nx, ny ); 01226 } 01227 01228 plflush(); 01229 return TCL_OK; 01230 } 01231 01232 //-------------------------------------------------------------------------- 01233 // plsvect 01234 // 01235 // Implement Tcl-side setting of arrow style. 01236 //-------------------------------------------------------------------------- 01237 01238 static int 01239 plsvectCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp, 01240 int argc, const char *argv[] ) 01241 { 01242 tclMatrix *matx, *maty; 01243 PLINT npts; 01244 PLBOOL fill; 01245 01246 if ( argc == 1 01247 || ( strcmp( argv[1], "NULL" ) == 0 ) && ( strcmp( argv[2], "NULL" ) == 0 ) ) 01248 { 01249 // The user has requested to clear the transform setting. 01250 plsvect( NULL, NULL, 0, 0 ); 01251 return TCL_OK; 01252 } 01253 else if ( argc != 4 ) 01254 { 01255 Tcl_AppendResult( interp, "wrong # args: see documentation for ", 01256 argv[0], (char *) NULL ); 01257 return TCL_ERROR; 01258 } 01259 01260 matx = Tcl_GetMatrixPtr( interp, argv[1] ); 01261 if ( matx == NULL ) 01262 return TCL_ERROR; 01263 01264 if ( matx->dim != 1 ) 01265 { 01266 Tcl_SetResult( interp, "plsvect: Must use 1-d data.", TCL_STATIC ); 01267 return TCL_ERROR; 01268 } 01269 npts = matx->n[0]; 01270 01271 maty = Tcl_GetMatrixPtr( interp, argv[2] ); 01272 if ( maty == NULL ) 01273 return TCL_ERROR; 01274 01275 if ( maty->dim != 1 ) 01276 { 01277 Tcl_SetResult( interp, "plsvect: Must use 1-d data.", TCL_STATIC ); 01278 return TCL_ERROR; 01279 } 01280 01281 if ( maty->n[0] != npts ) 01282 { 01283 Tcl_SetResult( interp, "plsvect: Arrays must be of equal length", TCL_STATIC ); 01284 return TCL_ERROR; 01285 } 01286 01287 fill = (PLBOOL) atoi( argv[3] ); 01288 01289 plsvect( matx->fdata, maty->fdata, npts, fill ); 01290 01291 return TCL_OK; 01292 } 01293 01294 01295 //-------------------------------------------------------------------------- 01296 // plvect implementation (based on plcont above) 01297 //-------------------------------------------------------------------------- 01298 static int 01299 plvectCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp, 01300 int argc, const char *argv[] ) 01301 { 01302 tclMatrix *matPtr, *matu, *matv; 01303 PLINT nx, ny; 01304 const char *pltrname = "pltr0"; 01305 tclMatrix *mattrx = NULL, *mattry = NULL; 01306 PLFLT **u, **v, **uused, **vused, **uwrapped, **vwrapped; 01307 PLFLT scaling; 01308 01309 int i, j; 01310 void ( *pltr )( PLFLT, PLFLT, PLFLT *, PLFLT *, PLPointer ); 01311 PLPointer pltr_data = NULL; 01312 PLcGrid cgrid1; 01313 PLcGrid2 cgrid2; 01314 01315 int wrap = 0; 01316 01317 if ( argc < 3 ) 01318 { 01319 Tcl_AppendResult( interp, "wrong # args: see documentation for ", 01320 argv[0], (char *) NULL ); 01321 return TCL_ERROR; 01322 } 01323 01324 matu = Tcl_GetMatrixPtr( interp, argv[1] ); 01325 if ( matu == NULL ) 01326 return TCL_ERROR; 01327 01328 if ( matu->dim != 2 ) 01329 { 01330 Tcl_SetResult( interp, "Must use 2-d data.", TCL_STATIC ); 01331 return TCL_ERROR; 01332 } 01333 else 01334 { 01335 nx = matu->n[0]; 01336 ny = matu->n[1]; 01337 tclmateval_modx = nx; 01338 tclmateval_mody = ny; 01339 01340 // convert matu to 2d-array so can use standard wrap approach 01341 // from now on in this code. 01342 plAlloc2dGrid( &u, nx, ny ); 01343 for ( i = 0; i < nx; i++ ) 01344 { 01345 for ( j = 0; j < ny; j++ ) 01346 { 01347 u[i][j] = tclMatrix_feval( i, j, matu ); 01348 } 01349 } 01350 } 01351 01352 matv = Tcl_GetMatrixPtr( interp, argv[2] ); 01353 if ( matv == NULL ) 01354 return TCL_ERROR; 01355 01356 if ( matv->dim != 2 ) 01357 { 01358 Tcl_SetResult( interp, "Must use 2-d data.", TCL_STATIC ); 01359 return TCL_ERROR; 01360 } 01361 else 01362 { 01363 nx = matv->n[0]; 01364 ny = matv->n[1]; 01365 tclmateval_modx = nx; 01366 tclmateval_mody = ny; 01367 01368 // convert matv to 2d-array so can use standard wrap approach 01369 // from now on in this code. 01370 plAlloc2dGrid( &v, nx, ny ); 01371 for ( i = 0; i < nx; i++ ) 01372 { 01373 for ( j = 0; j < ny; j++ ) 01374 { 01375 v[i][j] = tclMatrix_feval( i, j, matv ); 01376 } 01377 } 01378 } 01379 01380 argc -= 3, argv += 3; 01381 01382 // The next argument has to be scaling 01383 01384 if ( argc < 1 ) 01385 { 01386 Tcl_SetResult( interp, "plvect, bogus syntax", TCL_STATIC ); 01387 return TCL_ERROR; 01388 } 01389 01390 scaling = atof( argv[0] ); 01391 argc--, argv++; 01392 01393 // Now handle trailing optional parameters, if any 01394 01395 if ( argc >= 3 ) 01396 { 01397 // There is a pltr spec, parse it. 01398 pltrname = argv[0]; 01399 mattrx = Tcl_GetMatrixPtr( interp, argv[1] ); 01400 if ( mattrx == NULL ) 01401 return TCL_ERROR; 01402 mattry = Tcl_GetMatrixPtr( interp, argv[2] ); 01403 if ( mattry == NULL ) 01404 return TCL_ERROR; 01405 01406 argc -= 3, argv += 3; 01407 } 01408 01409 if ( argc ) 01410 { 01411 // There is a wrap spec, get it. 01412 wrap = atoi( argv[0] ); 01413 01414 // Hmm, I said the the doc they could also say x or y, have to come back 01415 // to this... 01416 01417 argc--, argv++; 01418 } 01419 01420 // There had better not be anything else on the command line by this point. 01421 01422 if ( argc ) 01423 { 01424 Tcl_SetResult( interp, "plvect, bogus syntax, too many args.", TCL_STATIC ); 01425 return TCL_ERROR; 01426 } 01427 01428 // Now we need to set up the data for contouring. 01429 01430 if ( !strcmp( pltrname, "pltr0" ) ) 01431 { 01432 pltr = pltr0; 01433 uused = u; 01434 vused = v; 01435 01436 // wrapping is only supported for pltr2. 01437 if ( wrap ) 01438 { 01439 Tcl_SetResult( interp, "Must use pltr2 if want wrapping.", TCL_STATIC ); 01440 return TCL_ERROR; 01441 } 01442 } 01443 else if ( !strcmp( pltrname, "pltr1" ) ) 01444 { 01445 pltr = pltr1; 01446 cgrid1.xg = mattrx->fdata; 01447 cgrid1.nx = nx; 01448 cgrid1.yg = mattry->fdata; 01449 cgrid1.ny = ny; 01450 uused = u; 01451 vused = v; 01452 01453 // wrapping is only supported for pltr2. 01454 if ( wrap ) 01455 { 01456 Tcl_SetResult( interp, "Must use pltr2 if want wrapping.", TCL_STATIC ); 01457 return TCL_ERROR; 01458 } 01459 01460 if ( mattrx->dim != 1 || mattry->dim != 1 ) 01461 { 01462 Tcl_SetResult( interp, "Must use 1-d coord arrays with pltr1.", TCL_STATIC ); 01463 return TCL_ERROR; 01464 } 01465 01466 pltr_data = &cgrid1; 01467 } 01468 else if ( !strcmp( pltrname, "pltr2" ) ) 01469 { 01470 // printf( "plvect, setting up for pltr2\n" ); 01471 if ( !wrap ) 01472 { 01473 // printf( "plvect, no wrapping is needed.\n" ); 01474 plAlloc2dGrid( &cgrid2.xg, nx, ny ); 01475 plAlloc2dGrid( &cgrid2.yg, nx, ny ); 01476 cgrid2.nx = nx; 01477 cgrid2.ny = ny; 01478 uused = u; 01479 vused = v; 01480 01481 matPtr = mattrx; 01482 for ( i = 0; i < nx; i++ ) 01483 for ( j = 0; j < ny; j++ ) 01484 cgrid2.xg[i][j] = mattrx->fdata[ I2D( i, j ) ]; 01485 matPtr = mattry; 01486 for ( i = 0; i < nx; i++ ) 01487 { 01488 for ( j = 0; j < ny; j++ ) 01489 { 01490 cgrid2.yg[i][j] = mattry->fdata[ I2D( i, j ) ]; 01491 } 01492 } 01493 } 01494 else if ( wrap == 1 ) 01495 { 01496 plAlloc2dGrid( &cgrid2.xg, nx + 1, ny ); 01497 plAlloc2dGrid( &cgrid2.yg, nx + 1, ny ); 01498 plAlloc2dGrid( &uwrapped, nx + 1, ny ); 01499 plAlloc2dGrid( &vwrapped, nx + 1, ny ); 01500 cgrid2.nx = nx + 1; 01501 cgrid2.ny = ny; 01502 uused = uwrapped; 01503 vused = vwrapped; 01504 01505 01506 matPtr = mattrx; 01507 for ( i = 0; i < nx; i++ ) 01508 for ( j = 0; j < ny; j++ ) 01509 cgrid2.xg[i][j] = mattrx->fdata[ I2D( i, j ) ]; 01510 01511 matPtr = mattry; 01512 for ( i = 0; i < nx; i++ ) 01513 { 01514 for ( j = 0; j < ny; j++ ) 01515 { 01516 cgrid2.yg[i][j] = mattry->fdata[ I2D( i, j ) ]; 01517 uwrapped[i][j] = u[i][j]; 01518 vwrapped[i][j] = v[i][j]; 01519 } 01520 } 01521 01522 for ( j = 0; j < ny; j++ ) 01523 { 01524 cgrid2.xg[nx][j] = cgrid2.xg[0][j]; 01525 cgrid2.yg[nx][j] = cgrid2.yg[0][j]; 01526 uwrapped[nx][j] = uwrapped[0][j]; 01527 vwrapped[nx][j] = vwrapped[0][j]; 01528 } 01529 01530 // u and v not used in executable path after this so free it 01531 // before nx value is changed. 01532 plFree2dGrid( u, nx, ny ); 01533 plFree2dGrid( v, nx, ny ); 01534 nx++; 01535 } 01536 else if ( wrap == 2 ) 01537 { 01538 plAlloc2dGrid( &cgrid2.xg, nx, ny + 1 ); 01539 plAlloc2dGrid( &cgrid2.yg, nx, ny + 1 ); 01540 plAlloc2dGrid( &uwrapped, nx, ny + 1 ); 01541 plAlloc2dGrid( &vwrapped, nx, ny + 1 ); 01542 cgrid2.nx = nx; 01543 cgrid2.ny = ny + 1; 01544 uused = uwrapped; 01545 vused = vwrapped; 01546 01547 matPtr = mattrx; 01548 for ( i = 0; i < nx; i++ ) 01549 for ( j = 0; j < ny; j++ ) 01550 cgrid2.xg[i][j] = mattrx->fdata[ I2D( i, j ) ]; 01551 01552 matPtr = mattry; 01553 for ( i = 0; i < nx; i++ ) 01554 { 01555 for ( j = 0; j < ny; j++ ) 01556 { 01557 cgrid2.yg[i][j] = mattry->fdata[ I2D( i, j ) ]; 01558 uwrapped[i][j] = u[i][j]; 01559 vwrapped[i][j] = v[i][j]; 01560 } 01561 } 01562 01563 for ( i = 0; i < nx; i++ ) 01564 { 01565 cgrid2.xg[i][ny] = cgrid2.xg[i][0]; 01566 cgrid2.yg[i][ny] = cgrid2.yg[i][0]; 01567 uwrapped[i][ny] = uwrapped[i][0]; 01568 vwrapped[i][ny] = vwrapped[i][0]; 01569 } 01570 01571 // u and v not used in executable path after this so free it 01572 // before ny value is changed. 01573 plFree2dGrid( u, nx, ny ); 01574 plFree2dGrid( v, nx, ny ); 01575 01576 ny++; 01577 } 01578 else 01579 { 01580 Tcl_SetResult( interp, "Invalid wrap specifier, must be <empty>, 0, 1, or 2.", TCL_STATIC ); 01581 return TCL_ERROR; 01582 } 01583 01584 pltr = pltr2; 01585 pltr_data = &cgrid2; 01586 } 01587 else 01588 { 01589 Tcl_AppendResult( interp, 01590 "Unrecognized coordinate transformation spec:", 01591 pltrname, ", must be pltr0 pltr1 or pltr2.", 01592 (char *) NULL ); 01593 return TCL_ERROR; 01594 } 01595 01596 01597 // plot the vector data. 01598 01599 plvect( (const PLFLT * const *) uused, (const PLFLT * const *) vused, nx, ny, 01600 scaling, pltr, pltr_data ); 01601 // Now free up any space which got allocated for our coordinate trickery. 01602 01603 // uused points to either u or uwrapped. In both cases the allocated size 01604 // was nx by ny. Now free the allocated space, and note in the case 01605 // where uused points to uwrapped, the separate u space has been freed by 01606 // previous wrap logic. 01607 plFree2dGrid( uused, nx, ny ); 01608 plFree2dGrid( vused, nx, ny ); 01609 01610 if ( pltr == pltr1 ) 01611 { 01612 // Hmm, actually, nothing to do here currently, since we just used the 01613 // Tcl Matrix data directly, rather than allocating private space. 01614 } 01615 else if ( pltr == pltr2 ) 01616 { 01617 // printf( "plvect, freeing space for grids used in pltr2\n" ); 01618 plFree2dGrid( cgrid2.xg, nx, ny ); 01619 plFree2dGrid( cgrid2.yg, nx, ny ); 01620 } 01621 01622 plflush(); 01623 return TCL_OK; 01624 } 01625 01626 //-------------------------------------------------------------------------- 01627 // 01628 // plmeshCmd 01629 // 01630 // Processes plmesh Tcl command. 01631 // 01632 // We support 3 different invocation forms: 01633 // 1) plmesh x y z nx ny opt 01634 // 2) plmesh x y z opt 01635 // 3) plmesh z opt 01636 // 01637 // Form 1) is an exact mirror of the usual C API. In form 2) we infer nx and 01638 // ny from the input data, and in form 3 we inver nx and ny, and also take 01639 // the x and y arrays to just be integral spacing. 01640 //-------------------------------------------------------------------------- 01641 01642 static int 01643 plmeshCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp, 01644 int argc, const char *argv[] ) 01645 { 01646 PLINT nx, ny, opt; 01647 PLFLT *x, *y, **z; 01648 tclMatrix *matx, *maty, *matz, *matPtr; 01649 int i; 01650 01651 if ( argc == 7 ) 01652 { 01653 nx = atoi( argv[4] ); 01654 ny = atoi( argv[5] ); 01655 opt = atoi( argv[6] ); 01656 01657 matx = Tcl_GetMatrixPtr( interp, argv[1] ); 01658 if ( matx == NULL ) 01659 return TCL_ERROR; 01660 maty = Tcl_GetMatrixPtr( interp, argv[2] ); 01661 if ( maty == NULL ) 01662 return TCL_ERROR; 01663 matz = Tcl_GetMatrixPtr( interp, argv[3] ); 01664 if ( matz == NULL ) 01665 return TCL_ERROR; 01666 matPtr = matz; // For dumb indexer macro, grrrr. 01667 01668 if ( matx->type != TYPE_FLOAT || 01669 maty->type != TYPE_FLOAT || 01670 matz->type != TYPE_FLOAT ) 01671 { 01672 Tcl_SetResult( interp, "x y and z must all be float", TCL_STATIC ); 01673 return TCL_ERROR; 01674 } 01675 01676 if ( matx->dim != 1 || matx->n[0] != nx || 01677 maty->dim != 1 || maty->n[0] != ny || 01678 matz->dim != 2 || matz->n[0] != nx || matz->n[1] != ny ) 01679 { 01680 Tcl_SetResult( interp, "Inconsistent dimensions", TCL_STATIC ); 01681 return TCL_ERROR; 01682 } 01683 01684 x = matx->fdata; 01685 y = maty->fdata; 01686 01687 z = (PLFLT **) malloc( (size_t) nx * sizeof ( PLFLT * ) ); 01688 for ( i = 0; i < nx; i++ ) 01689 z[i] = &matz->fdata[ I2D( i, 0 ) ]; 01690 } 01691 else if ( argc == 5 ) 01692 { 01693 opt = atoi( argv[4] ); 01694 01695 matx = Tcl_GetMatrixPtr( interp, argv[1] ); 01696 if ( matx == NULL ) 01697 return TCL_ERROR; 01698 maty = Tcl_GetMatrixPtr( interp, argv[2] ); 01699 if ( maty == NULL ) 01700 return TCL_ERROR; 01701 matz = Tcl_GetMatrixPtr( interp, argv[3] ); 01702 if ( matz == NULL ) 01703 return TCL_ERROR; 01704 matPtr = matz; // For dumb indexer macro, grrrr. 01705 01706 if ( matx->type != TYPE_FLOAT || 01707 maty->type != TYPE_FLOAT || 01708 matz->type != TYPE_FLOAT ) 01709 { 01710 Tcl_SetResult( interp, "x y and z must all be float", TCL_STATIC ); 01711 return TCL_ERROR; 01712 } 01713 01714 nx = matx->n[0]; ny = maty->n[0]; 01715 01716 if ( matx->dim != 1 || matx->n[0] != nx || 01717 maty->dim != 1 || maty->n[0] != ny || 01718 matz->dim != 2 || matz->n[0] != nx || matz->n[1] != ny ) 01719 { 01720 Tcl_SetResult( interp, "Inconsistent dimensions", TCL_STATIC ); 01721 return TCL_ERROR; 01722 } 01723 01724 x = matx->fdata; 01725 y = maty->fdata; 01726 01727 z = (PLFLT **) malloc( (size_t) nx * sizeof ( PLFLT * ) ); 01728 for ( i = 0; i < nx; i++ ) 01729 z[i] = &matz->fdata[ I2D( i, 0 ) ]; 01730 } 01731 else if ( argc == 3 ) 01732 { 01733 Tcl_SetResult( interp, "unimplemented", TCL_STATIC ); 01734 return TCL_ERROR; 01735 } 01736 else 01737 { 01738 Tcl_AppendResult( interp, "wrong # args: should be \"plmesh ", 01739 "x y z nx ny opt\", or a valid contraction ", 01740 "thereof.", (char *) NULL ); 01741 return TCL_ERROR; 01742 } 01743 01744 plmesh( x, y, (const PLFLT * const *) z, nx, ny, opt ); 01745 01746 if ( argc == 7 ) 01747 { 01748 free( z ); 01749 } 01750 else if ( argc == 5 ) 01751 { 01752 free( z ); 01753 } 01754 else // argc == 3 01755 { 01756 } 01757 01758 plflush(); 01759 return TCL_OK; 01760 } 01761 01762 //-------------------------------------------------------------------------- 01763 // plmeshcCmd 01764 // 01765 // Processes plmeshc Tcl command. 01766 // 01767 // We support 5 different invocation forms: 01768 // 1) plmeshc x y z nx ny opt clevel nlevel 01769 // 2) plmeshc x y z nx ny opt clevel 01770 // 3) plmeshc x y z nx ny opt 01771 // 4) plmeshc x y z opt 01772 // 5) plmeshc z opt 01773 // 01774 // Form 1) is an exact mirror of the usual C API. In form 2) we infer nlevel. 01775 // In form 3,4 and 5 clevel is set to NULL. In form 4 we infer nx and 01776 // ny from the input data, and in form 5 we infer nx and ny, and also take 01777 // the x and y arrays to just be integral spacing. 01778 //-------------------------------------------------------------------------- 01779 01780 static int 01781 plmeshcCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp, 01782 int argc, const char *argv[] ) 01783 { 01784 PLINT nx, ny, opt, nlev = 10; 01785 PLFLT *x, *y, **z; 01786 PLFLT *clev; 01787 01788 tclMatrix *matx, *maty, *matz, *matPtr, *matlev; 01789 int i; 01790 01791 if ( argc == 9 ) 01792 { 01793 nlev = atoi( argv[8] ); 01794 nx = atoi( argv[4] ); 01795 ny = atoi( argv[5] ); 01796 opt = atoi( argv[6] ); 01797 01798 matx = Tcl_GetMatrixPtr( interp, argv[1] ); 01799 if ( matx == NULL ) 01800 return TCL_ERROR; 01801 maty = Tcl_GetMatrixPtr( interp, argv[2] ); 01802 if ( maty == NULL ) 01803 return TCL_ERROR; 01804 matz = Tcl_GetMatrixPtr( interp, argv[3] ); 01805 if ( matz == NULL ) 01806 return TCL_ERROR; 01807 matPtr = matz; // For dumb indexer macro, grrrr. 01808 01809 matlev = Tcl_GetMatrixPtr( interp, argv[7] ); 01810 if ( matlev == NULL ) 01811 return TCL_ERROR; 01812 01813 if ( matx->type != TYPE_FLOAT || 01814 maty->type != TYPE_FLOAT || 01815 matz->type != TYPE_FLOAT || 01816 matlev->type != TYPE_FLOAT ) 01817 { 01818 Tcl_SetResult( interp, "x y z and clevel must all be float", TCL_STATIC ); 01819 return TCL_ERROR; 01820 } 01821 01822 if ( matx->dim != 1 || matx->n[0] != nx || 01823 maty->dim != 1 || maty->n[0] != ny || 01824 matz->dim != 2 || matz->n[0] != nx || matz->n[1] != ny || 01825 matlev->dim != 1 || matlev->n[0] != nlev ) 01826 { 01827 Tcl_SetResult( interp, "popo Inconsistent dimensions", TCL_STATIC ); 01828 return TCL_ERROR; 01829 } 01830 01831 x = matx->fdata; 01832 y = maty->fdata; 01833 clev = matlev->fdata; 01834 01835 z = (PLFLT **) malloc( (size_t) nx * sizeof ( PLFLT * ) ); 01836 for ( i = 0; i < nx; i++ ) 01837 z[i] = &matz->fdata[ I2D( i, 0 ) ]; 01838 } 01839 01840 else if ( argc == 8 ) 01841 { 01842 nx = atoi( argv[4] ); 01843 ny = atoi( argv[5] ); 01844 opt = atoi( argv[6] ); 01845 01846 matx = Tcl_GetMatrixPtr( interp, argv[1] ); 01847 if ( matx == NULL ) 01848 return TCL_ERROR; 01849 maty = Tcl_GetMatrixPtr( interp, argv[2] ); 01850 if ( maty == NULL ) 01851 return TCL_ERROR; 01852 matz = Tcl_GetMatrixPtr( interp, argv[3] ); 01853 if ( matz == NULL ) 01854 return TCL_ERROR; 01855 matPtr = matz; // For dumb indexer macro, grrrr. 01856 matlev = Tcl_GetMatrixPtr( interp, argv[7] ); 01857 if ( matlev == NULL ) 01858 return TCL_ERROR; 01859 01860 if ( matx->type != TYPE_FLOAT || 01861 maty->type != TYPE_FLOAT || 01862 matz->type != TYPE_FLOAT || 01863 matlev->type != TYPE_FLOAT ) 01864 { 01865 Tcl_SetResult( interp, "x y z and clevel must all be float", TCL_STATIC ); 01866 return TCL_ERROR; 01867 } 01868 01869 if ( matx->dim != 1 || matx->n[0] != nx || 01870 maty->dim != 1 || maty->n[0] != ny || 01871 matz->dim != 2 || matz->n[0] != nx || matz->n[1] != ny || 01872 matlev->dim != 1 || matlev->n[0] != nlev ) 01873 { 01874 Tcl_SetResult( interp, "Inconsistent dimensions", TCL_STATIC ); 01875 return TCL_ERROR; 01876 } 01877 01878 x = matx->fdata; 01879 y = maty->fdata; 01880 clev = matlev->fdata; 01881 nlev = matlev->n[0]; 01882 01883 z = (PLFLT **) malloc( (size_t) nx * sizeof ( PLFLT * ) ); 01884 for ( i = 0; i < nx; i++ ) 01885 z[i] = &matz->fdata[ I2D( i, 0 ) ]; 01886 } 01887 01888 else if ( argc == 7 ) 01889 { 01890 nx = atoi( argv[4] ); 01891 ny = atoi( argv[5] ); 01892 opt = atoi( argv[6] ); 01893 clev = NULL; 01894 01895 matx = Tcl_GetMatrixPtr( interp, argv[1] ); 01896 if ( matx == NULL ) 01897 return TCL_ERROR; 01898 maty = Tcl_GetMatrixPtr( interp, argv[2] ); 01899 if ( maty == NULL ) 01900 return TCL_ERROR; 01901 matz = Tcl_GetMatrixPtr( interp, argv[3] ); 01902 if ( matz == NULL ) 01903 return TCL_ERROR; 01904 matPtr = matz; // For dumb indexer macro, grrrr. 01905 01906 if ( matx->type != TYPE_FLOAT || 01907 maty->type != TYPE_FLOAT || 01908 matz->type != TYPE_FLOAT ) 01909 { 01910 Tcl_SetResult( interp, "x y and z must all be float", TCL_STATIC ); 01911 return TCL_ERROR; 01912 } 01913 01914 if ( matx->dim != 1 || matx->n[0] != nx || 01915 maty->dim != 1 || maty->n[0] != ny || 01916 matz->dim != 2 || matz->n[0] != nx || matz->n[1] != ny ) 01917 { 01918 Tcl_SetResult( interp, "Inconsistent dimensions", TCL_STATIC ); 01919 return TCL_ERROR; 01920 } 01921 01922 x = matx->fdata; 01923 y = maty->fdata; 01924 01925 z = (PLFLT **) malloc( (size_t) nx * sizeof ( PLFLT * ) ); 01926 for ( i = 0; i < nx; i++ ) 01927 z[i] = &matz->fdata[ I2D( i, 0 ) ]; 01928 } 01929 else if ( argc == 5 ) 01930 { 01931 opt = atoi( argv[4] ); 01932 clev = NULL; 01933 01934 matx = Tcl_GetMatrixPtr( interp, argv[1] ); 01935 if ( matx == NULL ) 01936 return TCL_ERROR; 01937 maty = Tcl_GetMatrixPtr( interp, argv[2] ); 01938 if ( maty == NULL ) 01939 return TCL_ERROR; 01940 matz = Tcl_GetMatrixPtr( interp, argv[3] ); 01941 if ( matz == NULL ) 01942 return TCL_ERROR; 01943 matPtr = matz; // For dumb indexer macro, grrrr. 01944 01945 if ( matx->type != TYPE_FLOAT || 01946 maty->type != TYPE_FLOAT || 01947 matz->type != TYPE_FLOAT ) 01948 { 01949 Tcl_SetResult( interp, "x y and z must all be float", TCL_STATIC ); 01950 return TCL_ERROR; 01951 } 01952 01953 nx = matx->n[0]; ny = maty->n[0]; 01954 01955 if ( matx->dim != 1 || matx->n[0] != nx || 01956 maty->dim != 1 || maty->n[0] != ny || 01957 matz->dim != 2 || matz->n[0] != nx || matz->n[1] != ny ) 01958 { 01959 Tcl_SetResult( interp, "Inconsistent dimensions", TCL_STATIC ); 01960 return TCL_ERROR; 01961 } 01962 01963 x = matx->fdata; 01964 y = maty->fdata; 01965 01966 z = (PLFLT **) malloc( (size_t) nx * sizeof ( PLFLT * ) ); 01967 for ( i = 0; i < nx; i++ ) 01968 z[i] = &matz->fdata[ I2D( i, 0 ) ]; 01969 } 01970 else if ( argc == 3 ) 01971 { 01972 Tcl_SetResult( interp, "unimplemented", TCL_STATIC ); 01973 return TCL_ERROR; 01974 } 01975 else 01976 { 01977 Tcl_AppendResult( interp, "wrong # args: should be \"plmeshc ", 01978 "x y z nx ny opt clevel nlevel\", or a valid contraction ", 01979 "thereof.", (char *) NULL ); 01980 return TCL_ERROR; 01981 } 01982 01983 plmeshc( x, y, (const PLFLT * const *) z, nx, ny, opt, clev, nlev ); 01984 01985 if ( argc == 7 ) 01986 { 01987 free( z ); 01988 } 01989 else if ( argc == 5 ) 01990 { 01991 free( z ); 01992 } 01993 else // argc == 3 01994 { 01995 } 01996 01997 plflush(); 01998 return TCL_OK; 01999 } 02000 02001 //-------------------------------------------------------------------------- 02002 // plot3dCmd 02003 // 02004 // Processes plot3d Tcl command. 02005 // 02006 // We support 3 different invocation forms: 02007 // 1) plot3d x y z nx ny opt side 02008 // 2) plot3d x y z opt side 02009 // 3) plot3d z opt side 02010 // 02011 // Form 1) is an exact mirror of the usual C API. In form 2) we infer nx and 02012 // ny from the input data, and in form 3 we inver nx and ny, and also take 02013 // the x and y arrays to just be integral spacing. 02014 //-------------------------------------------------------------------------- 02015 02016 static int 02017 plot3dCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp, 02018 int argc, const char *argv[] ) 02019 { 02020 PLINT nx, ny, opt, side; 02021 PLFLT *x, *y, **z; 02022 tclMatrix *matx, *maty, *matz, *matPtr; 02023 int i; 02024 02025 if ( argc == 8 ) 02026 { 02027 nx = atoi( argv[4] ); 02028 ny = atoi( argv[5] ); 02029 opt = atoi( argv[6] ); 02030 side = atoi( argv[7] ); 02031 02032 matx = Tcl_GetMatrixPtr( interp, argv[1] ); 02033 if ( matx == NULL ) 02034 return TCL_ERROR; 02035 maty = Tcl_GetMatrixPtr( interp, argv[2] ); 02036 if ( maty == NULL ) 02037 return TCL_ERROR; 02038 matz = Tcl_GetMatrixPtr( interp, argv[3] ); 02039 if ( matz == NULL ) 02040 return TCL_ERROR; 02041 matPtr = matz; // For dumb indexer macro, grrrr. 02042 02043 if ( matx->type != TYPE_FLOAT || 02044 maty->type != TYPE_FLOAT || 02045 matz->type != TYPE_FLOAT ) 02046 { 02047 Tcl_SetResult( interp, "x y and z must all be float", TCL_STATIC ); 02048 return TCL_ERROR; 02049 } 02050 02051 if ( matx->dim != 1 || matx->n[0] != nx || 02052 maty->dim != 1 || maty->n[0] != ny || 02053 matz->dim != 2 || matz->n[0] != nx || matz->n[1] != ny ) 02054 { 02055 Tcl_SetResult( interp, "Inconsistent dimensions", TCL_STATIC ); 02056 return TCL_ERROR; 02057 } 02058 02059 x = matx->fdata; 02060 y = maty->fdata; 02061 02062 z = (PLFLT **) malloc( (size_t) nx * sizeof ( PLFLT * ) ); 02063 for ( i = 0; i < nx; i++ ) 02064 z[i] = &matz->fdata[ I2D( i, 0 ) ]; 02065 } 02066 else if ( argc == 6 ) 02067 { 02068 opt = atoi( argv[4] ); 02069 side = atoi( argv[5] ); 02070 02071 matx = Tcl_GetMatrixPtr( interp, argv[1] ); 02072 if ( matx == NULL ) 02073 return TCL_ERROR; 02074 maty = Tcl_GetMatrixPtr( interp, argv[2] ); 02075 if ( maty == NULL ) 02076 return TCL_ERROR; 02077 matz = Tcl_GetMatrixPtr( interp, argv[3] ); 02078 if ( matz == NULL ) 02079 return TCL_ERROR; 02080 matPtr = matz; // For dumb indexer macro, grrrr. 02081 02082 if ( matx->type != TYPE_FLOAT || 02083 maty->type != TYPE_FLOAT || 02084 matz->type != TYPE_FLOAT ) 02085 { 02086 Tcl_SetResult( interp, "x y and z must all be float", TCL_STATIC ); 02087 return TCL_ERROR; 02088 } 02089 02090 nx = matx->n[0]; ny = maty->n[0]; 02091 02092 if ( matx->dim != 1 || matx->n[0] != nx || 02093 maty->dim != 1 || maty->n[0] != ny || 02094 matz->dim != 2 || matz->n[0] != nx || matz->n[1] != ny ) 02095 { 02096 Tcl_SetResult( interp, "Inconsistent dimensions", TCL_STATIC ); 02097 return TCL_ERROR; 02098 } 02099 02100 x = matx->fdata; 02101 y = maty->fdata; 02102 02103 z = (PLFLT **) malloc( (size_t) nx * sizeof ( PLFLT * ) ); 02104 for ( i = 0; i < nx; i++ ) 02105 z[i] = &matz->fdata[ I2D( i, 0 ) ]; 02106 } 02107 else if ( argc == 4 ) 02108 { 02109 Tcl_SetResult( interp, "unimplemented", TCL_STATIC ); 02110 return TCL_ERROR; 02111 } 02112 else 02113 { 02114 Tcl_AppendResult( interp, "wrong # args: should be \"plot3d ", 02115 "x y z nx ny opt side\", or a valid contraction ", 02116 "thereof.", (char *) NULL ); 02117 return TCL_ERROR; 02118 } 02119 02120 plot3d( x, y, (const PLFLT * const *) z, nx, ny, opt, side ); 02121 02122 if ( argc == 8 ) 02123 { 02124 free( z ); 02125 } 02126 else if ( argc == 6 ) 02127 { 02128 free( z ); 02129 } 02130 else // argc == 4 02131 { 02132 } 02133 02134 plflush(); 02135 return TCL_OK; 02136 } 02137 02138 //-------------------------------------------------------------------------- 02139 // plot3dcCmd 02140 // 02141 // Processes plot3dc Tcl command. 02142 // 02143 // We support 5 different invocation forms: 02144 // 1) plot3dc x y z nx ny opt clevel nlevel 02145 // 2) plot3dc x y z nx ny opt clevel 02146 // 3) plot3dc x y z nx ny opt 02147 // 4) plot3dc x y z opt 02148 // 5) plot3dc z opt 02149 // 02150 // Form 1) is an exact mirror of the usual C API. In form 2) we infer nlevel. 02151 // In form 3,4 and 5 clevel is set to NULL. In form 4 we infer nx and 02152 // ny from the input data, and in form 5 we infer nx and ny, and also take 02153 // the x and y arrays to just be integral spacing. 02154 //-------------------------------------------------------------------------- 02155 02156 static int 02157 plot3dcCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp, 02158 int argc, const char *argv[] ) 02159 { 02160 PLINT nx, ny, opt, nlev = 10; 02161 PLFLT *x, *y, **z; 02162 PLFLT *clev; 02163 02164 tclMatrix *matx, *maty, *matz, *matPtr, *matlev; 02165 int i; 02166 02167 if ( argc == 9 ) 02168 { 02169 nlev = atoi( argv[8] ); 02170 nx = atoi( argv[4] ); 02171 ny = atoi( argv[5] ); 02172 opt = atoi( argv[6] ); 02173 02174 matx = Tcl_GetMatrixPtr( interp, argv[1] ); 02175 if ( matx == NULL ) 02176 return TCL_ERROR; 02177 maty = Tcl_GetMatrixPtr( interp, argv[2] ); 02178 if ( maty == NULL ) 02179 return TCL_ERROR; 02180 matz = Tcl_GetMatrixPtr( interp, argv[3] ); 02181 if ( matz == NULL ) 02182 return TCL_ERROR; 02183 matPtr = matz; // For dumb indexer macro, grrrr. 02184 02185 matlev = Tcl_GetMatrixPtr( interp, argv[7] ); 02186 if ( matlev == NULL ) 02187 return TCL_ERROR; 02188 02189 if ( matx->type != TYPE_FLOAT || 02190 maty->type != TYPE_FLOAT || 02191 matz->type != TYPE_FLOAT || 02192 matlev->type != TYPE_FLOAT ) 02193 { 02194 Tcl_SetResult( interp, "x y z and clevel must all be float", TCL_STATIC ); 02195 return TCL_ERROR; 02196 } 02197 02198 if ( matx->dim != 1 || matx->n[0] != nx || 02199 maty->dim != 1 || maty->n[0] != ny || 02200 matz->dim != 2 || matz->n[0] != nx || matz->n[1] != ny || 02201 matlev->dim != 1 || matlev->n[0] != nlev ) 02202 { 02203 Tcl_SetResult( interp, "popo Inconsistent dimensions", TCL_STATIC ); 02204 return TCL_ERROR; 02205 } 02206 02207 x = matx->fdata; 02208 y = maty->fdata; 02209 clev = matlev->fdata; 02210 02211 z = (PLFLT **) malloc( (size_t) nx * sizeof ( PLFLT * ) ); 02212 for ( i = 0; i < nx; i++ ) 02213 z[i] = &matz->fdata[ I2D( i, 0 ) ]; 02214 } 02215 02216 else if ( argc == 8 ) 02217 { 02218 nx = atoi( argv[4] ); 02219 ny = atoi( argv[5] ); 02220 opt = atoi( argv[6] ); 02221 02222 matx = Tcl_GetMatrixPtr( interp, argv[1] ); 02223 if ( matx == NULL ) 02224 return TCL_ERROR; 02225 maty = Tcl_GetMatrixPtr( interp, argv[2] ); 02226 if ( maty == NULL ) 02227 return TCL_ERROR; 02228 matz = Tcl_GetMatrixPtr( interp, argv[3] ); 02229 if ( matz == NULL ) 02230 return TCL_ERROR; 02231 matPtr = matz; // For dumb indexer macro, grrrr. 02232 matlev = Tcl_GetMatrixPtr( interp, argv[7] ); 02233 if ( matlev == NULL ) 02234 return TCL_ERROR; 02235 02236 if ( matx->type != TYPE_FLOAT || 02237 maty->type != TYPE_FLOAT || 02238 matz->type != TYPE_FLOAT || 02239 matlev->type != TYPE_FLOAT ) 02240 { 02241 Tcl_SetResult( interp, "x y z and clevel must all be float", TCL_STATIC ); 02242 return TCL_ERROR; 02243 } 02244 02245 if ( matx->dim != 1 || matx->n[0] != nx || 02246 maty->dim != 1 || maty->n[0] != ny || 02247 matz->dim != 2 || matz->n[0] != nx || matz->n[1] != ny || 02248 matlev->dim != 1 || matlev->n[0] != nlev ) 02249 { 02250 Tcl_SetResult( interp, "Inconsistent dimensions", TCL_STATIC ); 02251 return TCL_ERROR; 02252 } 02253 02254 x = matx->fdata; 02255 y = maty->fdata; 02256 clev = matlev->fdata; 02257 nlev = matlev->n[0]; 02258 02259 z = (PLFLT **) malloc( (size_t) nx * sizeof ( PLFLT * ) ); 02260 for ( i = 0; i < nx; i++ ) 02261 z[i] = &matz->fdata[ I2D( i, 0 ) ]; 02262 } 02263 02264 else if ( argc == 7 ) 02265 { 02266 nx = atoi( argv[4] ); 02267 ny = atoi( argv[5] ); 02268 opt = atoi( argv[6] ); 02269 clev = NULL; 02270 02271 matx = Tcl_GetMatrixPtr( interp, argv[1] ); 02272 if ( matx == NULL ) 02273 return TCL_ERROR; 02274 maty = Tcl_GetMatrixPtr( interp, argv[2] ); 02275 if ( maty == NULL ) 02276 return TCL_ERROR; 02277 matz = Tcl_GetMatrixPtr( interp, argv[3] ); 02278 if ( matz == NULL ) 02279 return TCL_ERROR; 02280 matPtr = matz; // For dumb indexer macro, grrrr. 02281 02282 if ( matx->type != TYPE_FLOAT || 02283 maty->type != TYPE_FLOAT || 02284 matz->type != TYPE_FLOAT ) 02285 { 02286 Tcl_SetResult( interp, "x y and z must all be float", TCL_STATIC ); 02287 return TCL_ERROR; 02288 } 02289 02290 if ( matx->dim != 1 || matx->n[0] != nx || 02291 maty->dim != 1 || maty->n[0] != ny || 02292 matz->dim != 2 || matz->n[0] != nx || matz->n[1] != ny ) 02293 { 02294 Tcl_SetResult( interp, "Inconsistent dimensions", TCL_STATIC ); 02295 return TCL_ERROR; 02296 } 02297 02298 x = matx->fdata; 02299 y = maty->fdata; 02300 02301 z = (PLFLT **) malloc( (size_t) nx * sizeof ( PLFLT * ) ); 02302 for ( i = 0; i < nx; i++ ) 02303 z[i] = &matz->fdata[ I2D( i, 0 ) ]; 02304 } 02305 else if ( argc == 5 ) 02306 { 02307 opt = atoi( argv[4] ); 02308 clev = NULL; 02309 02310 matx = Tcl_GetMatrixPtr( interp, argv[1] ); 02311 if ( matx == NULL ) 02312 return TCL_ERROR; 02313 maty = Tcl_GetMatrixPtr( interp, argv[2] ); 02314 if ( maty == NULL ) 02315 return TCL_ERROR; 02316 matz = Tcl_GetMatrixPtr( interp, argv[3] ); 02317 if ( matz == NULL ) 02318 return TCL_ERROR; 02319 matPtr = matz; // For dumb indexer macro, grrrr. 02320 02321 if ( matx->type != TYPE_FLOAT || 02322 maty->type != TYPE_FLOAT || 02323 matz->type != TYPE_FLOAT ) 02324 { 02325 Tcl_SetResult( interp, "x y and z must all be float", TCL_STATIC ); 02326 return TCL_ERROR; 02327 } 02328 02329 nx = matx->n[0]; ny = maty->n[0]; 02330 02331 if ( matx->dim != 1 || matx->n[0] != nx || 02332 maty->dim != 1 || maty->n[0] != ny || 02333 matz->dim != 2 || matz->n[0] != nx || matz->n[1] != ny ) 02334 { 02335 Tcl_SetResult( interp, "Inconsistent dimensions", TCL_STATIC ); 02336 return TCL_ERROR; 02337 } 02338 02339 x = matx->fdata; 02340 y = maty->fdata; 02341 02342 z = (PLFLT **) malloc( (size_t) nx * sizeof ( PLFLT * ) ); 02343 for ( i = 0; i < nx; i++ ) 02344 z[i] = &matz->fdata[ I2D( i, 0 ) ]; 02345 } 02346 else if ( argc == 3 ) 02347 { 02348 Tcl_SetResult( interp, "unimplemented", TCL_STATIC ); 02349 return TCL_ERROR; 02350 } 02351 else 02352 { 02353 Tcl_AppendResult( interp, "wrong # args: should be \"plot3dc ", 02354 "x y z nx ny opt clevel nlevel\", or a valid contraction ", 02355 "thereof.", (char *) NULL ); 02356 return TCL_ERROR; 02357 } 02358 02359 plot3dc( x, y, (const PLFLT * const *) z, nx, ny, opt, clev, nlev ); 02360 02361 if ( argc == 7 ) 02362 { 02363 free( z ); 02364 } 02365 else if ( argc == 5 ) 02366 { 02367 free( z ); 02368 } 02369 else // argc == 3 02370 { 02371 } 02372 02373 plflush(); 02374 return TCL_OK; 02375 } 02376 02377 //-------------------------------------------------------------------------- 02378 // plsurf3dCmd 02379 // 02380 // Processes plsurf3d Tcl command. 02381 // 02382 // We support 5 different invocation forms: 02383 // 1) plsurf3d x y z nx ny opt clevel nlevel 02384 // 2) plsurf3d x y z nx ny opt clevel 02385 // 3) plsurf3d x y z nx ny opt 02386 // 4) plsurf3d x y z opt 02387 // 5) plsurf3d z opt 02388 // 02389 // Form 1) is an exact mirror of the usual C API. In form 2) we infer nlevel. 02390 // In form 3,4 and 5 clevel is set to NULL. In form 4 we infer nx and 02391 // ny from the input data, and in form 5 we infer nx and ny, and also take 02392 // the x and y arrays to just be integral spacing. 02393 //-------------------------------------------------------------------------- 02394 02395 static int 02396 plsurf3dCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp, 02397 int argc, const char *argv[] ) 02398 { 02399 PLINT nx, ny, opt, nlev = 10; 02400 PLFLT *x, *y, **z; 02401 PLFLT *clev; 02402 02403 tclMatrix *matx, *maty, *matz, *matPtr, *matlev; 02404 int i; 02405 02406 if ( argc == 9 ) 02407 { 02408 nlev = atoi( argv[8] ); 02409 nx = atoi( argv[4] ); 02410 ny = atoi( argv[5] ); 02411 opt = atoi( argv[6] ); 02412 02413 matx = Tcl_GetMatrixPtr( interp, argv[1] ); 02414 if ( matx == NULL ) 02415 return TCL_ERROR; 02416 maty = Tcl_GetMatrixPtr( interp, argv[2] ); 02417 if ( maty == NULL ) 02418 return TCL_ERROR; 02419 matz = Tcl_GetMatrixPtr( interp, argv[3] ); 02420 if ( matz == NULL ) 02421 return TCL_ERROR; 02422 matPtr = matz; // For dumb indexer macro, grrrr. 02423 02424 matlev = Tcl_GetMatrixPtr( interp, argv[7] ); 02425 if ( matlev == NULL ) 02426 return TCL_ERROR; 02427 02428 if ( matx->type != TYPE_FLOAT || 02429 maty->type != TYPE_FLOAT || 02430 matz->type != TYPE_FLOAT || 02431 matlev->type != TYPE_FLOAT ) 02432 { 02433 Tcl_SetResult( interp, "x y z and clevel must all be float", TCL_STATIC ); 02434 return TCL_ERROR; 02435 } 02436 02437 if ( matx->dim != 1 || matx->n[0] != nx || 02438 maty->dim != 1 || maty->n[0] != ny || 02439 matz->dim != 2 || matz->n[0] != nx || matz->n[1] != ny || 02440 matlev->dim != 1 || matlev->n[0] != nlev ) 02441 { 02442 Tcl_SetResult( interp, "popo Inconsistent dimensions", TCL_STATIC ); 02443 return TCL_ERROR; 02444 } 02445 02446 x = matx->fdata; 02447 y = maty->fdata; 02448 clev = matlev->fdata; 02449 02450 z = (PLFLT **) malloc( (size_t) nx * sizeof ( PLFLT * ) ); 02451 for ( i = 0; i < nx; i++ ) 02452 z[i] = &matz->fdata[ I2D( i, 0 ) ]; 02453 } 02454 02455 else if ( argc == 8 ) 02456 { 02457 nx = atoi( argv[4] ); 02458 ny = atoi( argv[5] ); 02459 opt = atoi( argv[6] ); 02460 02461 matx = Tcl_GetMatrixPtr( interp, argv[1] ); 02462 if ( matx == NULL ) 02463 return TCL_ERROR; 02464 maty = Tcl_GetMatrixPtr( interp, argv[2] ); 02465 if ( maty == NULL ) 02466 return TCL_ERROR; 02467 matz = Tcl_GetMatrixPtr( interp, argv[3] ); 02468 if ( matz == NULL ) 02469 return TCL_ERROR; 02470 matPtr = matz; // For dumb indexer macro, grrrr. 02471 matlev = Tcl_GetMatrixPtr( interp, argv[7] ); 02472 if ( matlev == NULL ) 02473 return TCL_ERROR; 02474 02475 if ( matx->type != TYPE_FLOAT || 02476 maty->type != TYPE_FLOAT || 02477 matz->type != TYPE_FLOAT || 02478 matlev->type != TYPE_FLOAT ) 02479 { 02480 Tcl_SetResult( interp, "x y z and clevel must all be float", TCL_STATIC ); 02481 return TCL_ERROR; 02482 } 02483 02484 if ( matx->dim != 1 || matx->n[0] != nx || 02485 maty->dim != 1 || maty->n[0] != ny || 02486 matz->dim != 2 || matz->n[0] != nx || matz->n[1] != ny || 02487 matlev->dim != 1 || matlev->n[0] != nlev ) 02488 { 02489 Tcl_SetResult( interp, "Inconsistent dimensions", TCL_STATIC ); 02490 return TCL_ERROR; 02491 } 02492 02493 x = matx->fdata; 02494 y = maty->fdata; 02495 clev = matlev->fdata; 02496 nlev = matlev->n[0]; 02497 02498 z = (PLFLT **) malloc( (size_t) nx * sizeof ( PLFLT * ) ); 02499 for ( i = 0; i < nx; i++ ) 02500 z[i] = &matz->fdata[ I2D( i, 0 ) ]; 02501 } 02502 02503 else if ( argc == 7 ) 02504 { 02505 nx = atoi( argv[4] ); 02506 ny = atoi( argv[5] ); 02507 opt = atoi( argv[6] ); 02508 clev = NULL; 02509 02510 matx = Tcl_GetMatrixPtr( interp, argv[1] ); 02511 if ( matx == NULL ) 02512 return TCL_ERROR; 02513 maty = Tcl_GetMatrixPtr( interp, argv[2] ); 02514 if ( maty == NULL ) 02515 return TCL_ERROR; 02516 matz = Tcl_GetMatrixPtr( interp, argv[3] ); 02517 if ( matz == NULL ) 02518 return TCL_ERROR; 02519 matPtr = matz; // For dumb indexer macro, grrrr. 02520 02521 if ( matx->type != TYPE_FLOAT || 02522 maty->type != TYPE_FLOAT || 02523 matz->type != TYPE_FLOAT ) 02524 { 02525 Tcl_SetResult( interp, "x y and z must all be float", TCL_STATIC ); 02526 return TCL_ERROR; 02527 } 02528 02529 if ( matx->dim != 1 || matx->n[0] != nx || 02530 maty->dim != 1 || maty->n[0] != ny || 02531 matz->dim != 2 || matz->n[0] != nx || matz->n[1] != ny ) 02532 { 02533 Tcl_SetResult( interp, "Inconsistent dimensions", TCL_STATIC ); 02534 return TCL_ERROR; 02535 } 02536 02537 x = matx->fdata; 02538 y = maty->fdata; 02539 02540 z = (PLFLT **) malloc( (size_t) nx * sizeof ( PLFLT * ) ); 02541 for ( i = 0; i < nx; i++ ) 02542 z[i] = &matz->fdata[ I2D( i, 0 ) ]; 02543 } 02544 else if ( argc == 5 ) 02545 { 02546 opt = atoi( argv[4] ); 02547 clev = NULL; 02548 02549 matx = Tcl_GetMatrixPtr( interp, argv[1] ); 02550 if ( matx == NULL ) 02551 return TCL_ERROR; 02552 maty = Tcl_GetMatrixPtr( interp, argv[2] ); 02553 if ( maty == NULL ) 02554 return TCL_ERROR; 02555 matz = Tcl_GetMatrixPtr( interp, argv[3] ); 02556 if ( matz == NULL ) 02557 return TCL_ERROR; 02558 matPtr = matz; // For dumb indexer macro, grrrr. 02559 02560 if ( matx->type != TYPE_FLOAT || 02561 maty->type != TYPE_FLOAT || 02562 matz->type != TYPE_FLOAT ) 02563 { 02564 Tcl_SetResult( interp, "x y and z must all be float", TCL_STATIC ); 02565 return TCL_ERROR; 02566 } 02567 02568 nx = matx->n[0]; ny = maty->n[0]; 02569 02570 if ( matx->dim != 1 || matx->n[0] != nx || 02571 maty->dim != 1 || maty->n[0] != ny || 02572 matz->dim != 2 || matz->n[0] != nx || matz->n[1] != ny ) 02573 { 02574 Tcl_SetResult( interp, "Inconsistent dimensions", TCL_STATIC ); 02575 return TCL_ERROR; 02576 } 02577 02578 x = matx->fdata; 02579 y = maty->fdata; 02580 02581 z = (PLFLT **) malloc( (size_t) nx * sizeof ( PLFLT * ) ); 02582 for ( i = 0; i < nx; i++ ) 02583 z[i] = &matz->fdata[ I2D( i, 0 ) ]; 02584 } 02585 else if ( argc == 3 ) 02586 { 02587 Tcl_SetResult( interp, "unimplemented", TCL_STATIC ); 02588 return TCL_ERROR; 02589 } 02590 else 02591 { 02592 Tcl_AppendResult( interp, "wrong # args: should be \"plsurf3d ", 02593 "x y z nx ny opt clevel nlevel\", or a valid contraction ", 02594 "thereof.", (char *) NULL ); 02595 return TCL_ERROR; 02596 } 02597 02598 plsurf3d( x, y, (const PLFLT * const *) z, nx, ny, opt, clev, nlev ); 02599 02600 if ( argc == 7 ) 02601 { 02602 free( z ); 02603 } 02604 else if ( argc == 5 ) 02605 { 02606 free( z ); 02607 } 02608 else // argc == 3 02609 { 02610 } 02611 02612 plflush(); 02613 return TCL_OK; 02614 } 02615 02616 //-------------------------------------------------------------------------- 02617 // plranddCmd 02618 // 02619 // Return a random number 02620 //-------------------------------------------------------------------------- 02621 02622 static int 02623 plranddCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp, 02624 int argc, const char **argv ) 02625 { 02626 if ( argc != 1 ) 02627 { 02628 Tcl_AppendResult( interp, "wrong # args: ", 02629 argv[0], " takes no arguments", (char *) NULL ); 02630 return TCL_ERROR; 02631 } 02632 else 02633 { 02634 Tcl_SetObjResult( interp, Tcl_NewDoubleObj( plrandd() ) ); 02635 return TCL_OK; 02636 } 02637 } 02638 02639 //-------------------------------------------------------------------------- 02640 // plsetoptCmd 02641 // 02642 // Processes plsetopt Tcl command. 02643 //-------------------------------------------------------------------------- 02644 02645 static int 02646 plsetoptCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp, 02647 int argc, const char **argv ) 02648 { 02649 if ( argc < 2 || argc > 3 ) 02650 { 02651 Tcl_AppendResult( interp, "wrong # args: should be \"", 02652 argv[0], " option ?argument?\"", (char *) NULL ); 02653 return TCL_ERROR; 02654 } 02655 02656 plsetopt( argv[1], argv[2] ); 02657 02658 plflush(); 02659 return TCL_OK; 02660 } 02661 02662 //-------------------------------------------------------------------------- 02663 // plshadeCmd 02664 // 02665 // Processes plshade Tcl command. 02666 // C version takes: 02667 // data, nx, ny, defined, 02668 // xmin, xmax, ymin, ymax, 02669 // sh_min, sh_max, sh_cmap, sh_color, sh_width, 02670 // min_col, min_wid, max_col, max_wid, 02671 // plfill, rect, pltr, pltr_data 02672 // 02673 // We will be getting data through a 2-d Matrix, which carries along 02674 // nx and ny, so no need for those. Toss defined since it's not supported 02675 // anyway. Toss plfill since it is the only valid choice. Take an optional 02676 // pltr spec just as for plcont or an alternative of NULL pltr, and add a 02677 // wrapping specifier, as in plcont. So the new command looks like: 02678 // 02679 // *INDENT-OFF* 02680 // plshade z xmin xmax ymin ymax 02681 // sh_min sh_max sh_cmap sh_color sh_width 02682 // min_col min_wid max_col max_wid 02683 // rect [[pltr x y] | NULL ] [wrap] 02684 // *INDENT-ON* 02685 //-------------------------------------------------------------------------- 02686 02687 static int 02688 plshadeCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp, 02689 int argc, const char *argv[] ) 02690 { 02691 tclMatrix *matPtr, *matz, *mattrx = NULL, *mattry = NULL; 02692 PLFLT **z, **zused, **zwrapped; 02693 PLFLT xmin, xmax, ymin, ymax, sh_min, sh_max, sh_col; 02694 02695 PLINT sh_cmap = 1; 02696 PLFLT sh_wid = 2.; 02697 PLINT min_col = 1, max_col = 0; 02698 PLFLT min_wid = 0., max_wid = 0.; 02699 PLINT rect = 1; 02700 const char *pltrname = "pltr0"; 02701 void ( *pltr )( PLFLT, PLFLT, PLFLT *, PLFLT *, PLPointer ); 02702 PLPointer pltr_data = NULL; 02703 PLcGrid cgrid1; 02704 PLcGrid2 cgrid2; 02705 PLINT wrap = 0; 02706 int nx, ny, i, j; 02707 02708 if ( argc < 16 ) 02709 { 02710 Tcl_AppendResult( interp, "bogus syntax for plshade, see doc.", 02711 (char *) NULL ); 02712 return TCL_ERROR; 02713 } 02714 02715 matz = Tcl_GetMatrixPtr( interp, argv[1] ); 02716 if ( matz == NULL ) 02717 return TCL_ERROR; 02718 if ( matz->dim != 2 ) 02719 { 02720 Tcl_SetResult( interp, "Must plot a 2-d matrix.", TCL_STATIC ); 02721 return TCL_ERROR; 02722 } 02723 02724 nx = matz->n[0]; 02725 ny = matz->n[1]; 02726 02727 tclmateval_modx = nx; 02728 tclmateval_mody = ny; 02729 02730 // convert matz to 2d-array so can use standard wrap approach 02731 // from now on in this code. 02732 plAlloc2dGrid( &z, nx, ny ); 02733 for ( i = 0; i < nx; i++ ) 02734 { 02735 for ( j = 0; j < ny; j++ ) 02736 { 02737 z[i][j] = tclMatrix_feval( i, j, matz ); 02738 } 02739 } 02740 02741 xmin = atof( argv[2] ); 02742 xmax = atof( argv[3] ); 02743 ymin = atof( argv[4] ); 02744 ymax = atof( argv[5] ); 02745 sh_min = atof( argv[6] ); 02746 sh_max = atof( argv[7] ); 02747 sh_cmap = atoi( argv[8] ); 02748 sh_col = atof( argv[9] ); 02749 sh_wid = atof( argv[10] ); 02750 min_col = atoi( argv[11] ); 02751 min_wid = atoi( argv[12] ); 02752 max_col = atoi( argv[13] ); 02753 max_wid = atof( argv[14] ); 02754 rect = atoi( argv[15] ); 02755 02756 argc -= 16, argv += 16; 02757 02758 if ( argc >= 3 ) 02759 { 02760 pltrname = argv[0]; 02761 mattrx = Tcl_GetMatrixPtr( interp, argv[1] ); 02762 if ( mattrx == NULL ) 02763 return TCL_ERROR; 02764 mattry = Tcl_GetMatrixPtr( interp, argv[2] ); 02765 if ( mattry == NULL ) 02766 return TCL_ERROR; 02767 02768 argc -= 3, argv += 3; 02769 } 02770 else if ( argc && !strcmp( argv[0], "NULL" ) ) 02771 { 02772 pltrname = argv[0]; 02773 argc -= 1, argv += 1; 02774 } 02775 02776 if ( argc ) 02777 { 02778 wrap = atoi( argv[0] ); 02779 argc--, argv++; 02780 } 02781 02782 if ( argc ) 02783 { 02784 Tcl_SetResult( interp, "plshade: bogus arg list", TCL_STATIC ); 02785 return TCL_ERROR; 02786 } 02787 02788 // Figure out which coordinate transformation model is being used, and setup 02789 // accordingly. 02790 02791 if ( !strcmp( pltrname, "NULL" ) ) 02792 { 02793 pltr = NULL; 02794 zused = z; 02795 02796 // wrapping is only supported for pltr2. 02797 if ( wrap ) 02798 { 02799 Tcl_SetResult( interp, "Must use pltr2 if want wrapping.", TCL_STATIC ); 02800 return TCL_ERROR; 02801 } 02802 } 02803 else if ( !strcmp( pltrname, "pltr0" ) ) 02804 { 02805 pltr = pltr0; 02806 zused = z; 02807 02808 // wrapping is only supported for pltr2. 02809 if ( wrap ) 02810 { 02811 Tcl_SetResult( interp, "Must use pltr2 if want wrapping.", TCL_STATIC ); 02812 return TCL_ERROR; 02813 } 02814 } 02815 else if ( !strcmp( pltrname, "pltr1" ) ) 02816 { 02817 pltr = pltr1; 02818 cgrid1.xg = mattrx->fdata; 02819 cgrid1.nx = nx; 02820 cgrid1.yg = mattry->fdata; 02821 cgrid1.ny = ny; 02822 zused = z; 02823 02824 // wrapping is only supported for pltr2. 02825 if ( wrap ) 02826 { 02827 Tcl_SetResult( interp, "Must use pltr2 if want wrapping.", TCL_STATIC ); 02828 return TCL_ERROR; 02829 } 02830 02831 if ( mattrx->dim != 1 || mattry->dim != 1 ) 02832 { 02833 Tcl_SetResult( interp, "Must use 1-d coord arrays with pltr1.", TCL_STATIC ); 02834 return TCL_ERROR; 02835 } 02836 02837 pltr_data = &cgrid1; 02838 } 02839 else if ( !strcmp( pltrname, "pltr2" ) ) 02840 { 02841 // printf( "plshade, setting up for pltr2\n" ); 02842 if ( !wrap ) 02843 { 02844 // printf( "plshade, no wrapping is needed.\n" ); 02845 plAlloc2dGrid( &cgrid2.xg, nx, ny ); 02846 plAlloc2dGrid( &cgrid2.yg, nx, ny ); 02847 cgrid2.nx = nx; 02848 cgrid2.ny = ny; 02849 zused = z; 02850 02851 matPtr = mattrx; 02852 for ( i = 0; i < nx; i++ ) 02853 for ( j = 0; j < ny; j++ ) 02854 cgrid2.xg[i][j] = mattrx->fdata[ I2D( i, j ) ]; 02855 02856 matPtr = mattry; 02857 for ( i = 0; i < nx; i++ ) 02858 for ( j = 0; j < ny; j++ ) 02859 cgrid2.yg[i][j] = mattry->fdata[ I2D( i, j ) ]; 02860 } 02861 else if ( wrap == 1 ) 02862 { 02863 plAlloc2dGrid( &cgrid2.xg, nx + 1, ny ); 02864 plAlloc2dGrid( &cgrid2.yg, nx + 1, ny ); 02865 plAlloc2dGrid( &zwrapped, nx + 1, ny ); 02866 cgrid2.nx = nx + 1; 02867 cgrid2.ny = ny; 02868 zused = zwrapped; 02869 02870 matPtr = mattrx; 02871 for ( i = 0; i < nx; i++ ) 02872 for ( j = 0; j < ny; j++ ) 02873 cgrid2.xg[i][j] = mattrx->fdata[ I2D( i, j ) ]; 02874 02875 matPtr = mattry; 02876 for ( i = 0; i < nx; i++ ) 02877 { 02878 for ( j = 0; j < ny; j++ ) 02879 { 02880 cgrid2.yg[i][j] = mattry->fdata[ I2D( i, j ) ]; 02881 zwrapped[i][j] = z[i][j]; 02882 } 02883 } 02884 02885 for ( j = 0; j < ny; j++ ) 02886 { 02887 cgrid2.xg[nx][j] = cgrid2.xg[0][j]; 02888 cgrid2.yg[nx][j] = cgrid2.yg[0][j]; 02889 zwrapped[nx][j] = zwrapped[0][j]; 02890 } 02891 02892 // z not used in executable path after this so free it before 02893 // nx value is changed. 02894 plFree2dGrid( z, nx, ny ); 02895 02896 nx++; 02897 } 02898 else if ( wrap == 2 ) 02899 { 02900 plAlloc2dGrid( &cgrid2.xg, nx, ny + 1 ); 02901 plAlloc2dGrid( &cgrid2.yg, nx, ny + 1 ); 02902 plAlloc2dGrid( &zwrapped, nx, ny + 1 ); 02903 cgrid2.nx = nx; 02904 cgrid2.ny = ny + 1; 02905 zused = zwrapped; 02906 02907 matPtr = mattrx; 02908 for ( i = 0; i < nx; i++ ) 02909 for ( j = 0; j < ny; j++ ) 02910 cgrid2.xg[i][j] = mattrx->fdata[ I2D( i, j ) ]; 02911 02912 matPtr = mattry; 02913 for ( i = 0; i < nx; i++ ) 02914 { 02915 for ( j = 0; j < ny; j++ ) 02916 { 02917 cgrid2.yg[i][j] = mattry->fdata[ I2D( i, j ) ]; 02918 zwrapped[i][j] = z[i][j]; 02919 } 02920 } 02921 02922 for ( i = 0; i < nx; i++ ) 02923 { 02924 cgrid2.xg[i][ny] = cgrid2.xg[i][0]; 02925 cgrid2.yg[i][ny] = cgrid2.yg[i][0]; 02926 zwrapped[i][ny] = zwrapped[i][0]; 02927 } 02928 02929 // z not used in executable path after this so free it before 02930 // ny value is changed. 02931 plFree2dGrid( z, nx, ny ); 02932 02933 ny++; 02934 } 02935 else 02936 { 02937 Tcl_SetResult( interp, "Invalid wrap specifier, must be <empty>, 0, 1, or 2.", TCL_STATIC ); 02938 return TCL_ERROR; 02939 } 02940 02941 pltr = pltr2; 02942 pltr_data = &cgrid2; 02943 } 02944 else 02945 { 02946 Tcl_AppendResult( interp, 02947 "Unrecognized coordinate transformation spec:", 02948 pltrname, ", must be NULL, pltr0, pltr1, or pltr2.", 02949 (char *) NULL ); 02950 return TCL_ERROR; 02951 } 02952 02953 // Now go make the plot. 02954 02955 plshade( (const PLFLT * const *) zused, nx, ny, NULL, 02956 xmin, xmax, ymin, ymax, 02957 sh_min, sh_max, sh_cmap, sh_col, sh_wid, 02958 min_col, min_wid, max_col, max_wid, 02959 plfill, rect, pltr, pltr_data ); 02960 02961 // Now free up any space which got allocated for our coordinate trickery. 02962 02963 // zused points to either z or zwrapped. In both cases the allocated size 02964 // was nx by ny. Now free the allocated space, and note in the case 02965 // where zused points to zwrapped, the separate z space has been freed by 02966 // previous wrap logic. 02967 plFree2dGrid( zused, nx, ny ); 02968 02969 if ( pltr == pltr1 ) 02970 { 02971 // Hmm, actually, nothing to do here currently, since we just used the 02972 // Tcl Matrix data directly, rather than allocating private space. 02973 } 02974 else if ( pltr == pltr2 ) 02975 { 02976 // printf( "plshade, freeing space for grids used in pltr2\n" ); 02977 plFree2dGrid( cgrid2.xg, nx, ny ); 02978 plFree2dGrid( cgrid2.yg, nx, ny ); 02979 } 02980 02981 plflush(); 02982 return TCL_OK; 02983 } 02984 02985 //-------------------------------------------------------------------------- 02986 // plshadesCmd 02987 // 02988 // Processes plshades Tcl command. 02989 // C version takes: 02990 // data, nx, ny, defined, 02991 // xmin, xmax, ymin, ymax, 02992 // clevel, nlevel, fill_width, cont_color, cont_width, 02993 // plfill, rect, pltr, pltr_data 02994 // 02995 // We will be getting data through a 2-d Matrix, which carries along 02996 // nx and ny, so no need for those. Toss defined since it's not supported 02997 // anyway. clevel will be via a 1-d matrix, which carries along nlevel, so 02998 // no need for that. Toss plfill since it is the only valid choice. 02999 // Take an optional pltr spec just as for plcont or an alternative of 03000 // NULL pltr, and add a wrapping specifier, as in plcont. 03001 // So the new command looks like: 03002 // 03003 // *INDENT-OFF* 03004 // plshades z xmin xmax ymin ymax 03005 // clevel, fill_width, cont_color, cont_width 03006 // rect [[pltr x y] | NULL] [wrap] 03007 // *INDENT-ON* 03008 //-------------------------------------------------------------------------- 03009 03010 static int 03011 plshadesCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp, 03012 int argc, const char *argv[] ) 03013 { 03014 tclMatrix *matPtr, *matz, *mattrx = NULL, *mattry = NULL; 03015 tclMatrix *matclevel = NULL; 03016 PLFLT **z, **zused, **zwrapped; 03017 PLFLT xmin, xmax, ymin, ymax; 03018 PLINT cont_color = 0; 03019 PLFLT fill_width = 0., cont_width = 0.; 03020 PLINT rect = 1; 03021 const char *pltrname = "pltr0"; 03022 void ( *pltr )( PLFLT, PLFLT, PLFLT *, PLFLT *, PLPointer ); 03023 PLPointer pltr_data = NULL; 03024 PLcGrid cgrid1; 03025 PLcGrid2 cgrid2; 03026 PLINT wrap = 0; 03027 int nx, ny, nlevel, i, j; 03028 03029 if ( argc < 11 ) 03030 { 03031 Tcl_AppendResult( interp, "bogus syntax for plshades, see doc.", 03032 (char *) NULL ); 03033 return TCL_ERROR; 03034 } 03035 03036 matz = Tcl_GetMatrixPtr( interp, argv[1] ); 03037 if ( matz == NULL ) 03038 return TCL_ERROR; 03039 if ( matz->dim != 2 ) 03040 { 03041 Tcl_SetResult( interp, "Must plot a 2-d matrix.", TCL_STATIC ); 03042 return TCL_ERROR; 03043 } 03044 03045 nx = matz->n[0]; 03046 ny = matz->n[1]; 03047 03048 tclmateval_modx = nx; 03049 tclmateval_mody = ny; 03050 03051 // convert matz to 2d-array so can use standard wrap approach 03052 // from now on in this code. 03053 plAlloc2dGrid( &z, nx, ny ); 03054 for ( i = 0; i < nx; i++ ) 03055 { 03056 for ( j = 0; j < ny; j++ ) 03057 { 03058 z[i][j] = tclMatrix_feval( i, j, matz ); 03059 } 03060 } 03061 03062 xmin = atof( argv[2] ); 03063 xmax = atof( argv[3] ); 03064 ymin = atof( argv[4] ); 03065 ymax = atof( argv[5] ); 03066 03067 matclevel = Tcl_GetMatrixPtr( interp, argv[6] ); 03068 if ( matclevel == NULL ) 03069 return TCL_ERROR; 03070 nlevel = matclevel->n[0]; 03071 if ( matclevel->dim != 1 ) 03072 { 03073 Tcl_SetResult( interp, "clevel must be 1-d matrix.", TCL_STATIC ); 03074 return TCL_ERROR; 03075 } 03076 03077 fill_width = atof( argv[7] ); 03078 cont_color = atoi( argv[8] ); 03079 cont_width = atof( argv[9] ); 03080 rect = atoi( argv[10] ); 03081 03082 argc -= 11, argv += 11; 03083 03084 if ( argc >= 3 ) 03085 { 03086 pltrname = argv[0]; 03087 mattrx = Tcl_GetMatrixPtr( interp, argv[1] ); 03088 if ( mattrx == NULL ) 03089 return TCL_ERROR; 03090 mattry = Tcl_GetMatrixPtr( interp, argv[2] ); 03091 if ( mattry == NULL ) 03092 return TCL_ERROR; 03093 03094 argc -= 3, argv += 3; 03095 } 03096 else if ( argc && !strcmp( argv[0], "NULL" ) ) 03097 { 03098 pltrname = argv[0]; 03099 argc -= 1, argv += 1; 03100 } 03101 03102 if ( argc ) 03103 { 03104 wrap = atoi( argv[0] ); 03105 argc--, argv++; 03106 } 03107 03108 if ( argc ) 03109 { 03110 Tcl_SetResult( interp, "plshades: bogus arg list", TCL_STATIC ); 03111 return TCL_ERROR; 03112 } 03113 03114 // Figure out which coordinate transformation model is being used, and setup 03115 // accordingly. 03116 03117 if ( !strcmp( pltrname, "NULL" ) ) 03118 { 03119 pltr = NULL; 03120 zused = z; 03121 03122 // wrapping is only supported for pltr2. 03123 if ( wrap ) 03124 { 03125 Tcl_SetResult( interp, "Must use pltr2 if want wrapping.", TCL_STATIC ); 03126 return TCL_ERROR; 03127 } 03128 } 03129 else if ( !strcmp( pltrname, "pltr0" ) ) 03130 { 03131 pltr = pltr0; 03132 zused = z; 03133 03134 // wrapping is only supported for pltr2. 03135 if ( wrap ) 03136 { 03137 Tcl_SetResult( interp, "Must use pltr2 if want wrapping.", TCL_STATIC ); 03138 return TCL_ERROR; 03139 } 03140 } 03141 else if ( !strcmp( pltrname, "pltr1" ) ) 03142 { 03143 pltr = pltr1; 03144 cgrid1.xg = mattrx->fdata; 03145 cgrid1.nx = nx; 03146 cgrid1.yg = mattry->fdata; 03147 cgrid1.ny = ny; 03148 zused = z; 03149 03150 // wrapping is only supported for pltr2. 03151 if ( wrap ) 03152 { 03153 Tcl_SetResult( interp, "Must use pltr2 if want wrapping.", TCL_STATIC ); 03154 return TCL_ERROR; 03155 } 03156 03157 if ( mattrx->dim != 1 || mattry->dim != 1 ) 03158 { 03159 Tcl_SetResult( interp, "Must use 1-d coord arrays with pltr1.", TCL_STATIC ); 03160 return TCL_ERROR; 03161 } 03162 03163 pltr_data = &cgrid1; 03164 } 03165 else if ( !strcmp( pltrname, "pltr2" ) ) 03166 { 03167 // printf( "plshades, setting up for pltr2\n" ); 03168 if ( !wrap ) 03169 { 03170 // printf( "plshades, no wrapping is needed.\n" ); 03171 plAlloc2dGrid( &cgrid2.xg, nx, ny ); 03172 plAlloc2dGrid( &cgrid2.yg, nx, ny ); 03173 cgrid2.nx = nx; 03174 cgrid2.ny = ny; 03175 zused = z; 03176 03177 matPtr = mattrx; 03178 for ( i = 0; i < nx; i++ ) 03179 for ( j = 0; j < ny; j++ ) 03180 cgrid2.xg[i][j] = mattrx->fdata[ I2D( i, j ) ]; 03181 03182 matPtr = mattry; 03183 for ( i = 0; i < nx; i++ ) 03184 for ( j = 0; j < ny; j++ ) 03185 cgrid2.yg[i][j] = mattry->fdata[ I2D( i, j ) ]; 03186 } 03187 else if ( wrap == 1 ) 03188 { 03189 plAlloc2dGrid( &cgrid2.xg, nx + 1, ny ); 03190 plAlloc2dGrid( &cgrid2.yg, nx + 1, ny ); 03191 plAlloc2dGrid( &zwrapped, nx + 1, ny ); 03192 cgrid2.nx = nx + 1; 03193 cgrid2.ny = ny; 03194 zused = zwrapped; 03195 03196 matPtr = mattrx; 03197 for ( i = 0; i < nx; i++ ) 03198 for ( j = 0; j < ny; j++ ) 03199 cgrid2.xg[i][j] = mattrx->fdata[ I2D( i, j ) ]; 03200 03201 matPtr = mattry; 03202 for ( i = 0; i < nx; i++ ) 03203 { 03204 for ( j = 0; j < ny; j++ ) 03205 { 03206 cgrid2.yg[i][j] = mattry->fdata[ I2D( i, j ) ]; 03207 zwrapped[i][j] = z[i][j]; 03208 } 03209 } 03210 03211 for ( j = 0; j < ny; j++ ) 03212 { 03213 cgrid2.xg[nx][j] = cgrid2.xg[0][j]; 03214 cgrid2.yg[nx][j] = cgrid2.yg[0][j]; 03215 zwrapped[nx][j] = zwrapped[0][j]; 03216 } 03217 03218 // z not used in executable path after this so free it before 03219 // nx value is changed. 03220 plFree2dGrid( z, nx, ny ); 03221 03222 nx++; 03223 } 03224 else if ( wrap == 2 ) 03225 { 03226 plAlloc2dGrid( &cgrid2.xg, nx, ny + 1 ); 03227 plAlloc2dGrid( &cgrid2.yg, nx, ny + 1 ); 03228 plAlloc2dGrid( &zwrapped, nx, ny + 1 ); 03229 cgrid2.nx = nx; 03230 cgrid2.ny = ny + 1; 03231 zused = zwrapped; 03232 03233 matPtr = mattrx; 03234 for ( i = 0; i < nx; i++ ) 03235 for ( j = 0; j < ny; j++ ) 03236 cgrid2.xg[i][j] = mattrx->fdata[ I2D( i, j ) ]; 03237 03238 matPtr = mattry; 03239 for ( i = 0; i < nx; i++ ) 03240 { 03241 for ( j = 0; j < ny; j++ ) 03242 { 03243 cgrid2.yg[i][j] = mattry->fdata[ I2D( i, j ) ]; 03244 zwrapped[i][j] = z[i][j]; 03245 } 03246 } 03247 03248 for ( i = 0; i < nx; i++ ) 03249 { 03250 cgrid2.xg[i][ny] = cgrid2.xg[i][0]; 03251 cgrid2.yg[i][ny] = cgrid2.yg[i][0]; 03252 zwrapped[i][ny] = zwrapped[i][0]; 03253 } 03254 03255 // z not used in executable path after this so free it before 03256 // ny value is changed. 03257 plFree2dGrid( z, nx, ny ); 03258 03259 ny++; 03260 } 03261 else 03262 { 03263 Tcl_SetResult( interp, "Invalid wrap specifier, must be <empty>, 0, 1, or 2.", TCL_STATIC ); 03264 return TCL_ERROR; 03265 } 03266 03267 pltr = pltr2; 03268 pltr_data = &cgrid2; 03269 } 03270 else 03271 { 03272 Tcl_AppendResult( interp, 03273 "Unrecognized coordinate transformation spec:", 03274 pltrname, ", must be NULL, pltr0, pltr1, or pltr2.", 03275 (char *) NULL ); 03276 return TCL_ERROR; 03277 } 03278 03279 // Now go make the plot. 03280 03281 plshades( (const PLFLT * const *) zused, nx, ny, NULL, 03282 xmin, xmax, ymin, ymax, 03283 matclevel->fdata, nlevel, fill_width, cont_color, cont_width, 03284 plfill, rect, pltr, pltr_data ); 03285 03286 // Now free up any space which got allocated for our coordinate trickery. 03287 03288 // zused points to either z or zwrapped. In both cases the allocated size 03289 // was nx by ny. Now free the allocated space, and note in the case 03290 // where zused points to zwrapped, the separate z space has been freed by 03291 // previous wrap logic. 03292 plFree2dGrid( zused, nx, ny ); 03293 03294 if ( pltr == pltr1 ) 03295 { 03296 // Hmm, actually, nothing to do here currently, since we just used the 03297 // Tcl Matrix data directly, rather than allocating private space. 03298 } 03299 else if ( pltr == pltr2 ) 03300 { 03301 // printf( "plshades, freeing space for grids used in pltr2\n" ); 03302 plFree2dGrid( cgrid2.xg, nx, ny ); 03303 plFree2dGrid( cgrid2.yg, nx, ny ); 03304 } 03305 03306 plflush(); 03307 return TCL_OK; 03308 } 03309 03310 //-------------------------------------------------------------------------- 03311 // mapform 03312 // 03313 // Defines our coordinate transformation. 03314 // x[], y[] are the coordinates to be plotted. 03315 //-------------------------------------------------------------------------- 03316 03317 static const char *transform_name; // Name of the procedure that transforms the 03318 // coordinates 03319 static Tcl_Interp *tcl_interp; // Pointer to the current interp 03320 static int return_code; // Saved return code 03321 03322 void 03323 mapform( PLINT n, PLFLT *x, PLFLT *y ) 03324 { 03325 int i; 03326 char *cmd; 03327 tclMatrix *xPtr, *yPtr; 03328 03329 cmd = (char *) malloc( strlen( transform_name ) + 40 ); 03330 03331 // Build the (new) matrix commands and fill the matrices 03332 sprintf( cmd, "matrix %cx f %d", (char) 1, n ); 03333 if ( Tcl_Eval( tcl_interp, cmd ) != TCL_OK ) 03334 { 03335 return_code = TCL_ERROR; 03336 free( cmd ); 03337 return; 03338 } 03339 sprintf( cmd, "matrix %cy f %d", (char) 1, n ); 03340 if ( Tcl_Eval( tcl_interp, cmd ) != TCL_OK ) 03341 { 03342 return_code = TCL_ERROR; 03343 free( cmd ); 03344 return; 03345 } 03346 03347 sprintf( cmd, "%cx", (char) 1 ); 03348 xPtr = Tcl_GetMatrixPtr( tcl_interp, cmd ); 03349 sprintf( cmd, "%cy", (char) 1 ); 03350 yPtr = Tcl_GetMatrixPtr( tcl_interp, cmd ); 03351 03352 if ( xPtr == NULL || yPtr == NULL ) 03353 return; // Impossible, but still 03354 03355 for ( i = 0; i < n; i++ ) 03356 { 03357 xPtr->fdata[i] = x[i]; 03358 yPtr->fdata[i] = y[i]; 03359 } 03360 03361 // Now call the Tcl procedure to do the work 03362 sprintf( cmd, "%s %d %cx %cy", transform_name, n, (char) 1, (char) 1 ); 03363 return_code = Tcl_Eval( tcl_interp, cmd ); 03364 if ( return_code != TCL_OK ) 03365 { 03366 free( cmd ); 03367 return; 03368 } 03369 03370 // Don't forget to copy the results back into the original arrays 03371 // 03372 for ( i = 0; i < n; i++ ) 03373 { 03374 x[i] = xPtr->fdata[i]; 03375 y[i] = yPtr->fdata[i]; 03376 } 03377 03378 // Clean up, otherwise the next call will fail - [matrix] does not 03379 // overwrite existing commands 03380 // 03381 sprintf( cmd, "rename %cx {}; rename %cy {}", (char) 1, (char) 1 ); 03382 return_code = Tcl_Eval( tcl_interp, cmd ); 03383 03384 free( cmd ); 03385 } 03386 03387 //-------------------------------------------------------------------------- 03388 // plmapCmd 03389 // 03390 // Processes plmap Tcl command. 03391 // C version takes: 03392 // string, minlong, maxlong, minlat, maxlat 03393 // 03394 // e.g. .p cmd plmap globe 0 360 -90 90 03395 //-------------------------------------------------------------------------- 03396 03397 static int 03398 plmapCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp, 03399 int argc, const char *argv[] ) 03400 { 03401 PLFLT minlong, maxlong, minlat, maxlat; 03402 PLINT transform; 03403 PLINT idxname; 03404 03405 return_code = TCL_OK; 03406 if ( argc < 6 || argc > 7 ) 03407 { 03408 Tcl_AppendResult( interp, "bogus syntax for plmap, see doc.", 03409 (char *) NULL ); 03410 return TCL_ERROR; 03411 } 03412 03413 if ( argc == 6 ) 03414 { 03415 transform = 0; 03416 idxname = 1; 03417 transform_name = NULL; 03418 minlong = atof( argv[2] ); 03419 maxlong = atof( argv[3] ); 03420 minlat = atof( argv[4] ); 03421 maxlat = atof( argv[5] ); 03422 } 03423 else 03424 { 03425 transform = 1; 03426 idxname = 2; 03427 minlong = atof( argv[3] ); 03428 maxlong = atof( argv[4] ); 03429 minlat = atof( argv[5] ); 03430 maxlat = atof( argv[6] ); 03431 03432 tcl_interp = interp; 03433 transform_name = argv[1]; 03434 if ( strlen( transform_name ) == 0 ) 03435 { 03436 idxname = 1; 03437 } 03438 } 03439 03440 if ( transform && idxname == 2 ) 03441 { 03442 plmap( &mapform, argv[idxname], minlong, maxlong, minlat, maxlat ); 03443 } 03444 else 03445 { 03446 // No transformation given 03447 plmap( NULL, argv[idxname], minlong, maxlong, minlat, maxlat ); 03448 } 03449 03450 plflush(); 03451 return return_code; 03452 } 03453 03454 //-------------------------------------------------------------------------- 03455 // plmeridiansCmd 03456 // 03457 // Processes plmeridians Tcl command. 03458 // C version takes: 03459 // dlong, dlat, minlong, maxlong, minlat, maxlat 03460 // 03461 // e.g. .p cmd plmeridians 1 ... 03462 //-------------------------------------------------------------------------- 03463 03464 static int 03465 plmeridiansCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp, 03466 int argc, const char *argv[] ) 03467 { 03468 PLFLT dlong, dlat, minlong, maxlong, minlat, maxlat; 03469 PLINT transform; 03470 03471 return_code = TCL_OK; 03472 03473 if ( argc < 7 || argc > 8 ) 03474 { 03475 Tcl_AppendResult( interp, "bogus syntax for plmeridians, see doc.", 03476 (char *) NULL ); 03477 return TCL_ERROR; 03478 } 03479 03480 if ( argc == 7 ) 03481 { 03482 transform = 0; 03483 transform_name = NULL; 03484 dlong = atof( argv[1] ); 03485 dlat = atof( argv[2] ); 03486 minlong = atof( argv[3] ); 03487 maxlong = atof( argv[4] ); 03488 minlat = atof( argv[5] ); 03489 maxlat = atof( argv[6] ); 03490 } 03491 else 03492 { 03493 dlong = atof( argv[2] ); 03494 dlat = atof( argv[3] ); 03495 minlong = atof( argv[4] ); 03496 maxlong = atof( argv[5] ); 03497 minlat = atof( argv[6] ); 03498 maxlat = atof( argv[7] ); 03499 03500 transform = 1; 03501 tcl_interp = interp; 03502 transform_name = argv[1]; 03503 if ( strlen( transform_name ) == 0 ) 03504 { 03505 transform = 0; 03506 } 03507 } 03508 03509 if ( transform ) 03510 { 03511 plmeridians( &mapform, dlong, dlat, minlong, maxlong, minlat, maxlat ); 03512 } 03513 else 03514 { 03515 plmeridians( NULL, dlong, dlat, minlong, maxlong, minlat, maxlat ); 03516 } 03517 03518 plflush(); 03519 return TCL_OK; 03520 } 03521 03522 static Tcl_Interp *tcl_xform_interp = 0; 03523 static char *tcl_xform_procname = 0; 03524 static const char *tcl_xform_template = 03525 #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION < 5 03526 "set result [%s ${_##_x} ${_##_y}] ; set _##_x [lindex $result 0] ; set _##_y [lindex $result 1]" 03527 #else 03528 "set result [%s ${_##_x} ${_##_y}] ; lassign $result _##_x _##_y" 03529 #endif 03530 ; 03531 03532 static char *tcl_xform_code = 0; 03533 03534 static void 03535 Tcl_transform( PLFLT x, PLFLT y, PLFLT *xt, PLFLT *yt, PLPointer PL_UNUSED( data ) ) 03536 { 03537 Tcl_Obj *objx, *objy; 03538 int code; 03539 double dx, dy; 03540 03541 // Set Tcl x to x 03542 objx = Tcl_NewDoubleObj( x ); 03543 Tcl_IncrRefCount( objx ); 03544 Tcl_SetVar2Ex( tcl_xform_interp, 03545 "_##_x", NULL, objx, 0 ); 03546 Tcl_DecrRefCount( objx ); 03547 03548 // Set Tcl y to y 03549 objy = Tcl_NewDoubleObj( y ); 03550 Tcl_IncrRefCount( objy ); 03551 Tcl_SetVar2Ex( tcl_xform_interp, 03552 "_##_y", NULL, objy, 0 ); 03553 Tcl_DecrRefCount( objy ); 03554 03555 // printf( "objx=%x objy=%x\n", objx, objy ); 03556 03557 // printf( "Evaluating code: %s\n", tcl_xform_code ); 03558 03559 // Call identified Tcl proc. Forget data, Tcl can use namespaces and custom 03560 // procs to manage transmission of the custom client data. 03561 // Proc should return a two element list which is xt yt. 03562 code = Tcl_Eval( tcl_xform_interp, tcl_xform_code ); 03563 03564 if ( code != TCL_OK ) 03565 { 03566 printf( "Unable to evaluate Tcl-side coordinate transform.\n" ); 03567 printf( "code = %d\n", code ); 03568 printf( "Error result: %s\n", Tcl_GetStringResult( tcl_xform_interp ) ); 03569 return; 03570 } 03571 03572 objx = Tcl_GetVar2Ex( tcl_xform_interp, "_##_x", NULL, 0 ); 03573 objy = Tcl_GetVar2Ex( tcl_xform_interp, "_##_y", NULL, 0 ); 03574 03575 // In case PLFLT != double, we have to make sure we perform the extraction in 03576 // a safe manner. 03577 if ( Tcl_GetDoubleFromObj( tcl_xform_interp, objx, &dx ) != TCL_OK || 03578 Tcl_GetDoubleFromObj( tcl_xform_interp, objy, &dy ) != TCL_OK ) 03579 { 03580 printf( "Unable to extract Tcl results.\n" ); 03581 return; 03582 } 03583 03584 *xt = dx; 03585 *yt = dy; 03586 } 03587 03588 //-------------------------------------------------------------------------- 03589 // plstransform 03590 // 03591 // Implement Tcl-side global coordinate transformation setting/restoring API. 03592 //-------------------------------------------------------------------------- 03593 03594 static int 03595 plstransformCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp, 03596 int argc, const char *argv[] ) 03597 { 03598 if ( argc == 1 03599 || strcmp( argv[1], "NULL" ) == 0 ) 03600 { 03601 // The user has requested to clear the transform setting. 03602 plstransform( NULL, NULL ); 03603 tcl_xform_interp = 0; 03604 if ( tcl_xform_procname ) 03605 { 03606 free( tcl_xform_procname ); 03607 tcl_xform_procname = 0; 03608 } 03609 } 03610 else 03611 { 03612 size_t len; 03613 03614 tcl_xform_interp = interp; 03615 tcl_xform_procname = plstrdup( argv[1] ); 03616 03617 len = strlen( tcl_xform_template ) + strlen( tcl_xform_procname ); 03618 tcl_xform_code = malloc( len ); 03619 sprintf( tcl_xform_code, tcl_xform_template, tcl_xform_procname ); 03620 03621 plstransform( Tcl_transform, NULL ); 03622 } 03623 03624 return TCL_OK; 03625 } 03626 03627 //-------------------------------------------------------------------------- 03628 // plgriddataCmd 03629 // 03630 // Processes plgriddata Tcl command. 03631 //-------------------------------------------------------------------------- 03632 static int 03633 plgriddataCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp, 03634 int argc, const char *argv[] ) 03635 { 03636 tclMatrix *arrx, *arry, *arrz, *xcoord, *ycoord, *zvalue; 03637 PLINT pts, nx, ny, alg; 03638 PLFLT optalg; 03639 PLFLT **z; 03640 03641 double value; 03642 int i, j; 03643 03644 if ( argc != 9 ) 03645 { 03646 Tcl_AppendResult( interp, "wrong # args: see documentation for ", 03647 argv[0], (char *) NULL ); 03648 return TCL_ERROR; 03649 } 03650 03651 arrx = Tcl_GetMatrixPtr( interp, argv[1] ); 03652 arry = Tcl_GetMatrixPtr( interp, argv[2] ); 03653 arrz = Tcl_GetMatrixPtr( interp, argv[3] ); 03654 03655 xcoord = Tcl_GetMatrixPtr( interp, argv[4] ); 03656 ycoord = Tcl_GetMatrixPtr( interp, argv[5] ); 03657 03658 zvalue = Tcl_GetMatrixPtr( interp, argv[6] ); 03659 03660 sscanf( argv[7], "%d", &alg ); 03661 03662 sscanf( argv[8], "%lg", &value ); optalg = (PLFLT) value; 03663 03664 if ( arrx == NULL || arrx->dim != 1 ) 03665 { 03666 Tcl_AppendResult( interp, argv[0], ": argument 1 should be a \ 03667 one-dimensional matrix - ", argv[1], (char *) NULL ); 03668 return TCL_ERROR; 03669 } 03670 if ( arry == NULL || arry->dim != 1 ) 03671 { 03672 Tcl_AppendResult( interp, argv[0], ": argument 2 should be a \ 03673 one-dimensional matrix - ", argv[2], (char *) NULL ); 03674 return TCL_ERROR; 03675 } 03676 if ( arrz == NULL || arrz->dim != 1 ) 03677 { 03678 Tcl_AppendResult( interp, argv[0], ": argument 3 should be a \ 03679 one-dimensional matrix - ", argv[3], (char *) NULL ); 03680 return TCL_ERROR; 03681 } 03682 03683 if ( xcoord == NULL || xcoord->dim != 1 ) 03684 { 03685 Tcl_AppendResult( interp, argv[0], ": argument 4 should be a \ 03686 one-dimensional matrix - ", argv[4], (char *) NULL ); 03687 return TCL_ERROR; 03688 } 03689 if ( ycoord == NULL || ycoord->dim != 1 ) 03690 { 03691 Tcl_AppendResult( interp, argv[0], ": argument 5 should be a \ 03692 one-dimensional matrix - ", argv[5], (char *) NULL ); 03693 return TCL_ERROR; 03694 } 03695 if ( zvalue == NULL || zvalue->dim != 2 ) 03696 { 03697 Tcl_AppendResult( interp, argv[0], ": argument 6 should be a \ 03698 two-dimensional matrix - ", argv[6], (char *) NULL ); 03699 return TCL_ERROR; 03700 } 03701 03702 pts = arrx->n[0]; 03703 nx = zvalue->n[0]; 03704 ny = zvalue->n[1]; 03705 03706 // convert zvalue to 2d-array so can use standard wrap approach 03707 // from now on in this code. 03708 plAlloc2dGrid( &z, nx, ny ); 03709 03710 // Interpolate the data 03711 plgriddata( arrx->fdata, arry->fdata, arrz->fdata, pts, 03712 xcoord->fdata, nx, ycoord->fdata, ny, z, alg, optalg ); 03713 03714 // Copy the result into the matrix 03715 for ( i = 0; i < nx; i++ ) 03716 { 03717 for ( j = 0; j < ny; j++ ) 03718 { 03719 zvalue->fdata[j + zvalue->n[1] * i] = z[i][j]; 03720 } 03721 } 03722 03723 plFree2dGrid( z, nx, ny ); 03724 return TCL_OK; 03725 } 03726 03727 //-------------------------------------------------------------------------- 03728 // plimageCmd 03729 // 03730 // Processes plimage Tcl command. 03731 //-------------------------------------------------------------------------- 03732 static int 03733 plimageCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp, 03734 int argc, const char *argv[] ) 03735 { 03736 tclMatrix *zvalue; 03737 PLINT nx, ny; 03738 PLFLT **pidata; 03739 PLFLT xmin, xmax, ymin, ymax, zmin, zmax, Dxmin, Dxmax, Dymin, Dymax; 03740 03741 double value; 03742 int i, j; 03743 03744 if ( argc != 12 ) 03745 { 03746 Tcl_AppendResult( interp, "wrong # args: see documentation for ", 03747 argv[0], (char *) NULL ); 03748 return TCL_ERROR; 03749 } 03750 03751 zvalue = Tcl_GetMatrixPtr( interp, argv[1] ); 03752 03753 if ( zvalue == NULL || zvalue->dim != 2 ) 03754 { 03755 Tcl_AppendResult( interp, argv[0], ": argument 1 should be a \ 03756 two-dimensional matrix - ", argv[1], (char *) NULL ); 03757 return TCL_ERROR; 03758 } 03759 03760 sscanf( argv[2], "%lg", &value ); xmin = (PLFLT) value; 03761 sscanf( argv[3], "%lg", &value ); xmax = (PLFLT) value; 03762 sscanf( argv[4], "%lg", &value ); ymin = (PLFLT) value; 03763 sscanf( argv[5], "%lg", &value ); ymax = (PLFLT) value; 03764 sscanf( argv[6], "%lg", &value ); zmin = (PLFLT) value; 03765 sscanf( argv[7], "%lg", &value ); zmax = (PLFLT) value; 03766 sscanf( argv[8], "%lg", &value ); Dxmin = (PLFLT) value; 03767 sscanf( argv[9], "%lg", &value ); Dxmax = (PLFLT) value; 03768 sscanf( argv[10], "%lg", &value ); Dymin = (PLFLT) value; 03769 sscanf( argv[11], "%lg", &value ); Dymax = (PLFLT) value; 03770 03771 nx = zvalue->n[0]; 03772 ny = zvalue->n[1]; 03773 03774 plAlloc2dGrid( &pidata, nx, ny ); 03775 03776 for ( i = 0; i < nx; i++ ) 03777 { 03778 for ( j = 0; j < ny; j++ ) 03779 { 03780 pidata[i][j] = zvalue->fdata[j + i * ny]; 03781 } 03782 } 03783 // 03784 // fprintf(stderr,"nx, ny: %d %d\n", nx, ny); 03785 // fprintf(stderr,"xmin, xmax: %.17g %.17g\n", xmin, xmax); 03786 // fprintf(stderr,"ymin, ymax: %.17g %.17g\n", ymin, ymax); 03787 // fprintf(stderr,"zmin, zmax: %.17g %.17g\n", zmin, zmax); 03788 // fprintf(stderr,"Dxmin, Dxmax: %.17g %.17g\n", Dxmin, Dxmax); 03789 // fprintf(stderr,"Dymin, Dymax: %.17g %.17g\n", Dymin, Dymax); 03790 // 03791 03792 c_plimage( (const PLFLT * const *) pidata, nx, ny, xmin, xmax, ymin, ymax, zmin, zmax, 03793 Dxmin, Dxmax, Dymin, Dymax ); 03794 03795 plFree2dGrid( pidata, nx, ny ); 03796 03797 return TCL_OK; 03798 } 03799 03800 //-------------------------------------------------------------------------- 03801 // plimagefrCmd 03802 // 03803 // Processes plimagefr Tcl command. 03804 // 03805 // Note: 03806 // Very basic! No user-defined interpolation routines 03807 //-------------------------------------------------------------------------- 03808 static int 03809 plimagefrCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp, 03810 int argc, const char *argv[] ) 03811 { 03812 tclMatrix *zvalue; 03813 tclMatrix *xg; 03814 tclMatrix *yg; 03815 PLINT nx, ny; 03816 PLFLT **pidata; 03817 PLcGrid2 cgrid2; 03818 PLFLT xmin, xmax, ymin, ymax, zmin, zmax, valuemin, valuemax; 03819 03820 double value; 03821 int i, j; 03822 03823 if ( argc != 12 && argc != 10 ) 03824 { 03825 Tcl_AppendResult( interp, "wrong # args: see documentation for ", 03826 argv[0], (char *) NULL ); 03827 return TCL_ERROR; 03828 } 03829 03830 zvalue = Tcl_GetMatrixPtr( interp, argv[1] ); 03831 03832 if ( zvalue == NULL || zvalue->dim != 2 ) 03833 { 03834 Tcl_AppendResult( interp, argv[0], ": argument 1 should be a \ 03835 two-dimensional matrix - ", argv[1], (char *) NULL ); 03836 return TCL_ERROR; 03837 } 03838 03839 xg = NULL; 03840 yg = NULL; 03841 if ( argc == 12 ) 03842 { 03843 xg = Tcl_GetMatrixPtr( interp, argv[10] ); 03844 yg = Tcl_GetMatrixPtr( interp, argv[11] ); 03845 03846 if ( xg == NULL || xg->dim != 2 ) 03847 { 03848 Tcl_AppendResult( interp, argv[0], ": argument 10 should be a \ 03849 two-dimensional matrix - ", argv[10], (char *) NULL ); 03850 return TCL_ERROR; 03851 } 03852 03853 if ( yg == NULL || yg->dim != 2 ) 03854 { 03855 Tcl_AppendResult( interp, argv[0], ": argument 11 should be a \ 03856 two-dimensional matrix - ", argv[11], (char *) NULL ); 03857 return TCL_ERROR; 03858 } 03859 } 03860 03861 sscanf( argv[2], "%lg", &value ); xmin = (PLFLT) value; 03862 sscanf( argv[3], "%lg", &value ); xmax = (PLFLT) value; 03863 sscanf( argv[4], "%lg", &value ); ymin = (PLFLT) value; 03864 sscanf( argv[5], "%lg", &value ); ymax = (PLFLT) value; 03865 sscanf( argv[6], "%lg", &value ); zmin = (PLFLT) value; 03866 sscanf( argv[7], "%lg", &value ); zmax = (PLFLT) value; 03867 sscanf( argv[8], "%lg", &value ); valuemin = (PLFLT) value; 03868 sscanf( argv[9], "%lg", &value ); valuemax = (PLFLT) value; 03869 03870 nx = zvalue->n[0]; 03871 ny = zvalue->n[1]; 03872 03873 plAlloc2dGrid( &pidata, nx, ny ); 03874 03875 for ( i = 0; i < nx; i++ ) 03876 { 03877 for ( j = 0; j < ny; j++ ) 03878 { 03879 pidata[i][j] = zvalue->fdata[j + i * ny]; 03880 } 03881 } 03882 03883 if ( xg != NULL ) 03884 { 03885 plAlloc2dGrid( &cgrid2.xg, nx + 1, ny + 1 ); 03886 plAlloc2dGrid( &cgrid2.yg, nx + 1, ny + 1 ); 03887 03888 cgrid2.nx = nx + 1; 03889 cgrid2.ny = ny + 1; 03890 for ( i = 0; i <= nx; i++ ) 03891 { 03892 for ( j = 0; j <= ny; j++ ) 03893 { 03894 cgrid2.xg[i][j] = xg->fdata[j + i * ( ny + 1 )]; 03895 cgrid2.yg[i][j] = yg->fdata[j + i * ( ny + 1 )]; 03896 } 03897 } 03898 c_plimagefr( (const PLFLT * const *) pidata, nx, ny, xmin, xmax, ymin, ymax, zmin, zmax, 03899 valuemin, valuemax, pltr2, (void *) &cgrid2 ); 03900 } 03901 else 03902 { 03903 c_plimagefr( (const PLFLT * const *) pidata, nx, ny, xmin, xmax, ymin, ymax, zmin, zmax, 03904 valuemin, valuemax, pltr0, NULL ); 03905 } 03906 03907 plFree2dGrid( pidata, nx, ny ); 03908 if ( xg != NULL ) 03909 { 03910 plFree2dGrid( cgrid2.xg, nx + 1, ny + 1 ); 03911 plFree2dGrid( cgrid2.yg, nx + 1, ny + 1 ); 03912 } 03913 03914 return TCL_OK; 03915 } 03916 03917 //-------------------------------------------------------------------------- 03918 // plstripcCmd 03919 // 03920 // Processes plstripc Tcl command. 03921 //-------------------------------------------------------------------------- 03922 static int 03923 plstripcCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp, 03924 int argc, const char *argv[] ) 03925 { 03926 int i; 03927 int id; 03928 const char *xspec; 03929 const char *yspec; 03930 const char *idName; 03931 tclMatrix *colMat; 03932 tclMatrix *styleMat; 03933 double value; 03934 int ivalue; 03935 PLFLT xmin, xmax, xjump, ymin, ymax, xlpos, ylpos; 03936 PLBOOL y_ascl, acc; 03937 PLINT colbox, collab; 03938 PLINT colline[4], styline[4]; 03939 int nlegend; 03940 const char **legline; 03941 const char *labx; 03942 const char *laby; 03943 const char *labtop; 03944 char idvalue[20]; 03945 03946 if ( argc != 21 ) 03947 { 03948 Tcl_AppendResult( interp, "wrong # args: see documentation for ", 03949 argv[0], (char *) NULL ); 03950 return TCL_ERROR; 03951 } 03952 03953 colMat = Tcl_GetMatrixPtr( interp, argv[15] ); 03954 styleMat = Tcl_GetMatrixPtr( interp, argv[16] ); 03955 03956 if ( colMat == NULL || colMat->dim != 1 || colMat->idata == NULL ) 03957 { 03958 Tcl_AppendResult( interp, argv[0], ": argument 15 should be a \ 03959 one-dimensional integer matrix - ", argv[15], (char *) NULL ); 03960 return TCL_ERROR; 03961 } 03962 03963 if ( styleMat == NULL || styleMat->dim != 1 || styleMat->idata == NULL ) 03964 { 03965 Tcl_AppendResult( interp, argv[0], ": argument 16 should be a \ 03966 one-dimensional integer matrix - ", argv[16], (char *) NULL ); 03967 return TCL_ERROR; 03968 } 03969 03970 idName = argv[1]; 03971 xspec = argv[2]; 03972 yspec = argv[3]; 03973 03974 sscanf( argv[4], "%lg", &value ); xmin = (PLFLT) value; 03975 sscanf( argv[5], "%lg", &value ); xmax = (PLFLT) value; 03976 sscanf( argv[6], "%lg", &value ); xjump = (PLFLT) value; 03977 sscanf( argv[7], "%lg", &value ); ymin = (PLFLT) value; 03978 sscanf( argv[8], "%lg", &value ); ymax = (PLFLT) value; 03979 sscanf( argv[9], "%lg", &value ); xlpos = (PLFLT) value; 03980 sscanf( argv[10], "%lg", &value ); ylpos = (PLFLT) value; 03981 sscanf( argv[11], "%d", &ivalue ); y_ascl = (PLBOOL) ivalue; 03982 sscanf( argv[12], "%d", &ivalue ); acc = (PLBOOL) ivalue; 03983 sscanf( argv[13], "%d", &ivalue ); colbox = ivalue; 03984 sscanf( argv[14], "%d", &ivalue ); collab = ivalue; 03985 03986 labx = argv[18]; 03987 laby = argv[19]; 03988 labtop = argv[20]; 03989 03990 for ( i = 0; i < 4; i++ ) 03991 { 03992 colline[i] = colMat->idata[i]; 03993 styline[i] = styleMat->idata[i]; 03994 } 03995 03996 if ( Tcl_SplitList( interp, argv[17], &nlegend, &legline ) != TCL_OK ) 03997 { 03998 return TCL_ERROR; 03999 } 04000 if ( nlegend < 4 ) 04001 { 04002 Tcl_AppendResult( interp, argv[0], ": argument 18 should be a \ 04003 list of at least four items - ", argv[17], (char *) NULL ); 04004 return TCL_ERROR; 04005 } 04006 04007 c_plstripc( &id, xspec, yspec, 04008 xmin, xmax, xjump, ymin, ymax, 04009 xlpos, ylpos, 04010 y_ascl, acc, 04011 colbox, collab, 04012 colline, styline, legline, 04013 labx, laby, labtop ); 04014 04015 sprintf( idvalue, "%d", id ); 04016 Tcl_SetVar( interp, idName, idvalue, 0 ); 04017 04018 Tcl_Free( (char *) legline ); 04019 04020 return TCL_OK; 04021 } 04022 04023 //-------------------------------------------------------------------------- 04024 // labelform 04025 // 04026 // Call the Tcl custom label function. 04027 //-------------------------------------------------------------------------- 04028 04029 static Tcl_Obj *label_objs[4] = { NULL, NULL, NULL, NULL }; // Arguments for the Tcl procedure 04030 // that handles the custom labels 04031 04032 void 04033 labelform( PLINT axis, PLFLT value, char *string, PLINT string_length, PLPointer PL_UNUSED( data ) ) 04034 { 04035 int objc; 04036 04037 label_objs[1] = Tcl_NewIntObj( axis ); 04038 label_objs[2] = Tcl_NewDoubleObj( (double) value ); 04039 04040 Tcl_IncrRefCount( label_objs[1] ); 04041 Tcl_IncrRefCount( label_objs[2] ); 04042 04043 // Call the Tcl procedure and store the result 04044 objc = 3; 04045 if ( label_objs[3] != NULL ) 04046 { 04047 objc = 4; 04048 } 04049 04050 return_code = Tcl_EvalObjv( tcl_interp, objc, label_objs, 0 ); 04051 04052 if ( return_code != TCL_OK ) 04053 { 04054 strncpy( string, "ERROR", (size_t) string_length ); 04055 } 04056 else 04057 { 04058 strncpy( string, Tcl_GetStringResult( tcl_interp ), (size_t) string_length ); 04059 } 04060 04061 Tcl_DecrRefCount( label_objs[1] ); 04062 Tcl_DecrRefCount( label_objs[2] ); 04063 } 04064 04065 //-------------------------------------------------------------------------- 04066 // plslabelfuncCmd 04067 // 04068 // Processes plslabelfunc Tcl command. 04069 // C version takes: 04070 // function, data 04071 // (data argument is optional) 04072 //-------------------------------------------------------------------------- 04073 04074 static int 04075 plslabelfuncCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp, 04076 int argc, const char *argv[] ) 04077 { 04078 if ( argc < 2 || argc > 3 ) 04079 { 04080 Tcl_AppendResult( interp, "bogus syntax for plslabelfunc, see doc.", 04081 (char *) NULL ); 04082 return TCL_ERROR; 04083 } 04084 04085 tcl_interp = interp; 04086 04087 if ( label_objs[0] != NULL ) 04088 { 04089 Tcl_DecrRefCount( label_objs[0] ); 04090 } 04091 if ( label_objs[3] != NULL ) 04092 { 04093 Tcl_DecrRefCount( label_objs[3] ); 04094 label_objs[3] = NULL; 04095 } 04096 04097 if ( strlen( argv[1] ) == 0 ) 04098 { 04099 plslabelfunc( NULL, NULL ); 04100 return TCL_OK; 04101 } 04102 else 04103 { 04104 plslabelfunc( labelform, NULL ); 04105 label_objs[0] = Tcl_NewStringObj( argv[1], (int) strlen( argv[1] ) ); 04106 Tcl_IncrRefCount( label_objs[0] ); 04107 } 04108 04109 if ( argc == 3 ) 04110 { 04111 label_objs[3] = Tcl_NewStringObj( argv[2], (int) strlen( argv[2] ) ); // Should change with Tcl_Obj interface 04112 Tcl_IncrRefCount( label_objs[3] ); 04113 } 04114 else 04115 { 04116 label_objs[3] = NULL; 04117 } 04118 04119 return TCL_OK; 04120 } 04121 04122 //-------------------------------------------------------------------------- 04123 // pllegendCmd 04124 // 04125 // Processes pllegend Tcl command. 04126 // C version takes: 04127 // function, data 04128 // (data argument is optional) 04129 //-------------------------------------------------------------------------- 04130 04131 static int *argv_to_ints( Tcl_Interp *interp, const char *list_numbers, int *number ) 04132 { 04133 int i, retcode; 04134 int *array; 04135 Tcl_Obj *list; 04136 Tcl_Obj *elem; 04137 04138 list = Tcl_NewStringObj( list_numbers, ( -1 ) ); 04139 04140 retcode = Tcl_ListObjLength( interp, list, number ); 04141 if ( retcode != TCL_OK || ( *number ) == 0 ) 04142 { 04143 *number = 0; 04144 return NULL; 04145 } 04146 else 04147 { 04148 array = (int *) malloc( sizeof ( int ) * (size_t) ( *number ) ); 04149 for ( i = 0; i < ( *number ); i++ ) 04150 { 04151 Tcl_ListObjIndex( interp, list, i, &elem ); 04152 Tcl_GetIntFromObj( interp, elem, &array[i] ); 04153 } 04154 } 04155 return array; 04156 } 04157 04158 static double *argv_to_doubles( Tcl_Interp *interp, const char *list_numbers, int *number ) 04159 { 04160 int i, retcode; 04161 double *array; 04162 Tcl_Obj *list; 04163 Tcl_Obj *elem; 04164 04165 list = Tcl_NewStringObj( list_numbers, ( -1 ) ); 04166 04167 retcode = Tcl_ListObjLength( interp, list, number ); 04168 if ( retcode != TCL_OK || ( *number ) == 0 ) 04169 { 04170 *number = 0; 04171 return NULL; 04172 } 04173 else 04174 { 04175 array = (double *) malloc( sizeof ( double ) * (size_t) ( *number ) ); 04176 for ( i = 0; i < ( *number ); i++ ) 04177 { 04178 Tcl_ListObjIndex( interp, list, i, &elem ); 04179 Tcl_GetDoubleFromObj( interp, elem, &array[i] ); 04180 } 04181 } 04182 return array; 04183 } 04184 04185 static char **argv_to_chars( Tcl_Interp *interp, const char *list_strings, int *number ) 04186 { 04187 int i, retcode; 04188 char **array; 04189 char *string; 04190 int length; 04191 int idx; 04192 Tcl_Obj *list; 04193 Tcl_Obj *elem; 04194 04195 list = Tcl_NewStringObj( list_strings, ( -1 ) ); 04196 04197 retcode = Tcl_ListObjLength( interp, list, number ); 04198 if ( retcode != TCL_OK || ( *number ) == 0 ) 04199 { 04200 *number = 0; 04201 return NULL; 04202 } 04203 else 04204 { 04205 array = (char **) malloc( sizeof ( char* ) * (size_t) ( *number ) ); 04206 array[0] = (char *) malloc( sizeof ( char ) * ( strlen( list_strings ) + 1 ) ); 04207 idx = 0; 04208 for ( i = 0; i < ( *number ); i++ ) 04209 { 04210 Tcl_ListObjIndex( interp, list, i, &elem ); 04211 string = Tcl_GetStringFromObj( elem, &length ); 04212 04213 array[i] = array[0] + idx; 04214 strncpy( array[i], string, (size_t) length ); 04215 idx += length + 1; 04216 array[0][idx - 1] = '\0'; 04217 } 04218 } 04219 return array; 04220 } 04221 04222 static int 04223 pllegendCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp, 04224 int argc, const char *argv[] ) 04225 { 04226 PLFLT legend_width, legend_height; 04227 PLFLT x, y, plot_width; 04228 PLINT opt, position; 04229 PLINT bg_color, bb_color, bb_style; 04230 PLINT nrow, ncolumn; 04231 PLINT nlegend; 04232 PLINT *opt_array; 04233 PLFLT text_offset, text_scale, text_spacing, text_justification; 04234 PLINT *text_colors; 04235 PLINT *box_colors, *box_patterns; 04236 PLFLT *box_scales; 04237 PLINT *line_colors, *line_styles; 04238 PLFLT *box_line_widths, *line_widths; 04239 PLINT *symbol_colors, *symbol_numbers; 04240 PLFLT *symbol_scales; 04241 char **text; 04242 char **symbols; 04243 04244 int number_opts; 04245 int number_texts; 04246 int dummy; 04247 double value; 04248 04249 Tcl_Obj *data[2]; 04250 04251 if ( argc != 29 ) 04252 { 04253 Tcl_AppendResult( interp, "bogus syntax for pllegend, see doc.", 04254 (char *) NULL ); 04255 return TCL_ERROR; 04256 } 04257 04258 sscanf( argv[1], "%d", &opt ); 04259 sscanf( argv[2], "%d", &position ); 04260 sscanf( argv[3], "%lg", &value ); x = (PLFLT) value; 04261 sscanf( argv[4], "%lg", &value ); y = (PLFLT) value; 04262 sscanf( argv[5], "%lg", &value ); plot_width = (PLFLT) value; 04263 sscanf( argv[6], "%d", &bg_color ); 04264 sscanf( argv[7], "%d", &bb_color ); 04265 sscanf( argv[8], "%d", &bb_style ); 04266 sscanf( argv[9], "%d", &nrow ); 04267 sscanf( argv[10], "%d", &ncolumn ); 04268 opt_array = argv_to_ints( interp, argv[11], &number_opts ); 04269 sscanf( argv[12], "%lg", &value ); text_offset = (PLFLT) value; 04270 sscanf( argv[13], "%lg", &value ); text_scale = (PLFLT) value; 04271 sscanf( argv[14], "%lg", &value ); text_spacing = (PLFLT) value; 04272 sscanf( argv[15], "%lg", &value ); text_justification = (PLFLT) value; 04273 04274 text_colors = argv_to_ints( interp, argv[16], &dummy ); 04275 text = argv_to_chars( interp, argv[17], &number_texts ); 04276 box_colors = argv_to_ints( interp, argv[18], &dummy ); 04277 box_patterns = argv_to_ints( interp, argv[19], &dummy ); 04278 box_scales = argv_to_doubles( interp, argv[20], &dummy ); 04279 box_line_widths = argv_to_doubles( interp, argv[21], &dummy ); 04280 line_colors = argv_to_ints( interp, argv[22], &dummy ); 04281 line_styles = argv_to_ints( interp, argv[23], &dummy ); 04282 line_widths = argv_to_doubles( interp, argv[24], &dummy ); 04283 symbol_colors = argv_to_ints( interp, argv[25], &dummy ); 04284 symbol_scales = argv_to_doubles( interp, argv[26], &dummy ); 04285 symbol_numbers = argv_to_ints( interp, argv[27], &dummy ); 04286 symbols = argv_to_chars( interp, argv[28], &dummy ); 04287 04288 nlegend = MIN( number_opts, number_texts ); 04289 04290 c_pllegend( &legend_width, &legend_height, 04291 opt, position, x, y, plot_width, 04292 bg_color, bb_color, bb_style, 04293 nrow, ncolumn, 04294 nlegend, opt_array, 04295 text_offset, text_scale, text_spacing, 04296 text_justification, 04297 text_colors, (const char * const *) text, 04298 box_colors, box_patterns, 04299 box_scales, box_line_widths, 04300 line_colors, line_styles, 04301 line_widths, 04302 symbol_colors, symbol_scales, 04303 symbol_numbers, (const char * const *) symbols ); 04304 04305 if ( opt_array != NULL ) 04306 free( opt_array ); 04307 if ( text_colors != NULL ) 04308 free( text_colors ); 04309 if ( text != NULL ) 04310 { 04311 free( text[0] ); 04312 free( text ); 04313 } 04314 if ( box_colors != NULL ) 04315 free( box_colors ); 04316 if ( box_patterns != NULL ) 04317 free( box_patterns ); 04318 if ( box_scales != NULL ) 04319 free( box_scales ); 04320 if ( box_line_widths != NULL ) 04321 free( box_line_widths ); 04322 if ( line_colors != NULL ) 04323 free( line_colors ); 04324 if ( line_styles != NULL ) 04325 free( line_styles ); 04326 if ( line_widths != NULL ) 04327 free( line_widths ); 04328 if ( symbol_colors != NULL ) 04329 free( symbol_colors ); 04330 if ( symbol_scales != NULL ) 04331 free( symbol_scales ); 04332 if ( symbol_numbers != NULL ) 04333 free( symbol_numbers ); 04334 if ( symbols != NULL ) 04335 { 04336 free( symbols[0] ); 04337 free( symbols ); 04338 } 04339 04340 data[0] = Tcl_NewDoubleObj( legend_width ); 04341 data[1] = Tcl_NewDoubleObj( legend_height ); 04342 Tcl_SetObjResult( interp, Tcl_NewListObj( 2, data ) ); 04343 04344 return TCL_OK; 04345 } 04346 04347 //-------------------------------------------------------------------------- 04348 // plcolorbarCmd 04349 // 04350 // Processes plcolorbar Tcl command. 04351 //-------------------------------------------------------------------------- 04352 04353 static int 04354 plcolorbarCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp, 04355 int argc, const char *argv[] ) 04356 { 04357 PLFLT colorbar_width, colorbar_height; 04358 PLINT opt, position; 04359 PLFLT x, y, x_length, y_length; 04360 PLINT bg_color, bb_color, bb_style; 04361 PLFLT low_cap_color, high_cap_color; 04362 PLINT cont_color; 04363 PLFLT cont_width; 04364 PLINT n_label_opts; 04365 PLINT n_labels; 04366 PLINT *label_opts; 04367 char **labels; 04368 PLINT n_axis_opts; 04369 PLINT n_ticks; 04370 PLINT n_sub_ticks; 04371 PLINT n_axes; 04372 char **axis_opts; 04373 PLFLT *ticks; 04374 PLINT *sub_ticks; 04375 Tcl_Obj *list_vectors; 04376 int n_vectors; 04377 PLINT *vector_sizes; 04378 PLFLT **vector_values; 04379 int retcode; 04380 int i; 04381 int length; 04382 Tcl_Obj *vector; 04383 tclMatrix *vectorPtr; 04384 04385 double value; 04386 04387 Tcl_Obj *data[2]; 04388 04389 if ( argc != 20 ) 04390 { 04391 Tcl_AppendResult( interp, "bogus syntax for plcolorbar, see doc.", 04392 (char *) NULL ); 04393 return TCL_ERROR; 04394 } 04395 04396 // The first two arguments, the resulting width and height are returned via Tcl_SetObjResult() 04397 sscanf( argv[1], "%d", &opt ); 04398 sscanf( argv[2], "%d", &position ); 04399 sscanf( argv[3], "%lg", &value ); x = (PLFLT) value; 04400 sscanf( argv[4], "%lg", &value ); y = (PLFLT) value; 04401 sscanf( argv[5], "%lg", &value ); x_length = (PLFLT) value; 04402 sscanf( argv[6], "%lg", &value ); y_length = (PLFLT) value; 04403 sscanf( argv[7], "%d", &bg_color ); 04404 sscanf( argv[8], "%d", &bb_color ); 04405 sscanf( argv[9], "%d", &bb_style ); 04406 sscanf( argv[10], "%lg", &value ); low_cap_color = (PLFLT) value; 04407 sscanf( argv[11], "%lg", &value ); high_cap_color = (PLFLT) value; 04408 sscanf( argv[12], "%d", &cont_color ); 04409 sscanf( argv[13], "%lg", &value ); cont_width = (PLFLT) value; 04410 label_opts = argv_to_ints( interp, argv[14], &n_label_opts ); 04411 labels = argv_to_chars( interp, argv[15], &n_labels ); 04412 axis_opts = argv_to_chars( interp, argv[16], &n_axis_opts ); 04413 ticks = argv_to_doubles( interp, argv[17], &n_ticks ); 04414 sub_ticks = argv_to_ints( interp, argv[18], &n_sub_ticks ); 04415 list_vectors = Tcl_NewStringObj( argv[19], ( -1 ) ); 04416 04417 // Check consistency 04418 if ( n_label_opts != n_labels ) 04419 { 04420 Tcl_AppendResult( interp, "number of label options must equal number of labels.", 04421 (char *) NULL ); 04422 return TCL_ERROR; 04423 } 04424 if ( n_axis_opts != n_ticks || n_axis_opts != n_sub_ticks ) 04425 { 04426 Tcl_AppendResult( interp, "number of axis, tick and subtick options must be equal.", 04427 (char *) NULL ); 04428 return TCL_ERROR; 04429 } 04430 n_axes = n_axis_opts; 04431 04432 retcode = Tcl_ListObjLength( interp, list_vectors, &n_vectors ); 04433 if ( retcode != TCL_OK || n_vectors == 0 ) 04434 { 04435 Tcl_AppendResult( interp, "malformed list of vectors or no vector at all.", 04436 (char *) NULL ); 04437 return TCL_ERROR; 04438 } 04439 else 04440 { 04441 vector_sizes = (int *) malloc( sizeof ( int ) * (size_t) n_vectors ); 04442 vector_values = (PLFLT **) malloc( sizeof ( PLFLT * ) * (size_t) n_vectors ); 04443 for ( i = 0; i < n_vectors; i++ ) 04444 { 04445 Tcl_ListObjIndex( interp, list_vectors, i, &vector ); 04446 vectorPtr = Tcl_GetMatrixPtr( interp, Tcl_GetStringFromObj( vector, &length ) ); 04447 if ( vectorPtr == NULL || vectorPtr->dim != 1 ) 04448 { 04449 Tcl_AppendResult( interp, "element in list of vectors is not a vector.", 04450 (char *) NULL ); 04451 return TCL_ERROR; 04452 } 04453 vector_sizes[i] = vectorPtr->n[0]; 04454 vector_values[i] = vectorPtr->fdata; 04455 } 04456 } 04457 04458 c_plcolorbar( &colorbar_width, &colorbar_height, 04459 opt, position, x, y, 04460 x_length, y_length, 04461 bg_color, bb_color, bb_style, 04462 low_cap_color, high_cap_color, 04463 cont_color, cont_width, 04464 n_labels, label_opts, (const char * const *) labels, 04465 n_axes, (const char * const *) axis_opts, 04466 ticks, sub_ticks, 04467 vector_sizes, (const PLFLT * const *) vector_values ); 04468 04469 if ( label_opts != NULL ) 04470 free( label_opts ); 04471 if ( labels != NULL ) 04472 { 04473 free( labels[0] ); 04474 free( labels ); 04475 } 04476 if ( axis_opts != NULL ) 04477 { 04478 free( axis_opts[0] ); 04479 free( axis_opts ); 04480 } 04481 if ( ticks != NULL ) 04482 free( ticks ); 04483 if ( sub_ticks != NULL ) 04484 free( sub_ticks ); 04485 if ( vector_values != NULL ) 04486 { 04487 free( vector_sizes ); 04488 free( vector_values ); 04489 } 04490 04491 Tcl_DecrRefCount( list_vectors ); 04492 04493 data[0] = Tcl_NewDoubleObj( colorbar_width ); 04494 data[1] = Tcl_NewDoubleObj( colorbar_height ); 04495 Tcl_SetObjResult( interp, Tcl_NewListObj( 2, data ) ); 04496 04497 return TCL_OK; 04498 }