• Main Page
  • Namespaces
  • Classes
  • Files
  • File List
  • File Members

tclAPI.c

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

Generated on Wed Oct 12 2011 20:42:23 for PLplot by  doxygen 1.7.1