PLplot  5.10.0
tclAPI.c
Go to the documentation of this file.
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 }
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Defines