PLplot  5.10.0
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Macros
tclAPI.c
Go to the documentation of this file.
1 // $Id: tclAPI.c 12873 2013-12-17 01:27:14Z airwin $
2 //
3 // Copyright 1994, 1995
4 // Maurice LeBrun mjl@dino.ph.utexas.edu
5 // Institute for Fusion Studies University of Texas at Austin
6 //
7 // Copyright (C) 2004 Joao Cardoso
8 // Copyright (C) 2004 Andrew Ross
9 //
10 // This file is part of PLplot.
11 //
12 // PLplot is free software; you can redistribute it and/or modify
13 // it under the terms of the GNU Library General Public License as published
14 // by the Free Software Foundation; either version 2 of the License, or
15 // (at your option) any later version.
16 //
17 // PLplot is distributed in the hope that it will be useful,
18 // but WITHOUT ANY WARRANTY; without even the implied warranty of
19 // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 // GNU Library General Public License for more details.
21 //
22 // You should have received a copy of the GNU Library General Public License
23 // along with PLplot; if not, write to the Free Software
24 // Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
25 //
26 //--------------------------------------------------------------------------
27 //
28 // This module implements a Tcl command set for interpretively calling
29 // PLplot functions. Each Tcl command is responsible for calling the
30 // appropriate underlying function in the C API. Can be used with any
31 // driver, in principle.
32 //
33 
34 #include "plplotP.h"
35 #include "pltcl.h"
36 #include "plplot_parameters.h"
37 #ifndef __WIN32__
38 #ifdef PL_HAVE_UNISTD_H
39 #include <unistd.h>
40 #endif
41 #else
42 #ifdef _MSC_VER
43 #define getcwd _getcwd
44 #include <direct.h>
45 #endif
46 #endif
47 
48 #include "tclgen.h"
49 
50 // PLplot/Tcl API handlers. Prototypes must come before Cmds struct
51 
52 static int loopbackCmd( ClientData, Tcl_Interp *, int, const char ** );
53 static int plcolorbarCmd( ClientData, Tcl_Interp *, int, const char ** );
54 static int plcontCmd( ClientData, Tcl_Interp *, int, const char ** );
55 static int pllegendCmd( ClientData, Tcl_Interp *, int, const char ** );
56 static int plmeshCmd( ClientData, Tcl_Interp *, int, const char ** );
57 static int plmeshcCmd( ClientData, Tcl_Interp *, int, const char ** );
58 static int plot3dCmd( ClientData, Tcl_Interp *, int, const char ** );
59 static int plot3dcCmd( ClientData, Tcl_Interp *, int, const char ** );
60 static int plsurf3dCmd( ClientData, Tcl_Interp *, int, const char ** );
61 static int plsetoptCmd( ClientData, Tcl_Interp *, int, const char ** );
62 static int plshadeCmd( ClientData, Tcl_Interp *, int, const char ** );
63 static int plshadesCmd( ClientData, Tcl_Interp *, int, const char ** );
64 static int plmapCmd( ClientData, Tcl_Interp *, int, const char ** );
65 static int plmeridiansCmd( ClientData, Tcl_Interp *, int, const char ** );
66 static int plstransformCmd( ClientData, Tcl_Interp *, int, const char ** );
67 static int plsvectCmd( ClientData, Tcl_Interp *, int, const char ** );
68 static int plvectCmd( ClientData, Tcl_Interp *, int, const char ** );
69 static int plranddCmd( ClientData, Tcl_Interp *, int, const char ** );
70 static int plgriddataCmd( ClientData, Tcl_Interp *, int, const char ** );
71 static int plimageCmd( ClientData, Tcl_Interp *, int, const char ** );
72 static int plimagefrCmd( ClientData, Tcl_Interp *, int, const char ** );
73 static int plstripcCmd( ClientData, Tcl_Interp *, int, const char ** );
74 static int plslabelfuncCmd( ClientData, Tcl_Interp *, int, const char ** );
75 void mapform( PLINT n, PLFLT *x, PLFLT *y );
76 void labelform( PLINT axis, PLFLT value, char *string, PLINT string_length, PLPointer data );
78 
79 //
80 // The following structure defines all of the commands in the PLplot/Tcl
81 // core, and the C procedures that execute them.
82 //
83 
84 typedef struct Command
85 {
86  int ( *proc )( void *, struct Tcl_Interp *, int, const char ** ); // Procedure to process command.
87  ClientData clientData; // Arbitrary value to pass to proc.
88  int *deleteProc; // Procedure to invoke when deleting
89  // command.
90  ClientData deleteData; // Arbitrary value to pass to deleteProc
91  // (usually the same as clientData).
92 } Command;
93 
94 typedef struct
95 {
96  const char *name;
97  int ( *proc )( void *, struct Tcl_Interp *, int, const char ** );
98 } CmdInfo;
99 
100 // Built-in commands, and the procedures associated with them
101 
102 static CmdInfo Cmds[] = {
103  { "loopback", loopbackCmd },
104 #include "tclgen_s.h"
105  { "plcolorbar", plcolorbarCmd },
106  { "plcont", plcontCmd },
107  { "pllegend", pllegendCmd },
108  { "plmap", plmapCmd },
109  { "plmeridians", plmeridiansCmd },
110  { "plstransform", plstransformCmd },
111  { "plmesh", plmeshCmd },
112  { "plmeshc", plmeshcCmd },
113  { "plot3d", plot3dCmd },
114  { "plot3dc", plot3dcCmd },
115  { "plsurf3d", plsurf3dCmd },
116  { "plsetopt", plsetoptCmd },
117  { "plshade", plshadeCmd },
118  { "plshades", plshadesCmd },
119  { "plsvect", plsvectCmd },
120  { "plvect", plvectCmd },
121  { "plrandd", plranddCmd },
122  { "plgriddata", plgriddataCmd },
123  { "plimage", plimageCmd },
124  { "plimagefr", plimagefrCmd },
125  { "plstripc", plstripcCmd },
126  { "plslabelfunc", plslabelfuncCmd },
127  { NULL, NULL }
128 };
129 
130 // Hash table and associated flag for directing control
131 
132 static int cmdTable_initted;
133 static Tcl_HashTable cmdTable;
134 
135 // Variables for holding error return info from PLplot
136 
138 static char errmsg[160];
139 
140 // Library initialization
141 
142 #ifndef PL_LIBRARY
143 #define PL_LIBRARY ""
144 #endif
145 
146 extern PLDLLIMPORT char * plplotLibDir;
147 
148 #if ( !defined ( MAC_TCL ) && !defined ( __WIN32__ ) )
149 //
150 // Use an extended search for installations on Unix where we
151 // have very likely installed plplot so that plplot.tcl is
152 // in /usr/local/plplot/lib/plplot5.1.0/tcl
153 //
154 #define PLPLOT_EXTENDED_SEARCH
155 #endif
156 
157 // Static functions
158 
159 // Evals the specified command, aborting on an error.
160 
161 static int
162 tcl_cmd( Tcl_Interp *interp, const char *cmd );
163 
164 //--------------------------------------------------------------------------
165 // Append_Cmdlist
166 //
167 // Generates command list from Cmds, storing as interps result.
168 //--------------------------------------------------------------------------
169 
170 static void
171 Append_Cmdlist( Tcl_Interp *interp )
172 {
173  static int inited = 0;
174  static const char** namelist;
175  int i, j, ncmds = sizeof ( Cmds ) / sizeof ( CmdInfo );
176 
177  if ( !inited )
178  {
179  namelist = (const char **) malloc( (size_t) ncmds * sizeof ( char * ) );
180 
181  for ( i = 0; i < ncmds; i++ )
182  namelist[i] = Cmds[i].name;
183 
184  // Sort the list, couldn't get qsort to do it for me for some reason, grrr.
185 
186  for ( i = 0; i < ncmds - 1; i++ )
187  for ( j = i + 1; j < ncmds - 1; j++ )
188  {
189  if ( strcmp( namelist[i], namelist[j] ) > 0 )
190  {
191  const char *t = namelist[i];
192  namelist[i] = namelist[j];
193  namelist[j] = t;
194  }
195  }
196 
197  inited = 1;
198  }
199 
200  for ( i = 0; i < ncmds; i++ )
201  Tcl_AppendResult( interp, " ", namelist[i], (char *) NULL );
202 }
203 
204 //--------------------------------------------------------------------------
205 // plTclCmd_Init
206 //
207 // Sets up command hash table for use with plframe to PLplot Tcl API.
208 //
209 // Right now all API calls are allowed, although some of these may not
210 // make much sense when used with a widget.
211 //--------------------------------------------------------------------------
212 
213 static void
214 plTclCmd_Init( Tcl_Interp * PL_UNUSED( interp ) )
215 {
216  register Command *cmdPtr;
217  register CmdInfo *cmdInfoPtr;
218 
219 // Register our error variables with PLplot
220 
222 
223 // Initialize hash table
224 
225  Tcl_InitHashTable( &cmdTable, TCL_STRING_KEYS );
226 
227 // Create the hash table entry for each command
228 
229  for ( cmdInfoPtr = Cmds; cmdInfoPtr->name != NULL; cmdInfoPtr++ )
230  {
231  int new;
232  Tcl_HashEntry *hPtr;
233 
234  hPtr = Tcl_CreateHashEntry( &cmdTable, cmdInfoPtr->name, &new );
235  if ( new )
236  {
237  cmdPtr = (Command *) ckalloc( sizeof ( Command ) );
238  cmdPtr->proc = cmdInfoPtr->proc;
239  cmdPtr->clientData = (ClientData) NULL;
240  cmdPtr->deleteProc = NULL;
241  cmdPtr->deleteData = (ClientData) NULL;
242  Tcl_SetHashValue( hPtr, cmdPtr );
243  }
244  }
245 }
246 
247 //--------------------------------------------------------------------------
248 // plTclCmd
249 //
250 // Front-end to PLplot/Tcl API for use from Tcl commands (e.g. plframe).
251 //
252 // This command is called by the plframe widget to process subcommands
253 // of the "cmd" plframe widget command. This is the plframe's direct
254 // plotting interface to the PLplot library. This routine can be called
255 // from other commands that want a similar capability.
256 //
257 // In a widget-based application, a PLplot "command" doesn't make much
258 // sense by itself since it isn't connected to a specific widget.
259 // Instead, you have widget commands. This allows arbitrarily many
260 // widgets and requires a slightly different syntax than if there were
261 // only a single output device. That is, the widget name (and in this
262 // case, the "cmd" widget command, after that comes the subcommand)
263 // must come first. The plframe widget checks first for one of its
264 // internal subcommands, those specifically designed for use with the
265 // plframe widget. If not found, control comes here.
266 //--------------------------------------------------------------------------
267 
268 int
269 plTclCmd( char *cmdlist, Tcl_Interp *interp, int argc, const char **argv )
270 {
271  register Tcl_HashEntry *hPtr;
272  int result = TCL_OK;
273 
274  pl_errcode = 0; errmsg[0] = '\0';
275 
276 // Create hash table on first call
277 
278  if ( !cmdTable_initted )
279  {
280  cmdTable_initted = 1;
281  plTclCmd_Init( interp );
282  }
283 
284 // no option -- return list of available PLplot commands
285 
286  if ( argc == 0 )
287  {
288  Tcl_AppendResult( interp, cmdlist, (char *) NULL );
289  Append_Cmdlist( interp );
290  return TCL_OK;
291  }
292 
293 // Pick out the desired command
294 
295  hPtr = Tcl_FindHashEntry( &cmdTable, argv[0] );
296  if ( hPtr == NULL )
297  {
298  Tcl_AppendResult( interp, "bad option \"", argv[0],
299  "\" to \"cmd\": must be one of ",
300  cmdlist, (char *) NULL );
301  Append_Cmdlist( interp );
302  result = TCL_ERROR;
303  }
304  else
305  {
306  register Command *cmdPtr = (Command *) Tcl_GetHashValue( hPtr );
307  result = ( *cmdPtr->proc )( cmdPtr->clientData, interp, argc, argv );
308  if ( result == TCL_OK )
309  {
310  if ( pl_errcode != 0 )
311  {
312  result = TCL_ERROR;
313  Tcl_AppendResult( interp, errmsg, (char *) NULL );
314  }
315  }
316  }
317 
318  return result;
319 }
320 
321 //--------------------------------------------------------------------------
322 // loopbackCmd
323 //
324 // Loop-back command for Tcl interpreter. Main purpose is to enable a
325 // compatible command syntax whether you are executing directly through a
326 // Tcl interpreter or a plframe widget. I.e. the syntax is:
327 //
328 // <widget> cmd <PLplot command> (widget command)
329 // loopback cmd <PLplot command> (pltcl command)
330 //
331 // This routine is essentially the same as plTclCmd but without some of
332 // the window dressing required by the plframe widget.
333 //--------------------------------------------------------------------------
334 
335 static int
336 loopbackCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp,
337  int argc, const char **argv )
338 {
339  register Tcl_HashEntry *hPtr;
340  int result = TCL_OK;
341 
342  argc--; argv++;
343  if ( argc == 0 || ( strcmp( argv[0], "cmd" ) != 0 ) )
344  {
345  Tcl_AppendResult( interp, "bad option \"", argv[0],
346  "\" to \"loopback\": must be ",
347  "\"cmd ?options?\" ", (char *) NULL );
348  return TCL_ERROR;
349  }
350 
351 // Create hash table on first call
352 
353  if ( !cmdTable_initted )
354  {
355  cmdTable_initted = 1;
356  plTclCmd_Init( interp );
357  }
358 
359 // no option -- return list of available PLplot commands
360 
361  argc--; argv++;
362  if ( argc == 0 )
363  {
364  Append_Cmdlist( interp );
365  return TCL_OK;
366  }
367 
368 // Pick out the desired command
369 
370  hPtr = Tcl_FindHashEntry( &cmdTable, argv[0] );
371  if ( hPtr == NULL )
372  {
373  Tcl_AppendResult( interp, "bad option \"", argv[0],
374  "\" to \"loopback cmd\": must be one of ",
375  (char *) NULL );
376  Append_Cmdlist( interp );
377  result = TCL_ERROR;
378  }
379  else
380  {
381  register Command *cmdPtr = (Command *) Tcl_GetHashValue( hPtr );
382  result = ( *cmdPtr->proc )( cmdPtr->clientData, interp, argc, argv );
383  }
384 
385  return result;
386 }
387 
388 //--------------------------------------------------------------------------
389 // PlbasicInit
390 //
391 // Used by Pltcl_Init, Pltk_Init(.c), and Plplotter_Init(.c). Ensures we have been correctly loaded
392 // into a Tcl/Tk interpreter, that the plplot.tcl startup file can be
393 // found and sourced, and that the Matrix library can be found and used,
394 // and that it correctly exports a stub table.
395 //--------------------------------------------------------------------------
396 
397 int
398 PlbasicInit( Tcl_Interp *interp )
399 {
400  int debug = plsc->debug;
401  const char *libDir = NULL;
402  static char initScript[] =
403  "tcl_findLibrary plplot " PLPLOT_VERSION " \"\" plplot.tcl PL_LIBRARY pllibrary";
404 #ifdef PLPLOT_EXTENDED_SEARCH
405  static char initScriptExtended[] =
406  "tcl_findLibrary plplot " PLPLOT_VERSION "/tcl \"\" plplot.tcl PL_LIBRARY pllibrary";
407 #endif
408 
409 #ifdef USE_TCL_STUBS
410 //
411 // We hard-wire 8.1 here, rather than TCL_VERSION, TK_VERSION because
412 // we really don't mind which version of Tcl, Tk we use as long as it
413 // is 8.1 or newer. Otherwise if we compiled against 8.2, we couldn't
414 // be loaded into 8.1
415 //
416  Tcl_InitStubs( interp, "8.1", 0 );
417 #endif
418 
419 #if 1
420  if ( Matrix_Init( interp ) != TCL_OK )
421  {
422  if ( debug )
423  fprintf( stderr, "error in matrix init\n" );
424  return TCL_ERROR;
425  }
426 #else
427 
428 //
429 // This code is really designed to be used with a stubified Matrix
430 // extension. It is not well tested under a non-stubs situation
431 // (which is in any case inferior). The USE_MATRIX_STUBS define
432 // is made in pltcl.h, and should be removed only with extreme caution.
433 //
434 #ifdef USE_MATRIX_STUBS
435  if ( Matrix_InitStubs( interp, "0.1", 0 ) == NULL )
436  {
437  if ( debug )
438  fprintf( stderr, "error in matrix stubs init\n" );
439  return TCL_ERROR;
440  }
441 #else
442  Tcl_PkgRequire( interp, "Matrix", "0.1", 0 );
443 #endif
444 #endif
445 
446  Tcl_SetVar( interp, "plversion", PLPLOT_VERSION, TCL_GLOBAL_ONLY );
447 
448  if ( strcmp( PLPLOT_ITCL_VERSION, "4.0.0" ) >= 0 )
449  Tcl_SetVar( interp, "pl_itcl_package_name", "Itcl 4", TCL_GLOBAL_ONLY );
450  else if ( strcmp( PLPLOT_ITCL_VERSION, "3.0.0" ) >= 0 )
451  Tcl_SetVar( interp, "pl_itcl_package_name", "Itcl 3", TCL_GLOBAL_ONLY );
452  else
453  // Mark invalid package name in such a way as to cause an error
454  // when, for example, itcl has been disabled by PLplot, yet one
455  // of the PLplot Tcl scripts attempts to load Itcl.
456  Tcl_SetVar( interp, "pl_itcl_package_name", "Itcl(because_not_found_by_PLplot)", TCL_GLOBAL_ONLY );
457 
458  if ( strcmp( PLPLOT_ITK_VERSION, "4.0.0" ) >= 0 )
459  Tcl_SetVar( interp, "pl_itk_package_name", "Itk 4", TCL_GLOBAL_ONLY );
460  else if ( strcmp( PLPLOT_ITK_VERSION, "3.0.0" ) >= 0 )
461  Tcl_SetVar( interp, "pl_itk_package_name", "Itk 3", TCL_GLOBAL_ONLY );
462  else
463  // Mark invalid package name in such a way as to cause an error
464  // when, for example, itk has been disabled by PLplot, yet one
465  // of the PLplot Tcl scripts attempts to load Itk.
466  Tcl_SetVar( interp, "pl_itk_package_name", "Itk(because_not_found_by_PLplot)", TCL_GLOBAL_ONLY );
467 
468  if ( strcmp( PLPLOT_IWIDGETS_VERSION, "4.1.0" ) >= 0 )
469  Tcl_SetVar( interp, "pl_iwidgets_package_name", "Iwidgets 4", TCL_GLOBAL_ONLY );
470  else if ( strcmp( PLPLOT_IWIDGETS_VERSION, "4.0.0" ) >= 0 )
471  Tcl_SetVar( interp, "pl_iwidgets_package_name", "-exact Iwidgets " PLPLOT_IWIDGETS_VERSION, TCL_GLOBAL_ONLY );
472  else
473  // Mark invalid package name in such a way as to cause an error
474  // when, for example, itk has been disabled by PLplot, yet one
475  // of the PLplot Tcl scripts attempts to load Iwidgets.
476  Tcl_SetVar( interp, "pl_iwidgets_package_name", "Iwidgets(because_not_found_by_PLplot)", TCL_GLOBAL_ONLY );
477 
478 
479 // Begin search for init script
480 // Each search begins with a test of libDir, so rearrangement is easy.
481 // If search is successful, both libDir (C) and pllibrary (tcl) are set
482 
483 // if we are in the build tree, search there
484  if ( plInBuildTree() )
485  {
486  if ( debug )
487  fprintf( stderr, "trying BUILD_DIR\n" );
488  libDir = BUILD_DIR "/bindings/tcl";
489  Tcl_SetVar( interp, "pllibrary", libDir, TCL_GLOBAL_ONLY );
490  if ( Tcl_Eval( interp, initScript ) != TCL_OK )
491  {
492  libDir = NULL;
493  Tcl_UnsetVar( interp, "pllibrary", TCL_GLOBAL_ONLY );
494  Tcl_ResetResult( interp );
495  }
496  }
497 
498 // Tcl extension dir and/or PL_LIBRARY
499  if ( libDir == NULL )
500  {
501  if ( debug )
502  fprintf( stderr, "trying init script\n" );
503  if ( Tcl_Eval( interp, initScript ) != TCL_OK )
504  {
505  // This unset is needed for Tcl < 8.4 support.
506  Tcl_UnsetVar( interp, "pllibrary", TCL_GLOBAL_ONLY );
507  // Clear the result to get rid of the error message
508  Tcl_ResetResult( interp );
509  }
510  else
511  libDir = Tcl_GetVar( interp, "pllibrary", TCL_GLOBAL_ONLY );
512  }
513 
514 #ifdef TCL_DIR
515 // Install directory
516  if ( libDir == NULL )
517  {
518  if ( debug )
519  fprintf( stderr, "trying TCL_DIR\n" );
520  libDir = TCL_DIR;
521  Tcl_SetVar( interp, "pllibrary", libDir, TCL_GLOBAL_ONLY );
522  if ( Tcl_Eval( interp, initScript ) != TCL_OK )
523  {
524  libDir = NULL;
525  Tcl_UnsetVar( interp, "pllibrary", TCL_GLOBAL_ONLY );
526  Tcl_ResetResult( interp );
527  }
528  }
529 #endif
530 
531 #ifdef PLPLOT_EXTENDED_SEARCH
532 // Unix extension directory
533  if ( libDir == NULL )
534  {
535  if ( debug )
536  fprintf( stderr, "trying extended init script\n" );
537  if ( Tcl_Eval( interp, initScriptExtended ) != TCL_OK )
538  {
539  // This unset is needed for Tcl < 8.4 support.
540  Tcl_UnsetVar( interp, "pllibrary", TCL_GLOBAL_ONLY );
541  // Clear the result to get rid of the error message
542  Tcl_ResetResult( interp );
543  }
544  else
545  libDir = Tcl_GetVar( interp, "pllibrary", TCL_GLOBAL_ONLY );
546  }
547 
548 // Last chance, current directory
549  if ( libDir == NULL )
550  {
551  Tcl_DString ds;
552  if ( debug )
553  fprintf( stderr, "trying curdir\n" );
554  if ( Tcl_Access( "plplot.tcl", 0 ) != 0 )
555  {
556  if ( debug )
557  fprintf( stderr, "couldn't find plplot.tcl in curdir\n" );
558  return TCL_ERROR;
559  }
560 
561  // It seems to be here. Set pllibrary & eval plplot.tcl "by hand"
562  libDir = Tcl_GetCwd( interp, &ds );
563  if ( libDir == NULL )
564  {
565  if ( debug )
566  fprintf( stderr, "couldn't get curdir\n" );
567  return TCL_ERROR;
568  }
569  libDir = plstrdup( libDir );
570  Tcl_DStringFree( &ds );
571  Tcl_SetVar( interp, "pllibrary", libDir, TCL_GLOBAL_ONLY );
572 
573  if ( Tcl_EvalFile( interp, "plplot.tcl" ) != TCL_OK )
574  {
575  if ( debug )
576  fprintf( stderr, "error evalling plplot.tcl\n" );
577  return TCL_ERROR;
578  }
579  }
580 #endif
581 
582  if ( libDir == NULL )
583  {
584  if ( debug )
585  fprintf( stderr, "libdir NULL at end of search\n" );
586  return TCL_ERROR;
587  }
588 
589 // Used by init code in plctrl.c
590  plplotLibDir = plstrdup( libDir );
591 
592 // wait_until -- waits for a specific condition to arise
593 // Can be used with either Tcl-DP or TK
594 
595  Tcl_CreateCommand( interp, "wait_until", (Tcl_CmdProc *) plWait_Until,
596  (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL );
597 
598 // Define the flags as variables in the PLPLOT namespace
599  set_plplot_parameters( interp );
600 
601  return TCL_OK;
602 }
603 
604 //--------------------------------------------------------------------------
605 // Pltcl_Init
606 //
607 // Initialization routine for extended tclsh's.
608 // Sets up auto_path, creates the matrix command and numerous commands for
609 // interfacing to PLplot. Should not be used in a widget-based system.
610 //--------------------------------------------------------------------------
611 
612 int
613 Pltcl_Init( Tcl_Interp *interp )
614 {
615  register CmdInfo *cmdInfoPtr;
616 // This must be before any other Tcl related calls
617  if ( PlbasicInit( interp ) != TCL_OK )
618  {
619  Tcl_AppendResult( interp, "Could not find plplot.tcl - please set \
620 environment variable PL_LIBRARY to the directory containing that file",
621  (char *) NULL );
622 
623  return TCL_ERROR;
624  }
625 
626 // Register our error variables with PLplot
627 
629 
630 // PLplot API commands
631 
632  for ( cmdInfoPtr = Cmds; cmdInfoPtr->name != NULL; cmdInfoPtr++ )
633  {
634  Tcl_CreateCommand( interp, cmdInfoPtr->name, cmdInfoPtr->proc,
635  (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL );
636  }
637 
638 // We really need this so the TEA based 'make install' can
639 // properly determine the package we have installed
640 
641  Tcl_PkgProvide( interp, "Pltcl", PLPLOT_VERSION );
642  return TCL_OK;
643 }
644 
645 //--------------------------------------------------------------------------
646 // plWait_Until
647 //
648 // Tcl command -- wait until the specified condition is satisfied.
649 // Processes all events while waiting.
650 //
651 // This command is more capable than tkwait, and has the added benefit
652 // of working with Tcl-DP as well. Example usage:
653 //
654 // wait_until {[info exists foobar]}
655 //
656 // Note the [info ...] command must be protected by braces so that it
657 // isn't actually evaluated until passed into this routine.
658 //--------------------------------------------------------------------------
659 
660 int
661 plWait_Until( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp, int PL_UNUSED( argc ), const char **argv )
662 {
663  int result = 0;
664 
665  dbug_enter( "plWait_Until" );
666 
667  for (;; )
668  {
669  if ( Tcl_ExprBoolean( interp, argv[1], &result ) )
670  {
671  fprintf( stderr, "wait_until command \"%s\" failed:\n\t %s\n",
672  argv[1], Tcl_GetStringResult( interp ) );
673  break;
674  }
675  if ( result )
676  break;
677 
678  Tcl_DoOneEvent( 0 );
679  }
680  return TCL_OK;
681 }
682 
683 //--------------------------------------------------------------------------
684 // pls_auto_path
685 //
686 // Sets up auto_path variable.
687 // Directories are added to the FRONT of autopath. Therefore, they are
688 // searched in reverse order of how they are listed below.
689 //
690 // Note: there is no harm in adding extra directories, even if they don't
691 // actually exist (aside from a slight increase in processing time when
692 // the autoloaded proc is first found).
693 //--------------------------------------------------------------------------
694 
695 int
696 pls_auto_path( Tcl_Interp *interp )
697 {
698  int debug = plsc->debug;
699  char *buf, *ptr = NULL, *dn;
700  int return_code = TCL_OK;
701 #ifdef DEBUG
702  char *path;
703 #endif
704 
705  buf = (char *) malloc( 256 * sizeof ( char ) );
706 
707 // Add TCL_DIR
708 
709 #ifdef TCL_DIR
710  if ( debug )
711  fprintf( stderr, "adding %s to auto_path\n", TCL_DIR );
712  Tcl_SetVar( interp, "dir", TCL_DIR, TCL_GLOBAL_ONLY );
713  if ( tcl_cmd( interp, "set auto_path [linsert $auto_path 0 $dir]" ) == TCL_ERROR )
714  {
715  return_code = TCL_ERROR;
716  goto finish;
717  }
718 #ifdef DEBUG
719  path = Tcl_GetVar( interp, "auto_path", 0 );
720  fprintf( stderr, "auto_path is %s\n", path );
721 #endif
722 #endif
723 
724 // Add $HOME/tcl
725 
726  if ( ( dn = getenv( "HOME" ) ) != NULL )
727  {
728  plGetName( dn, "tcl", "", &ptr );
729  Tcl_SetVar( interp, "dir", ptr, 0 );
730  if ( tcl_cmd( interp, "set auto_path [linsert $auto_path 0 $dir]" ) == TCL_ERROR )
731  {
732  return_code = TCL_ERROR;
733  goto finish;
734  }
735 #ifdef DEBUG
736  fprintf( stderr, "adding %s to auto_path\n", ptr );
737  path = Tcl_GetVar( interp, "auto_path", 0 );
738  fprintf( stderr, "auto_path is %s\n", path );
739 #endif
740  }
741 
742 // Add PL_TCL_ENV = $(PL_TCL)
743 
744 #if defined ( PL_TCL_ENV )
745  if ( ( dn = getenv( PL_TCL_ENV ) ) != NULL )
746  {
747  plGetName( dn, "", "", &ptr );
748  Tcl_SetVar( interp, "dir", ptr, 0 );
749  if ( tcl_cmd( interp, "set auto_path [linsert $auto_path 0 $dir]" ) == TCL_ERROR )
750  {
751  return_code = TCL_ERROR;
752  goto finish;
753  }
754 #ifdef DEBUG
755  fprintf( stderr, "adding %s to auto_path\n", ptr );
756  path = Tcl_GetVar( interp, "auto_path", 0 );
757  fprintf( stderr, "auto_path is %s\n", path );
758 #endif
759  }
760 #endif // PL_TCL_ENV
761 
762 // Add PL_HOME_ENV/tcl = $(PL_HOME_ENV)/tcl
763 
764 #if defined ( PL_HOME_ENV )
765  if ( ( dn = getenv( PL_HOME_ENV ) ) != NULL )
766  {
767  plGetName( dn, "tcl", "", &ptr );
768  Tcl_SetVar( interp, "dir", ptr, 0 );
769  if ( tcl_cmd( interp, "set auto_path [linsert $auto_path 0 $dir]" ) == TCL_ERROR )
770  {
771  return_code = TCL_ERROR;
772  goto finish;
773  }
774 #ifdef DEBUG
775  fprintf( stderr, "adding %s to auto_path\n", ptr );
776  path = Tcl_GetVar( interp, "auto_path", 0 );
777  fprintf( stderr, "auto_path is %s\n", path );
778 #endif
779  }
780 #endif // PL_HOME_ENV
781 
782 // Add cwd
783 
784  if ( getcwd( buf, 256 ) == 0 )
785  {
786  Tcl_SetResult( interp, "Problems with getcwd in pls_auto_path", TCL_STATIC );
787  {
788  return_code = TCL_ERROR;
789  goto finish;
790  }
791  }
792  Tcl_SetVar( interp, "dir", buf, 0 );
793  if ( tcl_cmd( interp, "set auto_path [linsert $auto_path 0 $dir]" ) == TCL_ERROR )
794  {
795  return_code = TCL_ERROR;
796  goto finish;
797  }
798  //** see if plserver was invoked in the build tree **
799  if ( plInBuildTree() )
800  {
801  Tcl_SetVar( interp, "dir", BUILD_DIR "/bindings/tk", TCL_GLOBAL_ONLY );
802  if ( tcl_cmd( interp, "set auto_path [linsert $auto_path 0 $dir]" ) == TCL_ERROR )
803  {
804  return_code = TCL_ERROR;
805  goto finish;
806  }
807  }
808 
809 #ifdef DEBUG
810  fprintf( stderr, "adding %s to auto_path\n", buf );
811  path = Tcl_GetVar( interp, "auto_path", 0 );
812  fprintf( stderr, "auto_path is %s\n", path );
813 #endif
814 
815 finish: free_mem( buf );
816  free_mem( ptr );
817 
818  return return_code;
819 }
820 
821 //--------------------------------------------------------------------------
822 // tcl_cmd
823 //
824 // Evals the specified command, aborting on an error.
825 //--------------------------------------------------------------------------
826 
827 static int
828 tcl_cmd( Tcl_Interp *interp, const char *cmd )
829 {
830  int result;
831 
832  result = Tcl_VarEval( interp, cmd, (char **) NULL );
833  if ( result != TCL_OK )
834  {
835  fprintf( stderr, "TCL command \"%s\" failed:\n\t %s\n",
836  cmd, Tcl_GetStringResult( interp ) );
837  }
838  return result;
839 }
840 
841 //--------------------------------------------------------------------------
842 // PLplot API Calls
843 //
844 // Any call that results in something actually being plotted must be
845 // followed by by a call to plflush(), to make sure all output from
846 // that command is finished. Devices that have text/graphics screens
847 // (e.g. Tek4xxx and emulators) implicitly switch to the graphics screen
848 // before graphics commands, so a plgra() is not necessary in this case.
849 // Although if you switch to the text screen via user control (instead of
850 // using pltext()), the device will get confused.
851 //--------------------------------------------------------------------------
852 
853 static char buf[200];
854 
855 #include "tclgen.c"
856 
857 //--------------------------------------------------------------------------
858 // plcontCmd
859 //
860 // Processes plcont Tcl command.
861 //
862 // The C function is:
863 // void
864 // c_plcont(PLFLT **f, PLINT nx, PLINT ny, PLINT kx, PLINT lx,
865 // PLINT ky, PLINT ly, PLFLT *clevel, PLINT nlevel,
866 // void (*pltr) (PLFLT, PLFLT, PLFLT *, PLFLT *, PLPointer),
867 // PLPointer pltr_data);
868 //
869 // Since f will be specified by a Tcl Matrix, nx and ny are redundant, and
870 // are automatically eliminated. Same for nlevel, since clevel will be a 1-d
871 // Tcl Matrix. Since most people plot the whole data set, we will allow kx,
872 // lx and ky, ly to be defaulted--either you specify all four, or none of
873 // them. We allow three ways of specifying the coordinate transforms: 1)
874 // Nothing, in which case we will use the identity mapper pltr0 2) pltr1, in
875 // which case the next two args must be 1-d Tcl Matricies 3) pltr2, in which
876 // case the next two args must be 2-d Tcl Matricies. Finally, a new
877 // paramater is allowed at the end to specify which, if either, of the
878 // coordinates wrap on themselves. Can be 1 or x, or 2 or y. Nothing or 0
879 // specifies that neither coordinate wraps.
880 //
881 // So, the new call from Tcl is:
882 // plcont f [kx lx ky ly] clev [pltr x y] [wrap]
883 //
884 //--------------------------------------------------------------------------
885 
887 
889 {
890  tclMatrix *matPtr = (tclMatrix *) p;
891 
892  i = i % tclmateval_modx;
893  j = j % tclmateval_mody;
894 
895 // printf( "tclMatrix_feval: i=%d j=%d f=%f\n", i, j,
896 // matPtr->fdata[I2D(i,j)] );
897 //
898  return matPtr->fdata[I2D( i, j )];
899 }
900 
901 static int
902 plcontCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp,
903  int argc, const char *argv[] )
904 {
905  tclMatrix *matPtr, *matf, *matclev;
906  PLINT nx, ny, kx = 0, lx = 0, ky = 0, ly = 0, nclev;
907  const char *pltrname = "pltr0";
908  tclMatrix *mattrx = NULL, *mattry = NULL;
909  PLFLT **z, **zused, **zwrapped;
910 
911  int arg3_is_kx = 1, i, j;
912  void ( *pltr )( PLFLT, PLFLT, PLFLT *, PLFLT *, PLPointer );
913  PLPointer pltr_data = NULL;
914  PLcGrid cgrid1;
915  PLcGrid2 cgrid2;
916 
917  int wrap = 0;
918 
919  if ( argc < 3 )
920  {
921  Tcl_AppendResult( interp, "wrong # args: see documentation for ",
922  argv[0], (char *) NULL );
923  return TCL_ERROR;
924  }
925 
926  matf = Tcl_GetMatrixPtr( interp, argv[1] );
927  if ( matf == NULL )
928  return TCL_ERROR;
929 
930  if ( matf->dim != 2 )
931  {
932  Tcl_SetResult( interp, "Must use 2-d data.", TCL_STATIC );
933  return TCL_ERROR;
934  }
935  else
936  {
937  nx = matf->n[0];
938  ny = matf->n[1];
939  tclmateval_modx = nx;
940  tclmateval_mody = ny;
941 
942  // convert matf to 2d-array so can use standard wrap approach
943  // from now on in this code.
944  plAlloc2dGrid( &z, nx, ny );
945  for ( i = 0; i < nx; i++ )
946  {
947  for ( j = 0; j < ny; j++ )
948  {
949  z[i][j] = tclMatrix_feval( i, j, matf );
950  }
951  }
952  }
953 
954 // Now check the next argument. If it is all digits, then it must be kx,
955 // otherwise it is the name of clev.
956 
957  for ( i = 0; i < (int) strlen( argv[2] ) && arg3_is_kx; i++ )
958  if ( !isdigit( argv[2][i] ) )
959  arg3_is_kx = 0;
960 
961  if ( arg3_is_kx )
962  {
963  // Check that there are enough args
964  if ( argc < 7 )
965  {
966  Tcl_SetResult( interp, "plcont, bogus syntax", TCL_STATIC );
967  return TCL_ERROR;
968  }
969 
970  // Peel off the ones we need
971  kx = atoi( argv[3] );
972  lx = atoi( argv[4] );
973  ky = atoi( argv[5] );
974  ly = atoi( argv[6] );
975 
976  // adjust argc, argv to reflect our consumption
977  argc -= 6, argv += 6;
978  }
979  else
980  {
981  argc -= 2, argv += 2;
982  }
983 
984 // The next argument has to be clev
985 
986  if ( argc < 1 )
987  {
988  Tcl_SetResult( interp, "plcont, bogus syntax", TCL_STATIC );
989  return TCL_ERROR;
990  }
991 
992  matclev = Tcl_GetMatrixPtr( interp, argv[0] );
993  if ( matclev == NULL )
994  return TCL_ERROR;
995  nclev = matclev->n[0];
996 
997  if ( matclev->dim != 1 )
998  {
999  Tcl_SetResult( interp, "clev must be 1-d matrix.", TCL_STATIC );
1000  return TCL_ERROR;
1001  }
1002 
1003  argc--, argv++;
1004 
1005 // Now handle trailing optional parameters, if any
1006 
1007  if ( argc >= 3 )
1008  {
1009  // There is a pltr spec, parse it.
1010  pltrname = argv[0];
1011  mattrx = Tcl_GetMatrixPtr( interp, argv[1] );
1012  if ( mattrx == NULL )
1013  return TCL_ERROR;
1014  mattry = Tcl_GetMatrixPtr( interp, argv[2] );
1015  if ( mattry == NULL )
1016  return TCL_ERROR;
1017 
1018  argc -= 3, argv += 3;
1019  }
1020 
1021  if ( argc )
1022  {
1023  // There is a wrap spec, get it.
1024  wrap = atoi( argv[0] );
1025 
1026  // Hmm, I said the the doc they could also say x or y, have to come back
1027  // to this...
1028 
1029  argc--, argv++;
1030  }
1031 
1032 // There had better not be anything else on the command line by this point.
1033 
1034  if ( argc )
1035  {
1036  Tcl_SetResult( interp, "plcont, bogus syntax, too many args.", TCL_STATIC );
1037  return TCL_ERROR;
1038  }
1039 
1040 // Now we need to set up the data for contouring.
1041 
1042  if ( !strcmp( pltrname, "pltr0" ) )
1043  {
1044  pltr = pltr0;
1045  zused = z;
1046 
1047  // wrapping is only supported for pltr2.
1048  if ( wrap )
1049  {
1050  Tcl_SetResult( interp, "Must use pltr2 if want wrapping.", TCL_STATIC );
1051  return TCL_ERROR;
1052  }
1053  }
1054  else if ( !strcmp( pltrname, "pltr1" ) )
1055  {
1056  pltr = pltr1;
1057  cgrid1.xg = mattrx->fdata;
1058  cgrid1.nx = nx;
1059  cgrid1.yg = mattry->fdata;
1060  cgrid1.ny = ny;
1061  zused = z;
1062 
1063  // wrapping is only supported for pltr2.
1064  if ( wrap )
1065  {
1066  Tcl_SetResult( interp, "Must use pltr2 if want wrapping.", TCL_STATIC );
1067  return TCL_ERROR;
1068  }
1069 
1070  if ( mattrx->dim != 1 || mattry->dim != 1 )
1071  {
1072  Tcl_SetResult( interp, "Must use 1-d coord arrays with pltr1.", TCL_STATIC );
1073  return TCL_ERROR;
1074  }
1075 
1076  pltr_data = &cgrid1;
1077  }
1078  else if ( !strcmp( pltrname, "pltr2" ) )
1079  {
1080  // printf( "plcont, setting up for pltr2\n" );
1081  if ( !wrap )
1082  {
1083  // printf( "plcont, no wrapping is needed.\n" );
1084  plAlloc2dGrid( &cgrid2.xg, nx, ny );
1085  plAlloc2dGrid( &cgrid2.yg, nx, ny );
1086  cgrid2.nx = nx;
1087  cgrid2.ny = ny;
1088  zused = z;
1089 
1090  matPtr = mattrx;
1091  for ( i = 0; i < nx; i++ )
1092  for ( j = 0; j < ny; j++ )
1093  cgrid2.xg[i][j] = mattrx->fdata[ I2D( i, j ) ];
1094 
1095  matPtr = mattry;
1096  for ( i = 0; i < nx; i++ )
1097  for ( j = 0; j < ny; j++ )
1098  cgrid2.yg[i][j] = mattry->fdata[ I2D( i, j ) ];
1099  }
1100  else if ( wrap == 1 )
1101  {
1102  plAlloc2dGrid( &cgrid2.xg, nx + 1, ny );
1103  plAlloc2dGrid( &cgrid2.yg, nx + 1, ny );
1104  plAlloc2dGrid( &zwrapped, nx + 1, ny );
1105  cgrid2.nx = nx + 1;
1106  cgrid2.ny = ny;
1107  zused = zwrapped;
1108 
1109  matPtr = mattrx;
1110  for ( i = 0; i < nx; i++ )
1111  for ( j = 0; j < ny; j++ )
1112  cgrid2.xg[i][j] = mattrx->fdata[ I2D( i, j ) ];
1113 
1114  matPtr = mattry;
1115  for ( i = 0; i < nx; i++ )
1116  {
1117  for ( j = 0; j < ny; j++ )
1118  {
1119  cgrid2.yg[i][j] = mattry->fdata[ I2D( i, j ) ];
1120  zwrapped[i][j] = z[i][j];
1121  }
1122  }
1123 
1124  for ( j = 0; j < ny; j++ )
1125  {
1126  cgrid2.xg[nx][j] = cgrid2.xg[0][j];
1127  cgrid2.yg[nx][j] = cgrid2.yg[0][j];
1128  zwrapped[nx][j] = zwrapped[0][j];
1129  }
1130 
1131  // z not used in executable path after this so free it before
1132  // nx value is changed.
1133  plFree2dGrid( z, nx, ny );
1134 
1135  nx++;
1136  }
1137  else if ( wrap == 2 )
1138  {
1139  plAlloc2dGrid( &cgrid2.xg, nx, ny + 1 );
1140  plAlloc2dGrid( &cgrid2.yg, nx, ny + 1 );
1141  plAlloc2dGrid( &zwrapped, nx, ny + 1 );
1142  cgrid2.nx = nx;
1143  cgrid2.ny = ny + 1;
1144  zused = zwrapped;
1145 
1146  matPtr = mattrx;
1147  for ( i = 0; i < nx; i++ )
1148  for ( j = 0; j < ny; j++ )
1149  cgrid2.xg[i][j] = mattrx->fdata[ I2D( i, j ) ];
1150 
1151  matPtr = mattry;
1152  for ( i = 0; i < nx; i++ )
1153  {
1154  for ( j = 0; j < ny; j++ )
1155  {
1156  cgrid2.yg[i][j] = mattry->fdata[ I2D( i, j ) ];
1157  zwrapped[i][j] = z[i][j];
1158  }
1159  }
1160 
1161  for ( i = 0; i < nx; i++ )
1162  {
1163  cgrid2.xg[i][ny] = cgrid2.xg[i][0];
1164  cgrid2.yg[i][ny] = cgrid2.yg[i][0];
1165  zwrapped[i][ny] = zwrapped[i][0];
1166  }
1167 
1168  // z not used in executable path after this so free it before
1169  // ny value is changed.
1170  plFree2dGrid( z, nx, ny );
1171 
1172  ny++;
1173  }
1174  else
1175  {
1176  Tcl_SetResult( interp, "Invalid wrap specifier, must be <empty>, 0, 1, or 2.", TCL_STATIC );
1177  return TCL_ERROR;
1178  }
1179 
1180  pltr = pltr2;
1181  pltr_data = &cgrid2;
1182  }
1183  else
1184  {
1185  Tcl_AppendResult( interp,
1186  "Unrecognized coordinate transformation spec:",
1187  pltrname, ", must be pltr0 pltr1 or pltr2.",
1188  (char *) NULL );
1189  return TCL_ERROR;
1190  }
1191  if ( !arg3_is_kx )
1192  {
1193  // default values must be set here since nx, ny can change with wrap.
1194  kx = 1; lx = nx;
1195  ky = 1; ly = ny;
1196  }
1197 
1198 // printf( "plcont: nx=%d ny=%d kx=%d lx=%d ky=%d ly=%d\n",
1199 // nx, ny, kx, lx, ky, ly );
1200 // printf( "plcont: nclev=%d\n", nclev );
1201 //
1202 
1203 // contour the data.
1204 
1205  plcont( (const PLFLT * const *) zused, nx, ny,
1206  kx, lx, ky, ly,
1207  matclev->fdata, nclev,
1208  pltr, pltr_data );
1209 
1210 // Now free up any space which got allocated for our coordinate trickery.
1211 
1212 // zused points to either z or zwrapped. In both cases the allocated size
1213 // was nx by ny. Now free the allocated space, and note in the case
1214 // where zused points to zwrapped, the separate z space has been freed by
1215 // previous wrap logic.
1216  plFree2dGrid( zused, nx, ny );
1217 
1218  if ( pltr == pltr1 )
1219  {
1220  // Hmm, actually, nothing to do here currently, since we just used the
1221  // Tcl Matrix data directly, rather than allocating private space.
1222  }
1223  else if ( pltr == pltr2 )
1224  {
1225  // printf( "plcont, freeing space for grids used in pltr2\n" );
1226  plFree2dGrid( cgrid2.xg, nx, ny );
1227  plFree2dGrid( cgrid2.yg, nx, ny );
1228  }
1229 
1230  plflush();
1231  return TCL_OK;
1232 }
1233 
1234 //--------------------------------------------------------------------------
1235 // plsvect
1236 //
1237 // Implement Tcl-side setting of arrow style.
1238 //--------------------------------------------------------------------------
1239 
1240 static int
1241 plsvectCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp,
1242  int argc, const char *argv[] )
1243 {
1244  tclMatrix *matx, *maty;
1245  PLINT npts;
1246  PLBOOL fill;
1247 
1248  if ( argc == 1
1249  || ( strcmp( argv[1], "NULL" ) == 0 ) && ( strcmp( argv[2], "NULL" ) == 0 ) )
1250  {
1251  // The user has requested to clear the transform setting.
1252  plsvect( NULL, NULL, 0, 0 );
1253  return TCL_OK;
1254  }
1255  else if ( argc != 4 )
1256  {
1257  Tcl_AppendResult( interp, "wrong # args: see documentation for ",
1258  argv[0], (char *) NULL );
1259  return TCL_ERROR;
1260  }
1261 
1262  matx = Tcl_GetMatrixPtr( interp, argv[1] );
1263  if ( matx == NULL )
1264  return TCL_ERROR;
1265 
1266  if ( matx->dim != 1 )
1267  {
1268  Tcl_SetResult( interp, "plsvect: Must use 1-d data.", TCL_STATIC );
1269  return TCL_ERROR;
1270  }
1271  npts = matx->n[0];
1272 
1273  maty = Tcl_GetMatrixPtr( interp, argv[2] );
1274  if ( maty == NULL )
1275  return TCL_ERROR;
1276 
1277  if ( maty->dim != 1 )
1278  {
1279  Tcl_SetResult( interp, "plsvect: Must use 1-d data.", TCL_STATIC );
1280  return TCL_ERROR;
1281  }
1282 
1283  if ( maty->n[0] != npts )
1284  {
1285  Tcl_SetResult( interp, "plsvect: Arrays must be of equal length", TCL_STATIC );
1286  return TCL_ERROR;
1287  }
1288 
1289  fill = (PLBOOL) atoi( argv[3] );
1290 
1291  plsvect( matx->fdata, maty->fdata, npts, fill );
1292 
1293  return TCL_OK;
1294 }
1295 
1296 
1297 //--------------------------------------------------------------------------
1298 // plvect implementation (based on plcont above)
1299 //--------------------------------------------------------------------------
1300 static int
1301 plvectCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp,
1302  int argc, const char *argv[] )
1303 {
1304  tclMatrix *matPtr, *matu, *matv;
1305  PLINT nx, ny;
1306  const char *pltrname = "pltr0";
1307  tclMatrix *mattrx = NULL, *mattry = NULL;
1308  PLFLT **u, **v, **uused, **vused, **uwrapped, **vwrapped;
1309  PLFLT scaling;
1310 
1311  int i, j;
1312  void ( *pltr )( PLFLT, PLFLT, PLFLT *, PLFLT *, PLPointer );
1313  PLPointer pltr_data = NULL;
1314  PLcGrid cgrid1;
1315  PLcGrid2 cgrid2;
1316 
1317  int wrap = 0;
1318 
1319  if ( argc < 3 )
1320  {
1321  Tcl_AppendResult( interp, "wrong # args: see documentation for ",
1322  argv[0], (char *) NULL );
1323  return TCL_ERROR;
1324  }
1325 
1326  matu = Tcl_GetMatrixPtr( interp, argv[1] );
1327  if ( matu == NULL )
1328  return TCL_ERROR;
1329 
1330  if ( matu->dim != 2 )
1331  {
1332  Tcl_SetResult( interp, "Must use 2-d data.", TCL_STATIC );
1333  return TCL_ERROR;
1334  }
1335  else
1336  {
1337  nx = matu->n[0];
1338  ny = matu->n[1];
1339  tclmateval_modx = nx;
1340  tclmateval_mody = ny;
1341 
1342  // convert matu to 2d-array so can use standard wrap approach
1343  // from now on in this code.
1344  plAlloc2dGrid( &u, nx, ny );
1345  for ( i = 0; i < nx; i++ )
1346  {
1347  for ( j = 0; j < ny; j++ )
1348  {
1349  u[i][j] = tclMatrix_feval( i, j, matu );
1350  }
1351  }
1352  }
1353 
1354  matv = Tcl_GetMatrixPtr( interp, argv[2] );
1355  if ( matv == NULL )
1356  return TCL_ERROR;
1357 
1358  if ( matv->dim != 2 )
1359  {
1360  Tcl_SetResult( interp, "Must use 2-d data.", TCL_STATIC );
1361  return TCL_ERROR;
1362  }
1363  else
1364  {
1365  nx = matv->n[0];
1366  ny = matv->n[1];
1367  tclmateval_modx = nx;
1368  tclmateval_mody = ny;
1369 
1370  // convert matv to 2d-array so can use standard wrap approach
1371  // from now on in this code.
1372  plAlloc2dGrid( &v, nx, ny );
1373  for ( i = 0; i < nx; i++ )
1374  {
1375  for ( j = 0; j < ny; j++ )
1376  {
1377  v[i][j] = tclMatrix_feval( i, j, matv );
1378  }
1379  }
1380  }
1381 
1382  argc -= 3, argv += 3;
1383 
1384 // The next argument has to be scaling
1385 
1386  if ( argc < 1 )
1387  {
1388  Tcl_SetResult( interp, "plvect, bogus syntax", TCL_STATIC );
1389  return TCL_ERROR;
1390  }
1391 
1392  scaling = atof( argv[0] );
1393  argc--, argv++;
1394 
1395 // Now handle trailing optional parameters, if any
1396 
1397  if ( argc >= 3 )
1398  {
1399  // There is a pltr spec, parse it.
1400  pltrname = argv[0];
1401  mattrx = Tcl_GetMatrixPtr( interp, argv[1] );
1402  if ( mattrx == NULL )
1403  return TCL_ERROR;
1404  mattry = Tcl_GetMatrixPtr( interp, argv[2] );
1405  if ( mattry == NULL )
1406  return TCL_ERROR;
1407 
1408  argc -= 3, argv += 3;
1409  }
1410 
1411  if ( argc )
1412  {
1413  // There is a wrap spec, get it.
1414  wrap = atoi( argv[0] );
1415 
1416  // Hmm, I said the the doc they could also say x or y, have to come back
1417  // to this...
1418 
1419  argc--, argv++;
1420  }
1421 
1422 // There had better not be anything else on the command line by this point.
1423 
1424  if ( argc )
1425  {
1426  Tcl_SetResult( interp, "plvect, bogus syntax, too many args.", TCL_STATIC );
1427  return TCL_ERROR;
1428  }
1429 
1430 // Now we need to set up the data for contouring.
1431 
1432  if ( !strcmp( pltrname, "pltr0" ) )
1433  {
1434  pltr = pltr0;
1435  uused = u;
1436  vused = v;
1437 
1438  // wrapping is only supported for pltr2.
1439  if ( wrap )
1440  {
1441  Tcl_SetResult( interp, "Must use pltr2 if want wrapping.", TCL_STATIC );
1442  return TCL_ERROR;
1443  }
1444  }
1445  else if ( !strcmp( pltrname, "pltr1" ) )
1446  {
1447  pltr = pltr1;
1448  cgrid1.xg = mattrx->fdata;
1449  cgrid1.nx = nx;
1450  cgrid1.yg = mattry->fdata;
1451  cgrid1.ny = ny;
1452  uused = u;
1453  vused = v;
1454 
1455  // wrapping is only supported for pltr2.
1456  if ( wrap )
1457  {
1458  Tcl_SetResult( interp, "Must use pltr2 if want wrapping.", TCL_STATIC );
1459  return TCL_ERROR;
1460  }
1461 
1462  if ( mattrx->dim != 1 || mattry->dim != 1 )
1463  {
1464  Tcl_SetResult( interp, "Must use 1-d coord arrays with pltr1.", TCL_STATIC );
1465  return TCL_ERROR;
1466  }
1467 
1468  pltr_data = &cgrid1;
1469  }
1470  else if ( !strcmp( pltrname, "pltr2" ) )
1471  {
1472  // printf( "plvect, setting up for pltr2\n" );
1473  if ( !wrap )
1474  {
1475  // printf( "plvect, no wrapping is needed.\n" );
1476  plAlloc2dGrid( &cgrid2.xg, nx, ny );
1477  plAlloc2dGrid( &cgrid2.yg, nx, ny );
1478  cgrid2.nx = nx;
1479  cgrid2.ny = ny;
1480  uused = u;
1481  vused = v;
1482 
1483  matPtr = mattrx;
1484  for ( i = 0; i < nx; i++ )
1485  for ( j = 0; j < ny; j++ )
1486  cgrid2.xg[i][j] = mattrx->fdata[ I2D( i, j ) ];
1487  matPtr = mattry;
1488  for ( i = 0; i < nx; i++ )
1489  {
1490  for ( j = 0; j < ny; j++ )
1491  {
1492  cgrid2.yg[i][j] = mattry->fdata[ I2D( i, j ) ];
1493  }
1494  }
1495  }
1496  else if ( wrap == 1 )
1497  {
1498  plAlloc2dGrid( &cgrid2.xg, nx + 1, ny );
1499  plAlloc2dGrid( &cgrid2.yg, nx + 1, ny );
1500  plAlloc2dGrid( &uwrapped, nx + 1, ny );
1501  plAlloc2dGrid( &vwrapped, nx + 1, ny );
1502  cgrid2.nx = nx + 1;
1503  cgrid2.ny = ny;
1504  uused = uwrapped;
1505  vused = vwrapped;
1506 
1507 
1508  matPtr = mattrx;
1509  for ( i = 0; i < nx; i++ )
1510  for ( j = 0; j < ny; j++ )
1511  cgrid2.xg[i][j] = mattrx->fdata[ I2D( i, j ) ];
1512 
1513  matPtr = mattry;
1514  for ( i = 0; i < nx; i++ )
1515  {
1516  for ( j = 0; j < ny; j++ )
1517  {
1518  cgrid2.yg[i][j] = mattry->fdata[ I2D( i, j ) ];
1519  uwrapped[i][j] = u[i][j];
1520  vwrapped[i][j] = v[i][j];
1521  }
1522  }
1523 
1524  for ( j = 0; j < ny; j++ )
1525  {
1526  cgrid2.xg[nx][j] = cgrid2.xg[0][j];
1527  cgrid2.yg[nx][j] = cgrid2.yg[0][j];
1528  uwrapped[nx][j] = uwrapped[0][j];
1529  vwrapped[nx][j] = vwrapped[0][j];
1530  }
1531 
1532  // u and v not used in executable path after this so free it
1533  // before nx value is changed.
1534  plFree2dGrid( u, nx, ny );
1535  plFree2dGrid( v, nx, ny );
1536  nx++;
1537  }
1538  else if ( wrap == 2 )
1539  {
1540  plAlloc2dGrid( &cgrid2.xg, nx, ny + 1 );
1541  plAlloc2dGrid( &cgrid2.yg, nx, ny + 1 );
1542  plAlloc2dGrid( &uwrapped, nx, ny + 1 );
1543  plAlloc2dGrid( &vwrapped, nx, ny + 1 );
1544  cgrid2.nx = nx;
1545  cgrid2.ny = ny + 1;
1546  uused = uwrapped;
1547  vused = vwrapped;
1548 
1549  matPtr = mattrx;
1550  for ( i = 0; i < nx; i++ )
1551  for ( j = 0; j < ny; j++ )
1552  cgrid2.xg[i][j] = mattrx->fdata[ I2D( i, j ) ];
1553 
1554  matPtr = mattry;
1555  for ( i = 0; i < nx; i++ )
1556  {
1557  for ( j = 0; j < ny; j++ )
1558  {
1559  cgrid2.yg[i][j] = mattry->fdata[ I2D( i, j ) ];
1560  uwrapped[i][j] = u[i][j];
1561  vwrapped[i][j] = v[i][j];
1562  }
1563  }
1564 
1565  for ( i = 0; i < nx; i++ )
1566  {
1567  cgrid2.xg[i][ny] = cgrid2.xg[i][0];
1568  cgrid2.yg[i][ny] = cgrid2.yg[i][0];
1569  uwrapped[i][ny] = uwrapped[i][0];
1570  vwrapped[i][ny] = vwrapped[i][0];
1571  }
1572 
1573  // u and v not used in executable path after this so free it
1574  // before ny value is changed.
1575  plFree2dGrid( u, nx, ny );
1576  plFree2dGrid( v, nx, ny );
1577 
1578  ny++;
1579  }
1580  else
1581  {
1582  Tcl_SetResult( interp, "Invalid wrap specifier, must be <empty>, 0, 1, or 2.", TCL_STATIC );
1583  return TCL_ERROR;
1584  }
1585 
1586  pltr = pltr2;
1587  pltr_data = &cgrid2;
1588  }
1589  else
1590  {
1591  Tcl_AppendResult( interp,
1592  "Unrecognized coordinate transformation spec:",
1593  pltrname, ", must be pltr0 pltr1 or pltr2.",
1594  (char *) NULL );
1595  return TCL_ERROR;
1596  }
1597 
1598 
1599 // plot the vector data.
1600 
1601  plvect( (const PLFLT * const *) uused, (const PLFLT * const *) vused, nx, ny,
1602  scaling, pltr, pltr_data );
1603 // Now free up any space which got allocated for our coordinate trickery.
1604 
1605 // uused points to either u or uwrapped. In both cases the allocated size
1606 // was nx by ny. Now free the allocated space, and note in the case
1607 // where uused points to uwrapped, the separate u space has been freed by
1608 // previous wrap logic.
1609  plFree2dGrid( uused, nx, ny );
1610  plFree2dGrid( vused, nx, ny );
1611 
1612  if ( pltr == pltr1 )
1613  {
1614  // Hmm, actually, nothing to do here currently, since we just used the
1615  // Tcl Matrix data directly, rather than allocating private space.
1616  }
1617  else if ( pltr == pltr2 )
1618  {
1619  // printf( "plvect, freeing space for grids used in pltr2\n" );
1620  plFree2dGrid( cgrid2.xg, nx, ny );
1621  plFree2dGrid( cgrid2.yg, nx, ny );
1622  }
1623 
1624  plflush();
1625  return TCL_OK;
1626 }
1627 
1628 //--------------------------------------------------------------------------
1629 //
1630 // plmeshCmd
1631 //
1632 // Processes plmesh Tcl command.
1633 //
1634 // We support 3 different invocation forms:
1635 // 1) plmesh x y z nx ny opt
1636 // 2) plmesh x y z opt
1637 // 3) plmesh z opt
1638 //
1639 // Form 1) is an exact mirror of the usual C API. In form 2) we infer nx and
1640 // ny from the input data, and in form 3 we inver nx and ny, and also take
1641 // the x and y arrays to just be integral spacing.
1642 //--------------------------------------------------------------------------
1643 
1644 static int
1645 plmeshCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp,
1646  int argc, const char *argv[] )
1647 {
1648  PLINT nx, ny, opt;
1649  PLFLT *x, *y, **z;
1650  tclMatrix *matx, *maty, *matz, *matPtr;
1651  int i;
1652 
1653  if ( argc == 7 )
1654  {
1655  nx = atoi( argv[4] );
1656  ny = atoi( argv[5] );
1657  opt = atoi( argv[6] );
1658 
1659  matx = Tcl_GetMatrixPtr( interp, argv[1] );
1660  if ( matx == NULL )
1661  return TCL_ERROR;
1662  maty = Tcl_GetMatrixPtr( interp, argv[2] );
1663  if ( maty == NULL )
1664  return TCL_ERROR;
1665  matz = Tcl_GetMatrixPtr( interp, argv[3] );
1666  if ( matz == NULL )
1667  return TCL_ERROR;
1668  matPtr = matz; // For dumb indexer macro, grrrr.
1669 
1670  if ( matx->type != TYPE_FLOAT ||
1671  maty->type != TYPE_FLOAT ||
1672  matz->type != TYPE_FLOAT )
1673  {
1674  Tcl_SetResult( interp, "x y and z must all be float", TCL_STATIC );
1675  return TCL_ERROR;
1676  }
1677 
1678  if ( matx->dim != 1 || matx->n[0] != nx ||
1679  maty->dim != 1 || maty->n[0] != ny ||
1680  matz->dim != 2 || matz->n[0] != nx || matz->n[1] != ny )
1681  {
1682  Tcl_SetResult( interp, "Inconsistent dimensions", TCL_STATIC );
1683  return TCL_ERROR;
1684  }
1685 
1686  x = matx->fdata;
1687  y = maty->fdata;
1688 
1689  z = (PLFLT **) malloc( (size_t) nx * sizeof ( PLFLT * ) );
1690  for ( i = 0; i < nx; i++ )
1691  z[i] = &matz->fdata[ I2D( i, 0 ) ];
1692  }
1693  else if ( argc == 5 )
1694  {
1695  opt = atoi( argv[4] );
1696 
1697  matx = Tcl_GetMatrixPtr( interp, argv[1] );
1698  if ( matx == NULL )
1699  return TCL_ERROR;
1700  maty = Tcl_GetMatrixPtr( interp, argv[2] );
1701  if ( maty == NULL )
1702  return TCL_ERROR;
1703  matz = Tcl_GetMatrixPtr( interp, argv[3] );
1704  if ( matz == NULL )
1705  return TCL_ERROR;
1706  matPtr = matz; // For dumb indexer macro, grrrr.
1707 
1708  if ( matx->type != TYPE_FLOAT ||
1709  maty->type != TYPE_FLOAT ||
1710  matz->type != TYPE_FLOAT )
1711  {
1712  Tcl_SetResult( interp, "x y and z must all be float", TCL_STATIC );
1713  return TCL_ERROR;
1714  }
1715 
1716  nx = matx->n[0]; ny = maty->n[0];
1717 
1718  if ( matx->dim != 1 || matx->n[0] != nx ||
1719  maty->dim != 1 || maty->n[0] != ny ||
1720  matz->dim != 2 || matz->n[0] != nx || matz->n[1] != ny )
1721  {
1722  Tcl_SetResult( interp, "Inconsistent dimensions", TCL_STATIC );
1723  return TCL_ERROR;
1724  }
1725 
1726  x = matx->fdata;
1727  y = maty->fdata;
1728 
1729  z = (PLFLT **) malloc( (size_t) nx * sizeof ( PLFLT * ) );
1730  for ( i = 0; i < nx; i++ )
1731  z[i] = &matz->fdata[ I2D( i, 0 ) ];
1732  }
1733  else if ( argc == 3 )
1734  {
1735  Tcl_SetResult( interp, "unimplemented", TCL_STATIC );
1736  return TCL_ERROR;
1737  }
1738  else
1739  {
1740  Tcl_AppendResult( interp, "wrong # args: should be \"plmesh ",
1741  "x y z nx ny opt\", or a valid contraction ",
1742  "thereof.", (char *) NULL );
1743  return TCL_ERROR;
1744  }
1745 
1746  plmesh( x, y, (const PLFLT * const *) z, nx, ny, opt );
1747 
1748  if ( argc == 7 )
1749  {
1750  free( z );
1751  }
1752  else if ( argc == 5 )
1753  {
1754  free( z );
1755  }
1756  else // argc == 3
1757  {
1758  }
1759 
1760  plflush();
1761  return TCL_OK;
1762 }
1763 
1764 //--------------------------------------------------------------------------
1765 // plmeshcCmd
1766 //
1767 // Processes plmeshc Tcl command.
1768 //
1769 // We support 5 different invocation forms:
1770 // 1) plmeshc x y z nx ny opt clevel nlevel
1771 // 2) plmeshc x y z nx ny opt clevel
1772 // 3) plmeshc x y z nx ny opt
1773 // 4) plmeshc x y z opt
1774 // 5) plmeshc z opt
1775 //
1776 // Form 1) is an exact mirror of the usual C API. In form 2) we infer nlevel.
1777 // In form 3,4 and 5 clevel is set to NULL. In form 4 we infer nx and
1778 // ny from the input data, and in form 5 we infer nx and ny, and also take
1779 // the x and y arrays to just be integral spacing.
1780 //--------------------------------------------------------------------------
1781 
1782 static int
1783 plmeshcCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp,
1784  int argc, const char *argv[] )
1785 {
1786  PLINT nx, ny, opt, nlev = 10;
1787  PLFLT *x, *y, **z;
1788  PLFLT *clev;
1789 
1790  tclMatrix *matx, *maty, *matz, *matPtr, *matlev;
1791  int i;
1792 
1793  if ( argc == 9 )
1794  {
1795  nlev = atoi( argv[8] );
1796  nx = atoi( argv[4] );
1797  ny = atoi( argv[5] );
1798  opt = atoi( argv[6] );
1799 
1800  matx = Tcl_GetMatrixPtr( interp, argv[1] );
1801  if ( matx == NULL )
1802  return TCL_ERROR;
1803  maty = Tcl_GetMatrixPtr( interp, argv[2] );
1804  if ( maty == NULL )
1805  return TCL_ERROR;
1806  matz = Tcl_GetMatrixPtr( interp, argv[3] );
1807  if ( matz == NULL )
1808  return TCL_ERROR;
1809  matPtr = matz; // For dumb indexer macro, grrrr.
1810 
1811  matlev = Tcl_GetMatrixPtr( interp, argv[7] );
1812  if ( matlev == NULL )
1813  return TCL_ERROR;
1814 
1815  if ( matx->type != TYPE_FLOAT ||
1816  maty->type != TYPE_FLOAT ||
1817  matz->type != TYPE_FLOAT ||
1818  matlev->type != TYPE_FLOAT )
1819  {
1820  Tcl_SetResult( interp, "x y z and clevel must all be float", TCL_STATIC );
1821  return TCL_ERROR;
1822  }
1823 
1824  if ( matx->dim != 1 || matx->n[0] != nx ||
1825  maty->dim != 1 || maty->n[0] != ny ||
1826  matz->dim != 2 || matz->n[0] != nx || matz->n[1] != ny ||
1827  matlev->dim != 1 || matlev->n[0] != nlev )
1828  {
1829  Tcl_SetResult( interp, "popo Inconsistent dimensions", TCL_STATIC );
1830  return TCL_ERROR;
1831  }
1832 
1833  x = matx->fdata;
1834  y = maty->fdata;
1835  clev = matlev->fdata;
1836 
1837  z = (PLFLT **) malloc( (size_t) nx * sizeof ( PLFLT * ) );
1838  for ( i = 0; i < nx; i++ )
1839  z[i] = &matz->fdata[ I2D( i, 0 ) ];
1840  }
1841 
1842  else if ( argc == 8 )
1843  {
1844  nx = atoi( argv[4] );
1845  ny = atoi( argv[5] );
1846  opt = atoi( argv[6] );
1847 
1848  matx = Tcl_GetMatrixPtr( interp, argv[1] );
1849  if ( matx == NULL )
1850  return TCL_ERROR;
1851  maty = Tcl_GetMatrixPtr( interp, argv[2] );
1852  if ( maty == NULL )
1853  return TCL_ERROR;
1854  matz = Tcl_GetMatrixPtr( interp, argv[3] );
1855  if ( matz == NULL )
1856  return TCL_ERROR;
1857  matPtr = matz; // For dumb indexer macro, grrrr.
1858  matlev = Tcl_GetMatrixPtr( interp, argv[7] );
1859  if ( matlev == NULL )
1860  return TCL_ERROR;
1861 
1862  if ( matx->type != TYPE_FLOAT ||
1863  maty->type != TYPE_FLOAT ||
1864  matz->type != TYPE_FLOAT ||
1865  matlev->type != TYPE_FLOAT )
1866  {
1867  Tcl_SetResult( interp, "x y z and clevel must all be float", TCL_STATIC );
1868  return TCL_ERROR;
1869  }
1870 
1871  if ( matx->dim != 1 || matx->n[0] != nx ||
1872  maty->dim != 1 || maty->n[0] != ny ||
1873  matz->dim != 2 || matz->n[0] != nx || matz->n[1] != ny ||
1874  matlev->dim != 1 || matlev->n[0] != nlev )
1875  {
1876  Tcl_SetResult( interp, "Inconsistent dimensions", TCL_STATIC );
1877  return TCL_ERROR;
1878  }
1879 
1880  x = matx->fdata;
1881  y = maty->fdata;
1882  clev = matlev->fdata;
1883  nlev = matlev->n[0];
1884 
1885  z = (PLFLT **) malloc( (size_t) nx * sizeof ( PLFLT * ) );
1886  for ( i = 0; i < nx; i++ )
1887  z[i] = &matz->fdata[ I2D( i, 0 ) ];
1888  }
1889 
1890  else if ( argc == 7 )
1891  {
1892  nx = atoi( argv[4] );
1893  ny = atoi( argv[5] );
1894  opt = atoi( argv[6] );
1895  clev = NULL;
1896 
1897  matx = Tcl_GetMatrixPtr( interp, argv[1] );
1898  if ( matx == NULL )
1899  return TCL_ERROR;
1900  maty = Tcl_GetMatrixPtr( interp, argv[2] );
1901  if ( maty == NULL )
1902  return TCL_ERROR;
1903  matz = Tcl_GetMatrixPtr( interp, argv[3] );
1904  if ( matz == NULL )
1905  return TCL_ERROR;
1906  matPtr = matz; // For dumb indexer macro, grrrr.
1907 
1908  if ( matx->type != TYPE_FLOAT ||
1909  maty->type != TYPE_FLOAT ||
1910  matz->type != TYPE_FLOAT )
1911  {
1912  Tcl_SetResult( interp, "x y and z must all be float", TCL_STATIC );
1913  return TCL_ERROR;
1914  }
1915 
1916  if ( matx->dim != 1 || matx->n[0] != nx ||
1917  maty->dim != 1 || maty->n[0] != ny ||
1918  matz->dim != 2 || matz->n[0] != nx || matz->n[1] != ny )
1919  {
1920  Tcl_SetResult( interp, "Inconsistent dimensions", TCL_STATIC );
1921  return TCL_ERROR;
1922  }
1923 
1924  x = matx->fdata;
1925  y = maty->fdata;
1926 
1927  z = (PLFLT **) malloc( (size_t) nx * sizeof ( PLFLT * ) );
1928  for ( i = 0; i < nx; i++ )
1929  z[i] = &matz->fdata[ I2D( i, 0 ) ];
1930  }
1931  else if ( argc == 5 )
1932  {
1933  opt = atoi( argv[4] );
1934  clev = NULL;
1935 
1936  matx = Tcl_GetMatrixPtr( interp, argv[1] );
1937  if ( matx == NULL )
1938  return TCL_ERROR;
1939  maty = Tcl_GetMatrixPtr( interp, argv[2] );
1940  if ( maty == NULL )
1941  return TCL_ERROR;
1942  matz = Tcl_GetMatrixPtr( interp, argv[3] );
1943  if ( matz == NULL )
1944  return TCL_ERROR;
1945  matPtr = matz; // For dumb indexer macro, grrrr.
1946 
1947  if ( matx->type != TYPE_FLOAT ||
1948  maty->type != TYPE_FLOAT ||
1949  matz->type != TYPE_FLOAT )
1950  {
1951  Tcl_SetResult( interp, "x y and z must all be float", TCL_STATIC );
1952  return TCL_ERROR;
1953  }
1954 
1955  nx = matx->n[0]; ny = maty->n[0];
1956 
1957  if ( matx->dim != 1 || matx->n[0] != nx ||
1958  maty->dim != 1 || maty->n[0] != ny ||
1959  matz->dim != 2 || matz->n[0] != nx || matz->n[1] != ny )
1960  {
1961  Tcl_SetResult( interp, "Inconsistent dimensions", TCL_STATIC );
1962  return TCL_ERROR;
1963  }
1964 
1965  x = matx->fdata;
1966  y = maty->fdata;
1967 
1968  z = (PLFLT **) malloc( (size_t) nx * sizeof ( PLFLT * ) );
1969  for ( i = 0; i < nx; i++ )
1970  z[i] = &matz->fdata[ I2D( i, 0 ) ];
1971  }
1972  else if ( argc == 3 )
1973  {
1974  Tcl_SetResult( interp, "unimplemented", TCL_STATIC );
1975  return TCL_ERROR;
1976  }
1977  else
1978  {
1979  Tcl_AppendResult( interp, "wrong # args: should be \"plmeshc ",
1980  "x y z nx ny opt clevel nlevel\", or a valid contraction ",
1981  "thereof.", (char *) NULL );
1982  return TCL_ERROR;
1983  }
1984 
1985  plmeshc( x, y, (const PLFLT * const *) z, nx, ny, opt, clev, nlev );
1986 
1987  if ( argc == 7 )
1988  {
1989  free( z );
1990  }
1991  else if ( argc == 5 )
1992  {
1993  free( z );
1994  }
1995  else // argc == 3
1996  {
1997  }
1998 
1999  plflush();
2000  return TCL_OK;
2001 }
2002 
2003 //--------------------------------------------------------------------------
2004 // plot3dCmd
2005 //
2006 // Processes plot3d Tcl command.
2007 //
2008 // We support 3 different invocation forms:
2009 // 1) plot3d x y z nx ny opt side
2010 // 2) plot3d x y z opt side
2011 // 3) plot3d z opt side
2012 //
2013 // Form 1) is an exact mirror of the usual C API. In form 2) we infer nx and
2014 // ny from the input data, and in form 3 we inver nx and ny, and also take
2015 // the x and y arrays to just be integral spacing.
2016 //--------------------------------------------------------------------------
2017 
2018 static int
2019 plot3dCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp,
2020  int argc, const char *argv[] )
2021 {
2022  PLINT nx, ny, opt, side;
2023  PLFLT *x, *y, **z;
2024  tclMatrix *matx, *maty, *matz, *matPtr;
2025  int i;
2026 
2027  if ( argc == 8 )
2028  {
2029  nx = atoi( argv[4] );
2030  ny = atoi( argv[5] );
2031  opt = atoi( argv[6] );
2032  side = atoi( argv[7] );
2033 
2034  matx = Tcl_GetMatrixPtr( interp, argv[1] );
2035  if ( matx == NULL )
2036  return TCL_ERROR;
2037  maty = Tcl_GetMatrixPtr( interp, argv[2] );
2038  if ( maty == NULL )
2039  return TCL_ERROR;
2040  matz = Tcl_GetMatrixPtr( interp, argv[3] );
2041  if ( matz == NULL )
2042  return TCL_ERROR;
2043  matPtr = matz; // For dumb indexer macro, grrrr.
2044 
2045  if ( matx->type != TYPE_FLOAT ||
2046  maty->type != TYPE_FLOAT ||
2047  matz->type != TYPE_FLOAT )
2048  {
2049  Tcl_SetResult( interp, "x y and z must all be float", TCL_STATIC );
2050  return TCL_ERROR;
2051  }
2052 
2053  if ( matx->dim != 1 || matx->n[0] != nx ||
2054  maty->dim != 1 || maty->n[0] != ny ||
2055  matz->dim != 2 || matz->n[0] != nx || matz->n[1] != ny )
2056  {
2057  Tcl_SetResult( interp, "Inconsistent dimensions", TCL_STATIC );
2058  return TCL_ERROR;
2059  }
2060 
2061  x = matx->fdata;
2062  y = maty->fdata;
2063 
2064  z = (PLFLT **) malloc( (size_t) nx * sizeof ( PLFLT * ) );
2065  for ( i = 0; i < nx; i++ )
2066  z[i] = &matz->fdata[ I2D( i, 0 ) ];
2067  }
2068  else if ( argc == 6 )
2069  {
2070  opt = atoi( argv[4] );
2071  side = atoi( argv[5] );
2072 
2073  matx = Tcl_GetMatrixPtr( interp, argv[1] );
2074  if ( matx == NULL )
2075  return TCL_ERROR;
2076  maty = Tcl_GetMatrixPtr( interp, argv[2] );
2077  if ( maty == NULL )
2078  return TCL_ERROR;
2079  matz = Tcl_GetMatrixPtr( interp, argv[3] );
2080  if ( matz == NULL )
2081  return TCL_ERROR;
2082  matPtr = matz; // For dumb indexer macro, grrrr.
2083 
2084  if ( matx->type != TYPE_FLOAT ||
2085  maty->type != TYPE_FLOAT ||
2086  matz->type != TYPE_FLOAT )
2087  {
2088  Tcl_SetResult( interp, "x y and z must all be float", TCL_STATIC );
2089  return TCL_ERROR;
2090  }
2091 
2092  nx = matx->n[0]; ny = maty->n[0];
2093 
2094  if ( matx->dim != 1 || matx->n[0] != nx ||
2095  maty->dim != 1 || maty->n[0] != ny ||
2096  matz->dim != 2 || matz->n[0] != nx || matz->n[1] != ny )
2097  {
2098  Tcl_SetResult( interp, "Inconsistent dimensions", TCL_STATIC );
2099  return TCL_ERROR;
2100  }
2101 
2102  x = matx->fdata;
2103  y = maty->fdata;
2104 
2105  z = (PLFLT **) malloc( (size_t) nx * sizeof ( PLFLT * ) );
2106  for ( i = 0; i < nx; i++ )
2107  z[i] = &matz->fdata[ I2D( i, 0 ) ];
2108  }
2109  else if ( argc == 4 )
2110  {
2111  Tcl_SetResult( interp, "unimplemented", TCL_STATIC );
2112  return TCL_ERROR;
2113  }
2114  else
2115  {
2116  Tcl_AppendResult( interp, "wrong # args: should be \"plot3d ",
2117  "x y z nx ny opt side\", or a valid contraction ",
2118  "thereof.", (char *) NULL );
2119  return TCL_ERROR;
2120  }
2121 
2122  plot3d( x, y, (const PLFLT * const *) z, nx, ny, opt, side );
2123 
2124  if ( argc == 8 )
2125  {
2126  free( z );
2127  }
2128  else if ( argc == 6 )
2129  {
2130  free( z );
2131  }
2132  else // argc == 4
2133  {
2134  }
2135 
2136  plflush();
2137  return TCL_OK;
2138 }
2139 
2140 //--------------------------------------------------------------------------
2141 // plot3dcCmd
2142 //
2143 // Processes plot3dc Tcl command.
2144 //
2145 // We support 5 different invocation forms:
2146 // 1) plot3dc x y z nx ny opt clevel nlevel
2147 // 2) plot3dc x y z nx ny opt clevel
2148 // 3) plot3dc x y z nx ny opt
2149 // 4) plot3dc x y z opt
2150 // 5) plot3dc z opt
2151 //
2152 // Form 1) is an exact mirror of the usual C API. In form 2) we infer nlevel.
2153 // In form 3,4 and 5 clevel is set to NULL. In form 4 we infer nx and
2154 // ny from the input data, and in form 5 we infer nx and ny, and also take
2155 // the x and y arrays to just be integral spacing.
2156 //--------------------------------------------------------------------------
2157 
2158 static int
2159 plot3dcCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp,
2160  int argc, const char *argv[] )
2161 {
2162  PLINT nx, ny, opt, nlev = 10;
2163  PLFLT *x, *y, **z;
2164  PLFLT *clev;
2165 
2166  tclMatrix *matx, *maty, *matz, *matPtr, *matlev;
2167  int i;
2168 
2169  if ( argc == 9 )
2170  {
2171  nlev = atoi( argv[8] );
2172  nx = atoi( argv[4] );
2173  ny = atoi( argv[5] );
2174  opt = atoi( argv[6] );
2175 
2176  matx = Tcl_GetMatrixPtr( interp, argv[1] );
2177  if ( matx == NULL )
2178  return TCL_ERROR;
2179  maty = Tcl_GetMatrixPtr( interp, argv[2] );
2180  if ( maty == NULL )
2181  return TCL_ERROR;
2182  matz = Tcl_GetMatrixPtr( interp, argv[3] );
2183  if ( matz == NULL )
2184  return TCL_ERROR;
2185  matPtr = matz; // For dumb indexer macro, grrrr.
2186 
2187  matlev = Tcl_GetMatrixPtr( interp, argv[7] );
2188  if ( matlev == NULL )
2189  return TCL_ERROR;
2190 
2191  if ( matx->type != TYPE_FLOAT ||
2192  maty->type != TYPE_FLOAT ||
2193  matz->type != TYPE_FLOAT ||
2194  matlev->type != TYPE_FLOAT )
2195  {
2196  Tcl_SetResult( interp, "x y z and clevel must all be float", TCL_STATIC );
2197  return TCL_ERROR;
2198  }
2199 
2200  if ( matx->dim != 1 || matx->n[0] != nx ||
2201  maty->dim != 1 || maty->n[0] != ny ||
2202  matz->dim != 2 || matz->n[0] != nx || matz->n[1] != ny ||
2203  matlev->dim != 1 || matlev->n[0] != nlev )
2204  {
2205  Tcl_SetResult( interp, "popo Inconsistent dimensions", TCL_STATIC );
2206  return TCL_ERROR;
2207  }
2208 
2209  x = matx->fdata;
2210  y = maty->fdata;
2211  clev = matlev->fdata;
2212 
2213  z = (PLFLT **) malloc( (size_t) nx * sizeof ( PLFLT * ) );
2214  for ( i = 0; i < nx; i++ )
2215  z[i] = &matz->fdata[ I2D( i, 0 ) ];
2216  }
2217 
2218  else if ( argc == 8 )
2219  {
2220  nx = atoi( argv[4] );
2221  ny = atoi( argv[5] );
2222  opt = atoi( argv[6] );
2223 
2224  matx = Tcl_GetMatrixPtr( interp, argv[1] );
2225  if ( matx == NULL )
2226  return TCL_ERROR;
2227  maty = Tcl_GetMatrixPtr( interp, argv[2] );
2228  if ( maty == NULL )
2229  return TCL_ERROR;
2230  matz = Tcl_GetMatrixPtr( interp, argv[3] );
2231  if ( matz == NULL )
2232  return TCL_ERROR;
2233  matPtr = matz; // For dumb indexer macro, grrrr.
2234  matlev = Tcl_GetMatrixPtr( interp, argv[7] );
2235  if ( matlev == NULL )
2236  return TCL_ERROR;
2237 
2238  if ( matx->type != TYPE_FLOAT ||
2239  maty->type != TYPE_FLOAT ||
2240  matz->type != TYPE_FLOAT ||
2241  matlev->type != TYPE_FLOAT )
2242  {
2243  Tcl_SetResult( interp, "x y z and clevel must all be float", TCL_STATIC );
2244  return TCL_ERROR;
2245  }
2246 
2247  if ( matx->dim != 1 || matx->n[0] != nx ||
2248  maty->dim != 1 || maty->n[0] != ny ||
2249  matz->dim != 2 || matz->n[0] != nx || matz->n[1] != ny ||
2250  matlev->dim != 1 || matlev->n[0] != nlev )
2251  {
2252  Tcl_SetResult( interp, "Inconsistent dimensions", TCL_STATIC );
2253  return TCL_ERROR;
2254  }
2255 
2256  x = matx->fdata;
2257  y = maty->fdata;
2258  clev = matlev->fdata;
2259  nlev = matlev->n[0];
2260 
2261  z = (PLFLT **) malloc( (size_t) nx * sizeof ( PLFLT * ) );
2262  for ( i = 0; i < nx; i++ )
2263  z[i] = &matz->fdata[ I2D( i, 0 ) ];
2264  }
2265 
2266  else if ( argc == 7 )
2267  {
2268  nx = atoi( argv[4] );
2269  ny = atoi( argv[5] );
2270  opt = atoi( argv[6] );
2271  clev = NULL;
2272 
2273  matx = Tcl_GetMatrixPtr( interp, argv[1] );
2274  if ( matx == NULL )
2275  return TCL_ERROR;
2276  maty = Tcl_GetMatrixPtr( interp, argv[2] );
2277  if ( maty == NULL )
2278  return TCL_ERROR;
2279  matz = Tcl_GetMatrixPtr( interp, argv[3] );
2280  if ( matz == NULL )
2281  return TCL_ERROR;
2282  matPtr = matz; // For dumb indexer macro, grrrr.
2283 
2284  if ( matx->type != TYPE_FLOAT ||
2285  maty->type != TYPE_FLOAT ||
2286  matz->type != TYPE_FLOAT )
2287  {
2288  Tcl_SetResult( interp, "x y and z must all be float", TCL_STATIC );
2289  return TCL_ERROR;
2290  }
2291 
2292  if ( matx->dim != 1 || matx->n[0] != nx ||
2293  maty->dim != 1 || maty->n[0] != ny ||
2294  matz->dim != 2 || matz->n[0] != nx || matz->n[1] != ny )
2295  {
2296  Tcl_SetResult( interp, "Inconsistent dimensions", TCL_STATIC );
2297  return TCL_ERROR;
2298  }
2299 
2300  x = matx->fdata;
2301  y = maty->fdata;
2302 
2303  z = (PLFLT **) malloc( (size_t) nx * sizeof ( PLFLT * ) );
2304  for ( i = 0; i < nx; i++ )
2305  z[i] = &matz->fdata[ I2D( i, 0 ) ];
2306  }
2307  else if ( argc == 5 )
2308  {
2309  opt = atoi( argv[4] );
2310  clev = NULL;
2311 
2312  matx = Tcl_GetMatrixPtr( interp, argv[1] );
2313  if ( matx == NULL )
2314  return TCL_ERROR;
2315  maty = Tcl_GetMatrixPtr( interp, argv[2] );
2316  if ( maty == NULL )
2317  return TCL_ERROR;
2318  matz = Tcl_GetMatrixPtr( interp, argv[3] );
2319  if ( matz == NULL )
2320  return TCL_ERROR;
2321  matPtr = matz; // For dumb indexer macro, grrrr.
2322 
2323  if ( matx->type != TYPE_FLOAT ||
2324  maty->type != TYPE_FLOAT ||
2325  matz->type != TYPE_FLOAT )
2326  {
2327  Tcl_SetResult( interp, "x y and z must all be float", TCL_STATIC );
2328  return TCL_ERROR;
2329  }
2330 
2331  nx = matx->n[0]; ny = maty->n[0];
2332 
2333  if ( matx->dim != 1 || matx->n[0] != nx ||
2334  maty->dim != 1 || maty->n[0] != ny ||
2335  matz->dim != 2 || matz->n[0] != nx || matz->n[1] != ny )
2336  {
2337  Tcl_SetResult( interp, "Inconsistent dimensions", TCL_STATIC );
2338  return TCL_ERROR;
2339  }
2340 
2341  x = matx->fdata;
2342  y = maty->fdata;
2343 
2344  z = (PLFLT **) malloc( (size_t) nx * sizeof ( PLFLT * ) );
2345  for ( i = 0; i < nx; i++ )
2346  z[i] = &matz->fdata[ I2D( i, 0 ) ];
2347  }
2348  else if ( argc == 3 )
2349  {
2350  Tcl_SetResult( interp, "unimplemented", TCL_STATIC );
2351  return TCL_ERROR;
2352  }
2353  else
2354  {
2355  Tcl_AppendResult( interp, "wrong # args: should be \"plot3dc ",
2356  "x y z nx ny opt clevel nlevel\", or a valid contraction ",
2357  "thereof.", (char *) NULL );
2358  return TCL_ERROR;
2359  }
2360 
2361  plot3dc( x, y, (const PLFLT * const *) z, nx, ny, opt, clev, nlev );
2362 
2363  if ( argc == 7 )
2364  {
2365  free( z );
2366  }
2367  else if ( argc == 5 )
2368  {
2369  free( z );
2370  }
2371  else // argc == 3
2372  {
2373  }
2374 
2375  plflush();
2376  return TCL_OK;
2377 }
2378 
2379 //--------------------------------------------------------------------------
2380 // plsurf3dCmd
2381 //
2382 // Processes plsurf3d Tcl command.
2383 //
2384 // We support 5 different invocation forms:
2385 // 1) plsurf3d x y z nx ny opt clevel nlevel
2386 // 2) plsurf3d x y z nx ny opt clevel
2387 // 3) plsurf3d x y z nx ny opt
2388 // 4) plsurf3d x y z opt
2389 // 5) plsurf3d z opt
2390 //
2391 // Form 1) is an exact mirror of the usual C API. In form 2) we infer nlevel.
2392 // In form 3,4 and 5 clevel is set to NULL. In form 4 we infer nx and
2393 // ny from the input data, and in form 5 we infer nx and ny, and also take
2394 // the x and y arrays to just be integral spacing.
2395 //--------------------------------------------------------------------------
2396 
2397 static int
2398 plsurf3dCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp,
2399  int argc, const char *argv[] )
2400 {
2401  PLINT nx, ny, opt, nlev = 10;
2402  PLFLT *x, *y, **z;
2403  PLFLT *clev;
2404 
2405  tclMatrix *matx, *maty, *matz, *matPtr, *matlev;
2406  int i;
2407 
2408  if ( argc == 9 )
2409  {
2410  nlev = atoi( argv[8] );
2411  nx = atoi( argv[4] );
2412  ny = atoi( argv[5] );
2413  opt = atoi( argv[6] );
2414 
2415  matx = Tcl_GetMatrixPtr( interp, argv[1] );
2416  if ( matx == NULL )
2417  return TCL_ERROR;
2418  maty = Tcl_GetMatrixPtr( interp, argv[2] );
2419  if ( maty == NULL )
2420  return TCL_ERROR;
2421  matz = Tcl_GetMatrixPtr( interp, argv[3] );
2422  if ( matz == NULL )
2423  return TCL_ERROR;
2424  matPtr = matz; // For dumb indexer macro, grrrr.
2425 
2426  matlev = Tcl_GetMatrixPtr( interp, argv[7] );
2427  if ( matlev == NULL )
2428  return TCL_ERROR;
2429 
2430  if ( matx->type != TYPE_FLOAT ||
2431  maty->type != TYPE_FLOAT ||
2432  matz->type != TYPE_FLOAT ||
2433  matlev->type != TYPE_FLOAT )
2434  {
2435  Tcl_SetResult( interp, "x y z and clevel must all be float", TCL_STATIC );
2436  return TCL_ERROR;
2437  }
2438 
2439  if ( matx->dim != 1 || matx->n[0] != nx ||
2440  maty->dim != 1 || maty->n[0] != ny ||
2441  matz->dim != 2 || matz->n[0] != nx || matz->n[1] != ny ||
2442  matlev->dim != 1 || matlev->n[0] != nlev )
2443  {
2444  Tcl_SetResult( interp, "popo Inconsistent dimensions", TCL_STATIC );
2445  return TCL_ERROR;
2446  }
2447 
2448  x = matx->fdata;
2449  y = maty->fdata;
2450  clev = matlev->fdata;
2451 
2452  z = (PLFLT **) malloc( (size_t) nx * sizeof ( PLFLT * ) );
2453  for ( i = 0; i < nx; i++ )
2454  z[i] = &matz->fdata[ I2D( i, 0 ) ];
2455  }
2456 
2457  else if ( argc == 8 )
2458  {
2459  nx = atoi( argv[4] );
2460  ny = atoi( argv[5] );
2461  opt = atoi( argv[6] );
2462 
2463  matx = Tcl_GetMatrixPtr( interp, argv[1] );
2464  if ( matx == NULL )
2465  return TCL_ERROR;
2466  maty = Tcl_GetMatrixPtr( interp, argv[2] );
2467  if ( maty == NULL )
2468  return TCL_ERROR;
2469  matz = Tcl_GetMatrixPtr( interp, argv[3] );
2470  if ( matz == NULL )
2471  return TCL_ERROR;
2472  matPtr = matz; // For dumb indexer macro, grrrr.
2473  matlev = Tcl_GetMatrixPtr( interp, argv[7] );
2474  if ( matlev == NULL )
2475  return TCL_ERROR;
2476 
2477  if ( matx->type != TYPE_FLOAT ||
2478  maty->type != TYPE_FLOAT ||
2479  matz->type != TYPE_FLOAT ||
2480  matlev->type != TYPE_FLOAT )
2481  {
2482  Tcl_SetResult( interp, "x y z and clevel must all be float", TCL_STATIC );
2483  return TCL_ERROR;
2484  }
2485 
2486  if ( matx->dim != 1 || matx->n[0] != nx ||
2487  maty->dim != 1 || maty->n[0] != ny ||
2488  matz->dim != 2 || matz->n[0] != nx || matz->n[1] != ny ||
2489  matlev->dim != 1 || matlev->n[0] != nlev )
2490  {
2491  Tcl_SetResult( interp, "Inconsistent dimensions", TCL_STATIC );
2492  return TCL_ERROR;
2493  }
2494 
2495  x = matx->fdata;
2496  y = maty->fdata;
2497  clev = matlev->fdata;
2498  nlev = matlev->n[0];
2499 
2500  z = (PLFLT **) malloc( (size_t) nx * sizeof ( PLFLT * ) );
2501  for ( i = 0; i < nx; i++ )
2502  z[i] = &matz->fdata[ I2D( i, 0 ) ];
2503  }
2504 
2505  else if ( argc == 7 )
2506  {
2507  nx = atoi( argv[4] );
2508  ny = atoi( argv[5] );
2509  opt = atoi( argv[6] );
2510  clev = NULL;
2511 
2512  matx = Tcl_GetMatrixPtr( interp, argv[1] );
2513  if ( matx == NULL )
2514  return TCL_ERROR;
2515  maty = Tcl_GetMatrixPtr( interp, argv[2] );
2516  if ( maty == NULL )
2517  return TCL_ERROR;
2518  matz = Tcl_GetMatrixPtr( interp, argv[3] );
2519  if ( matz == NULL )
2520  return TCL_ERROR;
2521  matPtr = matz; // For dumb indexer macro, grrrr.
2522 
2523  if ( matx->type != TYPE_FLOAT ||
2524  maty->type != TYPE_FLOAT ||
2525  matz->type != TYPE_FLOAT )
2526  {
2527  Tcl_SetResult( interp, "x y and z must all be float", TCL_STATIC );
2528  return TCL_ERROR;
2529  }
2530 
2531  if ( matx->dim != 1 || matx->n[0] != nx ||
2532  maty->dim != 1 || maty->n[0] != ny ||
2533  matz->dim != 2 || matz->n[0] != nx || matz->n[1] != ny )
2534  {
2535  Tcl_SetResult( interp, "Inconsistent dimensions", TCL_STATIC );
2536  return TCL_ERROR;
2537  }
2538 
2539  x = matx->fdata;
2540  y = maty->fdata;
2541 
2542  z = (PLFLT **) malloc( (size_t) nx * sizeof ( PLFLT * ) );
2543  for ( i = 0; i < nx; i++ )
2544  z[i] = &matz->fdata[ I2D( i, 0 ) ];
2545  }
2546  else if ( argc == 5 )
2547  {
2548  opt = atoi( argv[4] );
2549  clev = NULL;
2550 
2551  matx = Tcl_GetMatrixPtr( interp, argv[1] );
2552  if ( matx == NULL )
2553  return TCL_ERROR;
2554  maty = Tcl_GetMatrixPtr( interp, argv[2] );
2555  if ( maty == NULL )
2556  return TCL_ERROR;
2557  matz = Tcl_GetMatrixPtr( interp, argv[3] );
2558  if ( matz == NULL )
2559  return TCL_ERROR;
2560  matPtr = matz; // For dumb indexer macro, grrrr.
2561 
2562  if ( matx->type != TYPE_FLOAT ||
2563  maty->type != TYPE_FLOAT ||
2564  matz->type != TYPE_FLOAT )
2565  {
2566  Tcl_SetResult( interp, "x y and z must all be float", TCL_STATIC );
2567  return TCL_ERROR;
2568  }
2569 
2570  nx = matx->n[0]; ny = maty->n[0];
2571 
2572  if ( matx->dim != 1 || matx->n[0] != nx ||
2573  maty->dim != 1 || maty->n[0] != ny ||
2574  matz->dim != 2 || matz->n[0] != nx || matz->n[1] != ny )
2575  {
2576  Tcl_SetResult( interp, "Inconsistent dimensions", TCL_STATIC );
2577  return TCL_ERROR;
2578  }
2579 
2580  x = matx->fdata;
2581  y = maty->fdata;
2582 
2583  z = (PLFLT **) malloc( (size_t) nx * sizeof ( PLFLT * ) );
2584  for ( i = 0; i < nx; i++ )
2585  z[i] = &matz->fdata[ I2D( i, 0 ) ];
2586  }
2587  else if ( argc == 3 )
2588  {
2589  Tcl_SetResult( interp, "unimplemented", TCL_STATIC );
2590  return TCL_ERROR;
2591  }
2592  else
2593  {
2594  Tcl_AppendResult( interp, "wrong # args: should be \"plsurf3d ",
2595  "x y z nx ny opt clevel nlevel\", or a valid contraction ",
2596  "thereof.", (char *) NULL );
2597  return TCL_ERROR;
2598  }
2599 
2600  plsurf3d( x, y, (const PLFLT * const *) z, nx, ny, opt, clev, nlev );
2601 
2602  if ( argc == 7 )
2603  {
2604  free( z );
2605  }
2606  else if ( argc == 5 )
2607  {
2608  free( z );
2609  }
2610  else // argc == 3
2611  {
2612  }
2613 
2614  plflush();
2615  return TCL_OK;
2616 }
2617 
2618 //--------------------------------------------------------------------------
2619 // plranddCmd
2620 //
2621 // Return a random number
2622 //--------------------------------------------------------------------------
2623 
2624 static int
2625 plranddCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp,
2626  int argc, const char **argv )
2627 {
2628  if ( argc != 1 )
2629  {
2630  Tcl_AppendResult( interp, "wrong # args: ",
2631  argv[0], " takes no arguments", (char *) NULL );
2632  return TCL_ERROR;
2633  }
2634  else
2635  {
2636  Tcl_SetObjResult( interp, Tcl_NewDoubleObj( plrandd() ) );
2637  return TCL_OK;
2638  }
2639 }
2640 
2641 //--------------------------------------------------------------------------
2642 // plsetoptCmd
2643 //
2644 // Processes plsetopt Tcl command.
2645 //--------------------------------------------------------------------------
2646 
2647 static int
2648 plsetoptCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp,
2649  int argc, const char **argv )
2650 {
2651  if ( argc < 2 || argc > 3 )
2652  {
2653  Tcl_AppendResult( interp, "wrong # args: should be \"",
2654  argv[0], " option ?argument?\"", (char *) NULL );
2655  return TCL_ERROR;
2656  }
2657 
2658  plsetopt( argv[1], argv[2] );
2659 
2660  plflush();
2661  return TCL_OK;
2662 }
2663 
2664 //--------------------------------------------------------------------------
2665 // plshadeCmd
2666 //
2667 // Processes plshade Tcl command.
2668 // C version takes:
2669 // data, nx, ny, defined,
2670 // xmin, xmax, ymin, ymax,
2671 // sh_min, sh_max, sh_cmap, sh_color, sh_width,
2672 // min_col, min_wid, max_col, max_wid,
2673 // plfill, rect, pltr, pltr_data
2674 //
2675 // We will be getting data through a 2-d Matrix, which carries along
2676 // nx and ny, so no need for those. Toss defined since it's not supported
2677 // anyway. Toss plfill since it is the only valid choice. Take an optional
2678 // pltr spec just as for plcont or an alternative of NULL pltr, and add a
2679 // wrapping specifier, as in plcont. So the new command looks like:
2680 //
2681 // *INDENT-OFF*
2682 // plshade z xmin xmax ymin ymax
2683 // sh_min sh_max sh_cmap sh_color sh_width
2684 // min_col min_wid max_col max_wid
2685 // rect [[pltr x y] | NULL ] [wrap]
2686 // *INDENT-ON*
2687 //--------------------------------------------------------------------------
2688 
2689 static int
2690 plshadeCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp,
2691  int argc, const char *argv[] )
2692 {
2693  tclMatrix *matPtr, *matz, *mattrx = NULL, *mattry = NULL;
2694  PLFLT **z, **zused, **zwrapped;
2695  PLFLT xmin, xmax, ymin, ymax, sh_min, sh_max, sh_col;
2696 
2697  PLINT sh_cmap = 1;
2698  PLFLT sh_wid = 2.;
2699  PLINT min_col = 1, max_col = 0;
2700  PLFLT min_wid = 0., max_wid = 0.;
2701  PLINT rect = 1;
2702  const char *pltrname = "pltr0";
2703  void ( *pltr )( PLFLT, PLFLT, PLFLT *, PLFLT *, PLPointer );
2704  PLPointer pltr_data = NULL;
2705  PLcGrid cgrid1;
2706  PLcGrid2 cgrid2;
2707  PLINT wrap = 0;
2708  int nx, ny, i, j;
2709 
2710  if ( argc < 16 )
2711  {
2712  Tcl_AppendResult( interp, "bogus syntax for plshade, see doc.",
2713  (char *) NULL );
2714  return TCL_ERROR;
2715  }
2716 
2717  matz = Tcl_GetMatrixPtr( interp, argv[1] );
2718  if ( matz == NULL )
2719  return TCL_ERROR;
2720  if ( matz->dim != 2 )
2721  {
2722  Tcl_SetResult( interp, "Must plot a 2-d matrix.", TCL_STATIC );
2723  return TCL_ERROR;
2724  }
2725 
2726  nx = matz->n[0];
2727  ny = matz->n[1];
2728 
2729  tclmateval_modx = nx;
2730  tclmateval_mody = ny;
2731 
2732  // convert matz to 2d-array so can use standard wrap approach
2733  // from now on in this code.
2734  plAlloc2dGrid( &z, nx, ny );
2735  for ( i = 0; i < nx; i++ )
2736  {
2737  for ( j = 0; j < ny; j++ )
2738  {
2739  z[i][j] = tclMatrix_feval( i, j, matz );
2740  }
2741  }
2742 
2743  xmin = atof( argv[2] );
2744  xmax = atof( argv[3] );
2745  ymin = atof( argv[4] );
2746  ymax = atof( argv[5] );
2747  sh_min = atof( argv[6] );
2748  sh_max = atof( argv[7] );
2749  sh_cmap = atoi( argv[8] );
2750  sh_col = atof( argv[9] );
2751  sh_wid = atof( argv[10] );
2752  min_col = atoi( argv[11] );
2753  min_wid = atoi( argv[12] );
2754  max_col = atoi( argv[13] );
2755  max_wid = atof( argv[14] );
2756  rect = atoi( argv[15] );
2757 
2758  argc -= 16, argv += 16;
2759 
2760  if ( argc >= 3 )
2761  {
2762  pltrname = argv[0];
2763  mattrx = Tcl_GetMatrixPtr( interp, argv[1] );
2764  if ( mattrx == NULL )
2765  return TCL_ERROR;
2766  mattry = Tcl_GetMatrixPtr( interp, argv[2] );
2767  if ( mattry == NULL )
2768  return TCL_ERROR;
2769 
2770  argc -= 3, argv += 3;
2771  }
2772  else if ( argc && !strcmp( argv[0], "NULL" ) )
2773  {
2774  pltrname = argv[0];
2775  argc -= 1, argv += 1;
2776  }
2777 
2778  if ( argc )
2779  {
2780  wrap = atoi( argv[0] );
2781  argc--, argv++;
2782  }
2783 
2784  if ( argc )
2785  {
2786  Tcl_SetResult( interp, "plshade: bogus arg list", TCL_STATIC );
2787  return TCL_ERROR;
2788  }
2789 
2790 // Figure out which coordinate transformation model is being used, and setup
2791 // accordingly.
2792 
2793  if ( !strcmp( pltrname, "NULL" ) )
2794  {
2795  pltr = NULL;
2796  zused = z;
2797 
2798  // wrapping is only supported for pltr2.
2799  if ( wrap )
2800  {
2801  Tcl_SetResult( interp, "Must use pltr2 if want wrapping.", TCL_STATIC );
2802  return TCL_ERROR;
2803  }
2804  }
2805  else if ( !strcmp( pltrname, "pltr0" ) )
2806  {
2807  pltr = pltr0;
2808  zused = z;
2809 
2810  // wrapping is only supported for pltr2.
2811  if ( wrap )
2812  {
2813  Tcl_SetResult( interp, "Must use pltr2 if want wrapping.", TCL_STATIC );
2814  return TCL_ERROR;
2815  }
2816  }
2817  else if ( !strcmp( pltrname, "pltr1" ) )
2818  {
2819  pltr = pltr1;
2820  cgrid1.xg = mattrx->fdata;
2821  cgrid1.nx = nx;
2822  cgrid1.yg = mattry->fdata;
2823  cgrid1.ny = ny;
2824  zused = z;
2825 
2826  // wrapping is only supported for pltr2.
2827  if ( wrap )
2828  {
2829  Tcl_SetResult( interp, "Must use pltr2 if want wrapping.", TCL_STATIC );
2830  return TCL_ERROR;
2831  }
2832 
2833  if ( mattrx->dim != 1 || mattry->dim != 1 )
2834  {
2835  Tcl_SetResult( interp, "Must use 1-d coord arrays with pltr1.", TCL_STATIC );
2836  return TCL_ERROR;
2837  }
2838 
2839  pltr_data = &cgrid1;
2840  }
2841  else if ( !strcmp( pltrname, "pltr2" ) )
2842  {
2843  // printf( "plshade, setting up for pltr2\n" );
2844  if ( !wrap )
2845  {
2846  // printf( "plshade, no wrapping is needed.\n" );
2847  plAlloc2dGrid( &cgrid2.xg, nx, ny );
2848  plAlloc2dGrid( &cgrid2.yg, nx, ny );
2849  cgrid2.nx = nx;
2850  cgrid2.ny = ny;
2851  zused = z;
2852 
2853  matPtr = mattrx;
2854  for ( i = 0; i < nx; i++ )
2855  for ( j = 0; j < ny; j++ )
2856  cgrid2.xg[i][j] = mattrx->fdata[ I2D( i, j ) ];
2857 
2858  matPtr = mattry;
2859  for ( i = 0; i < nx; i++ )
2860  for ( j = 0; j < ny; j++ )
2861  cgrid2.yg[i][j] = mattry->fdata[ I2D( i, j ) ];
2862  }
2863  else if ( wrap == 1 )
2864  {
2865  plAlloc2dGrid( &cgrid2.xg, nx + 1, ny );
2866  plAlloc2dGrid( &cgrid2.yg, nx + 1, ny );
2867  plAlloc2dGrid( &zwrapped, nx + 1, ny );
2868  cgrid2.nx = nx + 1;
2869  cgrid2.ny = ny;
2870  zused = zwrapped;
2871 
2872  matPtr = mattrx;
2873  for ( i = 0; i < nx; i++ )
2874  for ( j = 0; j < ny; j++ )
2875  cgrid2.xg[i][j] = mattrx->fdata[ I2D( i, j ) ];
2876 
2877  matPtr = mattry;
2878  for ( i = 0; i < nx; i++ )
2879  {
2880  for ( j = 0; j < ny; j++ )
2881  {
2882  cgrid2.yg[i][j] = mattry->fdata[ I2D( i, j ) ];
2883  zwrapped[i][j] = z[i][j];
2884  }
2885  }
2886 
2887  for ( j = 0; j < ny; j++ )
2888  {
2889  cgrid2.xg[nx][j] = cgrid2.xg[0][j];
2890  cgrid2.yg[nx][j] = cgrid2.yg[0][j];
2891  zwrapped[nx][j] = zwrapped[0][j];
2892  }
2893 
2894  // z not used in executable path after this so free it before
2895  // nx value is changed.
2896  plFree2dGrid( z, nx, ny );
2897 
2898  nx++;
2899  }
2900  else if ( wrap == 2 )
2901  {
2902  plAlloc2dGrid( &cgrid2.xg, nx, ny + 1 );
2903  plAlloc2dGrid( &cgrid2.yg, nx, ny + 1 );
2904  plAlloc2dGrid( &zwrapped, nx, ny + 1 );
2905  cgrid2.nx = nx;
2906  cgrid2.ny = ny + 1;
2907  zused = zwrapped;
2908 
2909  matPtr = mattrx;
2910  for ( i = 0; i < nx; i++ )
2911  for ( j = 0; j < ny; j++ )
2912  cgrid2.xg[i][j] = mattrx->fdata[ I2D( i, j ) ];
2913 
2914  matPtr = mattry;
2915  for ( i = 0; i < nx; i++ )
2916  {
2917  for ( j = 0; j < ny; j++ )
2918  {
2919  cgrid2.yg[i][j] = mattry->fdata[ I2D( i, j ) ];
2920  zwrapped[i][j] = z[i][j];
2921  }
2922  }
2923 
2924  for ( i = 0; i < nx; i++ )
2925  {
2926  cgrid2.xg[i][ny] = cgrid2.xg[i][0];
2927  cgrid2.yg[i][ny] = cgrid2.yg[i][0];
2928  zwrapped[i][ny] = zwrapped[i][0];
2929  }
2930 
2931  // z not used in executable path after this so free it before
2932  // ny value is changed.
2933  plFree2dGrid( z, nx, ny );
2934 
2935  ny++;
2936  }
2937  else
2938  {
2939  Tcl_SetResult( interp, "Invalid wrap specifier, must be <empty>, 0, 1, or 2.", TCL_STATIC );
2940  return TCL_ERROR;
2941  }
2942 
2943  pltr = pltr2;
2944  pltr_data = &cgrid2;
2945  }
2946  else
2947  {
2948  Tcl_AppendResult( interp,
2949  "Unrecognized coordinate transformation spec:",
2950  pltrname, ", must be NULL, pltr0, pltr1, or pltr2.",
2951  (char *) NULL );
2952  return TCL_ERROR;
2953  }
2954 
2955 // Now go make the plot.
2956 
2957  plshade( (const PLFLT * const *) zused, nx, ny, NULL,
2958  xmin, xmax, ymin, ymax,
2959  sh_min, sh_max, sh_cmap, sh_col, sh_wid,
2960  min_col, min_wid, max_col, max_wid,
2961  plfill, rect, pltr, pltr_data );
2962 
2963 // Now free up any space which got allocated for our coordinate trickery.
2964 
2965 // zused points to either z or zwrapped. In both cases the allocated size
2966 // was nx by ny. Now free the allocated space, and note in the case
2967 // where zused points to zwrapped, the separate z space has been freed by
2968 // previous wrap logic.
2969  plFree2dGrid( zused, nx, ny );
2970 
2971  if ( pltr == pltr1 )
2972  {
2973  // Hmm, actually, nothing to do here currently, since we just used the
2974  // Tcl Matrix data directly, rather than allocating private space.
2975  }
2976  else if ( pltr == pltr2 )
2977  {
2978  // printf( "plshade, freeing space for grids used in pltr2\n" );
2979  plFree2dGrid( cgrid2.xg, nx, ny );
2980  plFree2dGrid( cgrid2.yg, nx, ny );
2981  }
2982 
2983  plflush();
2984  return TCL_OK;
2985 }
2986 
2987 //--------------------------------------------------------------------------
2988 // plshadesCmd
2989 //
2990 // Processes plshades Tcl command.
2991 // C version takes:
2992 // data, nx, ny, defined,
2993 // xmin, xmax, ymin, ymax,
2994 // clevel, nlevel, fill_width, cont_color, cont_width,
2995 // plfill, rect, pltr, pltr_data
2996 //
2997 // We will be getting data through a 2-d Matrix, which carries along
2998 // nx and ny, so no need for those. Toss defined since it's not supported
2999 // anyway. clevel will be via a 1-d matrix, which carries along nlevel, so
3000 // no need for that. Toss plfill since it is the only valid choice.
3001 // Take an optional pltr spec just as for plcont or an alternative of
3002 // NULL pltr, and add a wrapping specifier, as in plcont.
3003 // So the new command looks like:
3004 //
3005 // *INDENT-OFF*
3006 // plshades z xmin xmax ymin ymax
3007 // clevel, fill_width, cont_color, cont_width
3008 // rect [[pltr x y] | NULL] [wrap]
3009 // *INDENT-ON*
3010 //--------------------------------------------------------------------------
3011 
3012 static int
3013 plshadesCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp,
3014  int argc, const char *argv[] )
3015 {
3016  tclMatrix *matPtr, *matz, *mattrx = NULL, *mattry = NULL;
3017  tclMatrix *matclevel = NULL;
3018  PLFLT **z, **zused, **zwrapped;
3019  PLFLT xmin, xmax, ymin, ymax;
3020  PLINT cont_color = 0;
3021  PLFLT fill_width = 0., cont_width = 0.;
3022  PLINT rect = 1;
3023  const char *pltrname = "pltr0";
3024  void ( *pltr )( PLFLT, PLFLT, PLFLT *, PLFLT *, PLPointer );
3025  PLPointer pltr_data = NULL;
3026  PLcGrid cgrid1;
3027  PLcGrid2 cgrid2;
3028  PLINT wrap = 0;
3029  int nx, ny, nlevel, i, j;
3030 
3031  if ( argc < 11 )
3032  {
3033  Tcl_AppendResult( interp, "bogus syntax for plshades, see doc.",
3034  (char *) NULL );
3035  return TCL_ERROR;
3036  }
3037 
3038  matz = Tcl_GetMatrixPtr( interp, argv[1] );
3039  if ( matz == NULL )
3040  return TCL_ERROR;
3041  if ( matz->dim != 2 )
3042  {
3043  Tcl_SetResult( interp, "Must plot a 2-d matrix.", TCL_STATIC );
3044  return TCL_ERROR;
3045  }
3046 
3047  nx = matz->n[0];
3048  ny = matz->n[1];
3049 
3050  tclmateval_modx = nx;
3051  tclmateval_mody = ny;
3052 
3053  // convert matz to 2d-array so can use standard wrap approach
3054  // from now on in this code.
3055  plAlloc2dGrid( &z, nx, ny );
3056  for ( i = 0; i < nx; i++ )
3057  {
3058  for ( j = 0; j < ny; j++ )
3059  {
3060  z[i][j] = tclMatrix_feval( i, j, matz );
3061  }
3062  }
3063 
3064  xmin = atof( argv[2] );
3065  xmax = atof( argv[3] );
3066  ymin = atof( argv[4] );
3067  ymax = atof( argv[5] );
3068 
3069  matclevel = Tcl_GetMatrixPtr( interp, argv[6] );
3070  if ( matclevel == NULL )
3071  return TCL_ERROR;
3072  nlevel = matclevel->n[0];
3073  if ( matclevel->dim != 1 )
3074  {
3075  Tcl_SetResult( interp, "clevel must be 1-d matrix.", TCL_STATIC );
3076  return TCL_ERROR;
3077  }
3078 
3079  fill_width = atof( argv[7] );
3080  cont_color = atoi( argv[8] );
3081  cont_width = atof( argv[9] );
3082  rect = atoi( argv[10] );
3083 
3084  argc -= 11, argv += 11;
3085 
3086  if ( argc >= 3 )
3087  {
3088  pltrname = argv[0];
3089  mattrx = Tcl_GetMatrixPtr( interp, argv[1] );
3090  if ( mattrx == NULL )
3091  return TCL_ERROR;
3092  mattry = Tcl_GetMatrixPtr( interp, argv[2] );
3093  if ( mattry == NULL )
3094  return TCL_ERROR;
3095 
3096  argc -= 3, argv += 3;
3097  }
3098  else if ( argc && !strcmp( argv[0], "NULL" ) )
3099  {
3100  pltrname = argv[0];
3101  argc -= 1, argv += 1;
3102  }
3103 
3104  if ( argc )
3105  {
3106  wrap = atoi( argv[0] );
3107  argc--, argv++;
3108  }
3109 
3110  if ( argc )
3111  {
3112  Tcl_SetResult( interp, "plshades: bogus arg list", TCL_STATIC );
3113  return TCL_ERROR;
3114  }
3115 
3116 // Figure out which coordinate transformation model is being used, and setup
3117 // accordingly.
3118 
3119  if ( !strcmp( pltrname, "NULL" ) )
3120  {
3121  pltr = NULL;
3122  zused = z;
3123 
3124  // wrapping is only supported for pltr2.
3125  if ( wrap )
3126  {
3127  Tcl_SetResult( interp, "Must use pltr2 if want wrapping.", TCL_STATIC );
3128  return TCL_ERROR;
3129  }
3130  }
3131  else if ( !strcmp( pltrname, "pltr0" ) )
3132  {
3133  pltr = pltr0;
3134  zused = z;
3135 
3136  // wrapping is only supported for pltr2.
3137  if ( wrap )
3138  {
3139  Tcl_SetResult( interp, "Must use pltr2 if want wrapping.", TCL_STATIC );
3140  return TCL_ERROR;
3141  }
3142  }
3143  else if ( !strcmp( pltrname, "pltr1" ) )
3144  {
3145  pltr = pltr1;
3146  cgrid1.xg = mattrx->fdata;
3147  cgrid1.nx = nx;
3148  cgrid1.yg = mattry->fdata;
3149  cgrid1.ny = ny;
3150  zused = z;
3151 
3152  // wrapping is only supported for pltr2.
3153  if ( wrap )
3154  {
3155  Tcl_SetResult( interp, "Must use pltr2 if want wrapping.", TCL_STATIC );
3156  return TCL_ERROR;
3157  }
3158 
3159  if ( mattrx->dim != 1 || mattry->dim != 1 )
3160  {
3161  Tcl_SetResult( interp, "Must use 1-d coord arrays with pltr1.", TCL_STATIC );
3162  return TCL_ERROR;
3163  }
3164 
3165  pltr_data = &cgrid1;
3166  }
3167  else if ( !strcmp( pltrname, "pltr2" ) )
3168  {
3169  // printf( "plshades, setting up for pltr2\n" );
3170  if ( !wrap )
3171  {
3172  // printf( "plshades, no wrapping is needed.\n" );
3173  plAlloc2dGrid( &cgrid2.xg, nx, ny );
3174  plAlloc2dGrid( &cgrid2.yg, nx, ny );
3175  cgrid2.nx = nx;
3176  cgrid2.ny = ny;
3177  zused = z;
3178 
3179  matPtr = mattrx;
3180  for ( i = 0; i < nx; i++ )
3181  for ( j = 0; j < ny; j++ )
3182  cgrid2.xg[i][j] = mattrx->fdata[ I2D( i, j ) ];
3183 
3184  matPtr = mattry;
3185  for ( i = 0; i < nx; i++ )
3186  for ( j = 0; j < ny; j++ )
3187  cgrid2.yg[i][j] = mattry->fdata[ I2D( i, j ) ];
3188  }
3189  else if ( wrap == 1 )
3190  {
3191  plAlloc2dGrid( &cgrid2.xg, nx + 1, ny );
3192  plAlloc2dGrid( &cgrid2.yg, nx + 1, ny );
3193  plAlloc2dGrid( &zwrapped, nx + 1, ny );
3194  cgrid2.nx = nx + 1;
3195  cgrid2.ny = ny;
3196  zused = zwrapped;
3197 
3198  matPtr = mattrx;
3199  for ( i = 0; i < nx; i++ )
3200  for ( j = 0; j < ny; j++ )
3201  cgrid2.xg[i][j] = mattrx->fdata[ I2D( i, j ) ];
3202 
3203  matPtr = mattry;
3204  for ( i = 0; i < nx; i++ )
3205  {
3206  for ( j = 0; j < ny; j++ )
3207  {
3208  cgrid2.yg[i][j] = mattry->fdata[ I2D( i, j ) ];
3209  zwrapped[i][j] = z[i][j];
3210  }
3211  }
3212 
3213  for ( j = 0; j < ny; j++ )
3214  {
3215  cgrid2.xg[nx][j] = cgrid2.xg[0][j];
3216  cgrid2.yg[nx][j] = cgrid2.yg[0][j];
3217  zwrapped[nx][j] = zwrapped[0][j];
3218  }
3219 
3220  // z not used in executable path after this so free it before
3221  // nx value is changed.
3222  plFree2dGrid( z, nx, ny );
3223 
3224  nx++;
3225  }
3226  else if ( wrap == 2 )
3227  {
3228  plAlloc2dGrid( &cgrid2.xg, nx, ny + 1 );
3229  plAlloc2dGrid( &cgrid2.yg, nx, ny + 1 );
3230  plAlloc2dGrid( &zwrapped, nx, ny + 1 );
3231  cgrid2.nx = nx;
3232  cgrid2.ny = ny + 1;
3233  zused = zwrapped;
3234 
3235  matPtr = mattrx;
3236  for ( i = 0; i < nx; i++ )
3237  for ( j = 0; j < ny; j++ )
3238  cgrid2.xg[i][j] = mattrx->fdata[ I2D( i, j ) ];
3239 
3240  matPtr = mattry;
3241  for ( i = 0; i < nx; i++ )
3242  {
3243  for ( j = 0; j < ny; j++ )
3244  {
3245  cgrid2.yg[i][j] = mattry->fdata[ I2D( i, j ) ];
3246  zwrapped[i][j] = z[i][j];
3247  }
3248  }
3249 
3250  for ( i = 0; i < nx; i++ )
3251  {
3252  cgrid2.xg[i][ny] = cgrid2.xg[i][0];
3253  cgrid2.yg[i][ny] = cgrid2.yg[i][0];
3254  zwrapped[i][ny] = zwrapped[i][0];
3255  }
3256 
3257  // z not used in executable path after this so free it before
3258  // ny value is changed.
3259  plFree2dGrid( z, nx, ny );
3260 
3261  ny++;
3262  }
3263  else
3264  {
3265  Tcl_SetResult( interp, "Invalid wrap specifier, must be <empty>, 0, 1, or 2.", TCL_STATIC );
3266  return TCL_ERROR;
3267  }
3268 
3269  pltr = pltr2;
3270  pltr_data = &cgrid2;
3271  }
3272  else
3273  {
3274  Tcl_AppendResult( interp,
3275  "Unrecognized coordinate transformation spec:",
3276  pltrname, ", must be NULL, pltr0, pltr1, or pltr2.",
3277  (char *) NULL );
3278  return TCL_ERROR;
3279  }
3280 
3281 // Now go make the plot.
3282 
3283  plshades( (const PLFLT * const *) zused, nx, ny, NULL,
3284  xmin, xmax, ymin, ymax,
3285  matclevel->fdata, nlevel, fill_width, cont_color, cont_width,
3286  plfill, rect, pltr, pltr_data );
3287 
3288 // Now free up any space which got allocated for our coordinate trickery.
3289 
3290 // zused points to either z or zwrapped. In both cases the allocated size
3291 // was nx by ny. Now free the allocated space, and note in the case
3292 // where zused points to zwrapped, the separate z space has been freed by
3293 // previous wrap logic.
3294  plFree2dGrid( zused, nx, ny );
3295 
3296  if ( pltr == pltr1 )
3297  {
3298  // Hmm, actually, nothing to do here currently, since we just used the
3299  // Tcl Matrix data directly, rather than allocating private space.
3300  }
3301  else if ( pltr == pltr2 )
3302  {
3303  // printf( "plshades, freeing space for grids used in pltr2\n" );
3304  plFree2dGrid( cgrid2.xg, nx, ny );
3305  plFree2dGrid( cgrid2.yg, nx, ny );
3306  }
3307 
3308  plflush();
3309  return TCL_OK;
3310 }
3311 
3312 //--------------------------------------------------------------------------
3313 // mapform
3314 //
3315 // Defines our coordinate transformation.
3316 // x[], y[] are the coordinates to be plotted.
3317 //--------------------------------------------------------------------------
3318 
3319 static const char *transform_name; // Name of the procedure that transforms the
3320  // coordinates
3321 static Tcl_Interp *tcl_interp; // Pointer to the current interp
3322 static int return_code; // Saved return code
3323 
3324 void
3325 mapform( PLINT n, PLFLT *x, PLFLT *y )
3326 {
3327  int i;
3328  char *cmd;
3329  tclMatrix *xPtr, *yPtr;
3330 
3331  cmd = (char *) malloc( strlen( transform_name ) + 40 );
3332 
3333  // Build the (new) matrix commands and fill the matrices
3334  sprintf( cmd, "matrix %cx f %d", (char) 1, n );
3335  if ( Tcl_Eval( tcl_interp, cmd ) != TCL_OK )
3336  {
3337  return_code = TCL_ERROR;
3338  free( cmd );
3339  return;
3340  }
3341  sprintf( cmd, "matrix %cy f %d", (char) 1, n );
3342  if ( Tcl_Eval( tcl_interp, cmd ) != TCL_OK )
3343  {
3344  return_code = TCL_ERROR;
3345  free( cmd );
3346  return;
3347  }
3348 
3349  sprintf( cmd, "%cx", (char) 1 );
3350  xPtr = Tcl_GetMatrixPtr( tcl_interp, cmd );
3351  sprintf( cmd, "%cy", (char) 1 );
3352  yPtr = Tcl_GetMatrixPtr( tcl_interp, cmd );
3353 
3354  if ( xPtr == NULL || yPtr == NULL )
3355  return; // Impossible, but still
3356 
3357  for ( i = 0; i < n; i++ )
3358  {
3359  xPtr->fdata[i] = x[i];
3360  yPtr->fdata[i] = y[i];
3361  }
3362 
3363  // Now call the Tcl procedure to do the work
3364  sprintf( cmd, "%s %d %cx %cy", transform_name, n, (char) 1, (char) 1 );
3365  return_code = Tcl_Eval( tcl_interp, cmd );
3366  if ( return_code != TCL_OK )
3367  {
3368  free( cmd );
3369  return;
3370  }
3371 
3372  // Don't forget to copy the results back into the original arrays
3373  //
3374  for ( i = 0; i < n; i++ )
3375  {
3376  x[i] = xPtr->fdata[i];
3377  y[i] = yPtr->fdata[i];
3378  }
3379 
3380  // Clean up, otherwise the next call will fail - [matrix] does not
3381  // overwrite existing commands
3382  //
3383  sprintf( cmd, "rename %cx {}; rename %cy {}", (char) 1, (char) 1 );
3384  return_code = Tcl_Eval( tcl_interp, cmd );
3385 
3386  free( cmd );
3387 }
3388 
3389 //--------------------------------------------------------------------------
3390 // plmapCmd
3391 //
3392 // Processes plmap Tcl command.
3393 // C version takes:
3394 // string, minlong, maxlong, minlat, maxlat
3395 //
3396 // e.g. .p cmd plmap globe 0 360 -90 90
3397 //--------------------------------------------------------------------------
3398 
3399 static int
3400 plmapCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp,
3401  int argc, const char *argv[] )
3402 {
3403  PLFLT minlong, maxlong, minlat, maxlat;
3404  PLINT transform;
3405  PLINT idxname;
3406 
3407  return_code = TCL_OK;
3408  if ( argc < 6 || argc > 7 )
3409  {
3410  Tcl_AppendResult( interp, "bogus syntax for plmap, see doc.",
3411  (char *) NULL );
3412  return TCL_ERROR;
3413  }
3414 
3415  if ( argc == 6 )
3416  {
3417  transform = 0;
3418  idxname = 1;
3419  transform_name = NULL;
3420  minlong = atof( argv[2] );
3421  maxlong = atof( argv[3] );
3422  minlat = atof( argv[4] );
3423  maxlat = atof( argv[5] );
3424  }
3425  else
3426  {
3427  transform = 1;
3428  idxname = 2;
3429  minlong = atof( argv[3] );
3430  maxlong = atof( argv[4] );
3431  minlat = atof( argv[5] );
3432  maxlat = atof( argv[6] );
3433 
3434  tcl_interp = interp;
3435  transform_name = argv[1];
3436  if ( strlen( transform_name ) == 0 )
3437  {
3438  idxname = 1;
3439  }
3440  }
3441 
3442  if ( transform && idxname == 2 )
3443  {
3444  plmap( &mapform, argv[idxname], minlong, maxlong, minlat, maxlat );
3445  }
3446  else
3447  {
3448  // No transformation given
3449  plmap( NULL, argv[idxname], minlong, maxlong, minlat, maxlat );
3450  }
3451 
3452  plflush();
3453  return return_code;
3454 }
3455 
3456 //--------------------------------------------------------------------------
3457 // plmeridiansCmd
3458 //
3459 // Processes plmeridians Tcl command.
3460 // C version takes:
3461 // dlong, dlat, minlong, maxlong, minlat, maxlat
3462 //
3463 // e.g. .p cmd plmeridians 1 ...
3464 //--------------------------------------------------------------------------
3465 
3466 static int
3467 plmeridiansCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp,
3468  int argc, const char *argv[] )
3469 {
3470  PLFLT dlong, dlat, minlong, maxlong, minlat, maxlat;
3471  PLINT transform;
3472 
3473  return_code = TCL_OK;
3474 
3475  if ( argc < 7 || argc > 8 )
3476  {
3477  Tcl_AppendResult( interp, "bogus syntax for plmeridians, see doc.",
3478  (char *) NULL );
3479  return TCL_ERROR;
3480  }
3481 
3482  if ( argc == 7 )
3483  {
3484  transform = 0;
3485  transform_name = NULL;
3486  dlong = atof( argv[1] );
3487  dlat = atof( argv[2] );
3488  minlong = atof( argv[3] );
3489  maxlong = atof( argv[4] );
3490  minlat = atof( argv[5] );
3491  maxlat = atof( argv[6] );
3492  }
3493  else
3494  {
3495  dlong = atof( argv[2] );
3496  dlat = atof( argv[3] );
3497  minlong = atof( argv[4] );
3498  maxlong = atof( argv[5] );
3499  minlat = atof( argv[6] );
3500  maxlat = atof( argv[7] );
3501 
3502  transform = 1;
3503  tcl_interp = interp;
3504  transform_name = argv[1];
3505  if ( strlen( transform_name ) == 0 )
3506  {
3507  transform = 0;
3508  }
3509  }
3510 
3511  if ( transform )
3512  {
3513  plmeridians( &mapform, dlong, dlat, minlong, maxlong, minlat, maxlat );
3514  }
3515  else
3516  {
3517  plmeridians( NULL, dlong, dlat, minlong, maxlong, minlat, maxlat );
3518  }
3519 
3520  plflush();
3521  return TCL_OK;
3522 }
3523 
3524 static Tcl_Interp *tcl_xform_interp = 0;
3525 static char *tcl_xform_procname = 0;
3526 static const char *tcl_xform_template =
3527 #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION < 5
3528  "set result [%s ${_##_x} ${_##_y}] ; set _##_x [lindex $result 0] ; set _##_y [lindex $result 1]"
3529 #else
3530  "set result [%s ${_##_x} ${_##_y}] ; lassign $result _##_x _##_y"
3531 #endif
3532 ;
3533 
3534 static char *tcl_xform_code = 0;
3535 
3536 static void
3538 {
3539  Tcl_Obj *objx, *objy;
3540  int code;
3541  double dx, dy;
3542 
3543 // Set Tcl x to x
3544  objx = Tcl_NewDoubleObj( x );
3545  Tcl_IncrRefCount( objx );
3546  Tcl_SetVar2Ex( tcl_xform_interp,
3547  "_##_x", NULL, objx, 0 );
3548  Tcl_DecrRefCount( objx );
3549 
3550 // Set Tcl y to y
3551  objy = Tcl_NewDoubleObj( y );
3552  Tcl_IncrRefCount( objy );
3553  Tcl_SetVar2Ex( tcl_xform_interp,
3554  "_##_y", NULL, objy, 0 );
3555  Tcl_DecrRefCount( objy );
3556 
3557 // printf( "objx=%x objy=%x\n", objx, objy );
3558 
3559 // printf( "Evaluating code: %s\n", tcl_xform_code );
3560 
3561 // Call identified Tcl proc. Forget data, Tcl can use namespaces and custom
3562 // procs to manage transmission of the custom client data.
3563 // Proc should return a two element list which is xt yt.
3564  code = Tcl_Eval( tcl_xform_interp, tcl_xform_code );
3565 
3566  if ( code != TCL_OK )
3567  {
3568  printf( "Unable to evaluate Tcl-side coordinate transform.\n" );
3569  printf( "code = %d\n", code );
3570  printf( "Error result: %s\n", Tcl_GetStringResult( tcl_xform_interp ) );
3571  return;
3572  }
3573 
3574  objx = Tcl_GetVar2Ex( tcl_xform_interp, "_##_x", NULL, 0 );
3575  objy = Tcl_GetVar2Ex( tcl_xform_interp, "_##_y", NULL, 0 );
3576 
3577 // In case PLFLT != double, we have to make sure we perform the extraction in
3578 // a safe manner.
3579  if ( Tcl_GetDoubleFromObj( tcl_xform_interp, objx, &dx ) != TCL_OK ||
3580  Tcl_GetDoubleFromObj( tcl_xform_interp, objy, &dy ) != TCL_OK )
3581  {
3582  printf( "Unable to extract Tcl results.\n" );
3583  return;
3584  }
3585 
3586  *xt = dx;
3587  *yt = dy;
3588 }
3589 
3590 //--------------------------------------------------------------------------
3591 // plstransform
3592 //
3593 // Implement Tcl-side global coordinate transformation setting/restoring API.
3594 //--------------------------------------------------------------------------
3595 
3596 static int
3597 plstransformCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp,
3598  int argc, const char *argv[] )
3599 {
3600  if ( argc == 1
3601  || strcmp( argv[1], "NULL" ) == 0 )
3602  {
3603  // The user has requested to clear the transform setting.
3604  plstransform( NULL, NULL );
3605  tcl_xform_interp = 0;
3606  if ( tcl_xform_procname )
3607  {
3608  free( tcl_xform_procname );
3609  tcl_xform_procname = 0;
3610  }
3611  }
3612  else
3613  {
3614  size_t len;
3615 
3616  tcl_xform_interp = interp;
3617  tcl_xform_procname = plstrdup( argv[1] );
3618 
3619  len = strlen( tcl_xform_template ) + strlen( tcl_xform_procname );
3620  tcl_xform_code = malloc( len );
3621  sprintf( tcl_xform_code, tcl_xform_template, tcl_xform_procname );
3622 
3623  plstransform( Tcl_transform, NULL );
3624  }
3625 
3626  return TCL_OK;
3627 }
3628 
3629 //--------------------------------------------------------------------------
3630 // plgriddataCmd
3631 //
3632 // Processes plgriddata Tcl command.
3633 //--------------------------------------------------------------------------
3634 static int
3635 plgriddataCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp,
3636  int argc, const char *argv[] )
3637 {
3638  tclMatrix *arrx, *arry, *arrz, *xcoord, *ycoord, *zvalue;
3639  PLINT pts, nx, ny, alg;
3640  PLFLT optalg;
3641  PLFLT **z;
3642 
3643  double value;
3644  int i, j;
3645 
3646  if ( argc != 9 )
3647  {
3648  Tcl_AppendResult( interp, "wrong # args: see documentation for ",
3649  argv[0], (char *) NULL );
3650  return TCL_ERROR;
3651  }
3652 
3653  arrx = Tcl_GetMatrixPtr( interp, argv[1] );
3654  arry = Tcl_GetMatrixPtr( interp, argv[2] );
3655  arrz = Tcl_GetMatrixPtr( interp, argv[3] );
3656 
3657  xcoord = Tcl_GetMatrixPtr( interp, argv[4] );
3658  ycoord = Tcl_GetMatrixPtr( interp, argv[5] );
3659 
3660  zvalue = Tcl_GetMatrixPtr( interp, argv[6] );
3661 
3662  sscanf( argv[7], "%d", &alg );
3663 
3664  sscanf( argv[8], "%lg", &value ); optalg = (PLFLT) value;
3665 
3666  if ( arrx == NULL || arrx->dim != 1 )
3667  {
3668  Tcl_AppendResult( interp, argv[0], ": argument 1 should be a \
3669 one-dimensional matrix - ", argv[1], (char *) NULL );
3670  return TCL_ERROR;
3671  }
3672  if ( arry == NULL || arry->dim != 1 )
3673  {
3674  Tcl_AppendResult( interp, argv[0], ": argument 2 should be a \
3675 one-dimensional matrix - ", argv[2], (char *) NULL );
3676  return TCL_ERROR;
3677  }
3678  if ( arrz == NULL || arrz->dim != 1 )
3679  {
3680  Tcl_AppendResult( interp, argv[0], ": argument 3 should be a \
3681 one-dimensional matrix - ", argv[3], (char *) NULL );
3682  return TCL_ERROR;
3683  }
3684 
3685  if ( xcoord == NULL || xcoord->dim != 1 )
3686  {
3687  Tcl_AppendResult( interp, argv[0], ": argument 4 should be a \
3688 one-dimensional matrix - ", argv[4], (char *) NULL );
3689  return TCL_ERROR;
3690  }
3691  if ( ycoord == NULL || ycoord->dim != 1 )
3692  {
3693  Tcl_AppendResult( interp, argv[0], ": argument 5 should be a \
3694 one-dimensional matrix - ", argv[5], (char *) NULL );
3695  return TCL_ERROR;
3696  }
3697  if ( zvalue == NULL || zvalue->dim != 2 )
3698  {
3699  Tcl_AppendResult( interp, argv[0], ": argument 6 should be a \
3700 two-dimensional matrix - ", argv[6], (char *) NULL );
3701  return TCL_ERROR;
3702  }
3703 
3704  pts = arrx->n[0];
3705  nx = zvalue->n[0];
3706  ny = zvalue->n[1];
3707 
3708  // convert zvalue to 2d-array so can use standard wrap approach
3709  // from now on in this code.
3710  plAlloc2dGrid( &z, nx, ny );
3711 
3712  // Interpolate the data
3713  plgriddata( arrx->fdata, arry->fdata, arrz->fdata, pts,
3714  xcoord->fdata, nx, ycoord->fdata, ny, z, alg, optalg );
3715 
3716  // Copy the result into the matrix
3717  for ( i = 0; i < nx; i++ )
3718  {
3719  for ( j = 0; j < ny; j++ )
3720  {
3721  zvalue->fdata[j + zvalue->n[1] * i] = z[i][j];
3722  }
3723  }
3724 
3725  plFree2dGrid( z, nx, ny );
3726  return TCL_OK;
3727 }
3728 
3729 //--------------------------------------------------------------------------
3730 // plimageCmd
3731 //
3732 // Processes plimage Tcl command.
3733 //--------------------------------------------------------------------------
3734 static int
3735 plimageCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp,
3736  int argc, const char *argv[] )
3737 {
3738  tclMatrix *zvalue;
3739  PLINT nx, ny;
3740  PLFLT **pidata;
3741  PLFLT xmin, xmax, ymin, ymax, zmin, zmax, Dxmin, Dxmax, Dymin, Dymax;
3742 
3743  double value;
3744  int i, j;
3745 
3746  if ( argc != 12 )
3747  {
3748  Tcl_AppendResult( interp, "wrong # args: see documentation for ",
3749  argv[0], (char *) NULL );
3750  return TCL_ERROR;
3751  }
3752 
3753  zvalue = Tcl_GetMatrixPtr( interp, argv[1] );
3754 
3755  if ( zvalue == NULL || zvalue->dim != 2 )
3756  {
3757  Tcl_AppendResult( interp, argv[0], ": argument 1 should be a \
3758 two-dimensional matrix - ", argv[1], (char *) NULL );
3759  return TCL_ERROR;
3760  }
3761 
3762  sscanf( argv[2], "%lg", &value ); xmin = (PLFLT) value;
3763  sscanf( argv[3], "%lg", &value ); xmax = (PLFLT) value;
3764  sscanf( argv[4], "%lg", &value ); ymin = (PLFLT) value;
3765  sscanf( argv[5], "%lg", &value ); ymax = (PLFLT) value;
3766  sscanf( argv[6], "%lg", &value ); zmin = (PLFLT) value;
3767  sscanf( argv[7], "%lg", &value ); zmax = (PLFLT) value;
3768  sscanf( argv[8], "%lg", &value ); Dxmin = (PLFLT) value;
3769  sscanf( argv[9], "%lg", &value ); Dxmax = (PLFLT) value;
3770  sscanf( argv[10], "%lg", &value ); Dymin = (PLFLT) value;
3771  sscanf( argv[11], "%lg", &value ); Dymax = (PLFLT) value;
3772 
3773  nx = zvalue->n[0];
3774  ny = zvalue->n[1];
3775 
3776  plAlloc2dGrid( &pidata, nx, ny );
3777 
3778  for ( i = 0; i < nx; i++ )
3779  {
3780  for ( j = 0; j < ny; j++ )
3781  {
3782  pidata[i][j] = zvalue->fdata[j + i * ny];
3783  }
3784  }
3785  //
3786  // fprintf(stderr,"nx, ny: %d %d\n", nx, ny);
3787  // fprintf(stderr,"xmin, xmax: %.17g %.17g\n", xmin, xmax);
3788  // fprintf(stderr,"ymin, ymax: %.17g %.17g\n", ymin, ymax);
3789  // fprintf(stderr,"zmin, zmax: %.17g %.17g\n", zmin, zmax);
3790  // fprintf(stderr,"Dxmin, Dxmax: %.17g %.17g\n", Dxmin, Dxmax);
3791  // fprintf(stderr,"Dymin, Dymax: %.17g %.17g\n", Dymin, Dymax);
3792  //
3793 
3794  c_plimage( (const PLFLT * const *) pidata, nx, ny, xmin, xmax, ymin, ymax, zmin, zmax,
3795  Dxmin, Dxmax, Dymin, Dymax );
3796 
3797  plFree2dGrid( pidata, nx, ny );
3798 
3799  return TCL_OK;
3800 }
3801 
3802 //--------------------------------------------------------------------------
3803 // plimagefrCmd
3804 //
3805 // Processes plimagefr Tcl command.
3806 //
3807 // Note:
3808 // Very basic! No user-defined interpolation routines
3809 //--------------------------------------------------------------------------
3810 static int
3811 plimagefrCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp,
3812  int argc, const char *argv[] )
3813 {
3814  tclMatrix *zvalue;
3815  tclMatrix *xg;
3816  tclMatrix *yg;
3817  PLINT nx, ny;
3818  PLFLT **pidata;
3819  PLcGrid2 cgrid2;
3820  PLFLT xmin, xmax, ymin, ymax, zmin, zmax, valuemin, valuemax;
3821 
3822  double value;
3823  int i, j;
3824 
3825  if ( argc != 12 && argc != 10 )
3826  {
3827  Tcl_AppendResult( interp, "wrong # args: see documentation for ",
3828  argv[0], (char *) NULL );
3829  return TCL_ERROR;
3830  }
3831 
3832  zvalue = Tcl_GetMatrixPtr( interp, argv[1] );
3833 
3834  if ( zvalue == NULL || zvalue->dim != 2 )
3835  {
3836  Tcl_AppendResult( interp, argv[0], ": argument 1 should be a \
3837 two-dimensional matrix - ", argv[1], (char *) NULL );
3838  return TCL_ERROR;
3839  }
3840 
3841  xg = NULL;
3842  yg = NULL;
3843  if ( argc == 12 )
3844  {
3845  xg = Tcl_GetMatrixPtr( interp, argv[10] );
3846  yg = Tcl_GetMatrixPtr( interp, argv[11] );
3847 
3848  if ( xg == NULL || xg->dim != 2 )
3849  {
3850  Tcl_AppendResult( interp, argv[0], ": argument 10 should be a \
3851 two-dimensional matrix - ", argv[10], (char *) NULL );
3852  return TCL_ERROR;
3853  }
3854 
3855  if ( yg == NULL || yg->dim != 2 )
3856  {
3857  Tcl_AppendResult( interp, argv[0], ": argument 11 should be a \
3858 two-dimensional matrix - ", argv[11], (char *) NULL );
3859  return TCL_ERROR;
3860  }
3861  }
3862 
3863  sscanf( argv[2], "%lg", &value ); xmin = (PLFLT) value;
3864  sscanf( argv[3], "%lg", &value ); xmax = (PLFLT) value;
3865  sscanf( argv[4], "%lg", &value ); ymin = (PLFLT) value;
3866  sscanf( argv[5], "%lg", &value ); ymax = (PLFLT) value;
3867  sscanf( argv[6], "%lg", &value ); zmin = (PLFLT) value;
3868  sscanf( argv[7], "%lg", &value ); zmax = (PLFLT) value;
3869  sscanf( argv[8], "%lg", &value ); valuemin = (PLFLT) value;
3870  sscanf( argv[9], "%lg", &value ); valuemax = (PLFLT) value;
3871 
3872  nx = zvalue->n[0];
3873  ny = zvalue->n[1];
3874 
3875  plAlloc2dGrid( &pidata, nx, ny );
3876 
3877  for ( i = 0; i < nx; i++ )
3878  {
3879  for ( j = 0; j < ny; j++ )
3880  {
3881  pidata[i][j] = zvalue->fdata[j + i * ny];
3882  }
3883  }
3884 
3885  if ( xg != NULL )
3886  {
3887  plAlloc2dGrid( &cgrid2.xg, nx + 1, ny + 1 );
3888  plAlloc2dGrid( &cgrid2.yg, nx + 1, ny + 1 );
3889 
3890  cgrid2.nx = nx + 1;
3891  cgrid2.ny = ny + 1;
3892  for ( i = 0; i <= nx; i++ )
3893  {
3894  for ( j = 0; j <= ny; j++ )
3895  {
3896  cgrid2.xg[i][j] = xg->fdata[j + i * ( ny + 1 )];
3897  cgrid2.yg[i][j] = yg->fdata[j + i * ( ny + 1 )];
3898  }
3899  }
3900  c_plimagefr( (const PLFLT * const *) pidata, nx, ny, xmin, xmax, ymin, ymax, zmin, zmax,
3901  valuemin, valuemax, pltr2, (void *) &cgrid2 );
3902  }
3903  else
3904  {
3905  c_plimagefr( (const PLFLT * const *) pidata, nx, ny, xmin, xmax, ymin, ymax, zmin, zmax,
3906  valuemin, valuemax, pltr0, NULL );
3907  }
3908 
3909  plFree2dGrid( pidata, nx, ny );
3910  if ( xg != NULL )
3911  {
3912  plFree2dGrid( cgrid2.xg, nx + 1, ny + 1 );
3913  plFree2dGrid( cgrid2.yg, nx + 1, ny + 1 );
3914  }
3915 
3916  return TCL_OK;
3917 }
3918 
3919 //--------------------------------------------------------------------------
3920 // plstripcCmd
3921 //
3922 // Processes plstripc Tcl command.
3923 //--------------------------------------------------------------------------
3924 static int
3925 plstripcCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp,
3926  int argc, const char *argv[] )
3927 {
3928  int i;
3929  int id;
3930  const char *xspec;
3931  const char *yspec;
3932  const char *idName;
3933  tclMatrix *colMat;
3934  tclMatrix *styleMat;
3935  double value;
3936  int ivalue;
3937  PLFLT xmin, xmax, xjump, ymin, ymax, xlpos, ylpos;
3938  PLBOOL y_ascl, acc;
3939  PLINT colbox, collab;
3940  PLINT colline[4], styline[4];
3941  int nlegend;
3942  const char **legline;
3943  const char *labx;
3944  const char *laby;
3945  const char *labtop;
3946  char idvalue[20];
3947 
3948  if ( argc != 21 )
3949  {
3950  Tcl_AppendResult( interp, "wrong # args: see documentation for ",
3951  argv[0], (char *) NULL );
3952  return TCL_ERROR;
3953  }
3954 
3955  colMat = Tcl_GetMatrixPtr( interp, argv[15] );
3956  styleMat = Tcl_GetMatrixPtr( interp, argv[16] );
3957 
3958  if ( colMat == NULL || colMat->dim != 1 || colMat->idata == NULL )
3959  {
3960  Tcl_AppendResult( interp, argv[0], ": argument 15 should be a \
3961 one-dimensional integer matrix - ", argv[15], (char *) NULL );
3962  return TCL_ERROR;
3963  }
3964 
3965  if ( styleMat == NULL || styleMat->dim != 1 || styleMat->idata == NULL )
3966  {
3967  Tcl_AppendResult( interp, argv[0], ": argument 16 should be a \
3968 one-dimensional integer matrix - ", argv[16], (char *) NULL );
3969  return TCL_ERROR;
3970  }
3971 
3972  idName = argv[1];
3973  xspec = argv[2];
3974  yspec = argv[3];
3975 
3976  sscanf( argv[4], "%lg", &value ); xmin = (PLFLT) value;
3977  sscanf( argv[5], "%lg", &value ); xmax = (PLFLT) value;
3978  sscanf( argv[6], "%lg", &value ); xjump = (PLFLT) value;
3979  sscanf( argv[7], "%lg", &value ); ymin = (PLFLT) value;
3980  sscanf( argv[8], "%lg", &value ); ymax = (PLFLT) value;
3981  sscanf( argv[9], "%lg", &value ); xlpos = (PLFLT) value;
3982  sscanf( argv[10], "%lg", &value ); ylpos = (PLFLT) value;
3983  sscanf( argv[11], "%d", &ivalue ); y_ascl = (PLBOOL) ivalue;
3984  sscanf( argv[12], "%d", &ivalue ); acc = (PLBOOL) ivalue;
3985  sscanf( argv[13], "%d", &ivalue ); colbox = ivalue;
3986  sscanf( argv[14], "%d", &ivalue ); collab = ivalue;
3987 
3988  labx = argv[18];
3989  laby = argv[19];
3990  labtop = argv[20];
3991 
3992  for ( i = 0; i < 4; i++ )
3993  {
3994  colline[i] = colMat->idata[i];
3995  styline[i] = styleMat->idata[i];
3996  }
3997 
3998  if ( Tcl_SplitList( interp, argv[17], &nlegend, &legline ) != TCL_OK )
3999  {
4000  return TCL_ERROR;
4001  }
4002  if ( nlegend < 4 )
4003  {
4004  Tcl_AppendResult( interp, argv[0], ": argument 18 should be a \
4005 list of at least four items - ", argv[17], (char *) NULL );
4006  return TCL_ERROR;
4007  }
4008 
4009  c_plstripc( &id, xspec, yspec,
4010  xmin, xmax, xjump, ymin, ymax,
4011  xlpos, ylpos,
4012  y_ascl, acc,
4013  colbox, collab,
4014  colline, styline, legline,
4015  labx, laby, labtop );
4016 
4017  sprintf( idvalue, "%d", id );
4018  Tcl_SetVar( interp, idName, idvalue, 0 );
4019 
4020  Tcl_Free( (char *) legline );
4021 
4022  return TCL_OK;
4023 }
4024 
4025 //--------------------------------------------------------------------------
4026 // labelform
4027 //
4028 // Call the Tcl custom label function.
4029 //--------------------------------------------------------------------------
4030 
4031 static Tcl_Obj *label_objs[4] = { NULL, NULL, NULL, NULL }; // Arguments for the Tcl procedure
4032  // that handles the custom labels
4033 
4034 void
4035 labelform( PLINT axis, PLFLT value, char *string, PLINT string_length, PLPointer PL_UNUSED( data ) )
4036 {
4037  int objc;
4038 
4039  label_objs[1] = Tcl_NewIntObj( axis );
4040  label_objs[2] = Tcl_NewDoubleObj( (double) value );
4041 
4042  Tcl_IncrRefCount( label_objs[1] );
4043  Tcl_IncrRefCount( label_objs[2] );
4044 
4045  // Call the Tcl procedure and store the result
4046  objc = 3;
4047  if ( label_objs[3] != NULL )
4048  {
4049  objc = 4;
4050  }
4051 
4052  return_code = Tcl_EvalObjv( tcl_interp, objc, label_objs, 0 );
4053 
4054  if ( return_code != TCL_OK )
4055  {
4056  strncpy( string, "ERROR", (size_t) string_length );
4057  }
4058  else
4059  {
4060  strncpy( string, Tcl_GetStringResult( tcl_interp ), (size_t) string_length );
4061  }
4062 
4063  Tcl_DecrRefCount( label_objs[1] );
4064  Tcl_DecrRefCount( label_objs[2] );
4065 }
4066 
4067 //--------------------------------------------------------------------------
4068 // plslabelfuncCmd
4069 //
4070 // Processes plslabelfunc Tcl command.
4071 // C version takes:
4072 // function, data
4073 // (data argument is optional)
4074 //--------------------------------------------------------------------------
4075 
4076 static int
4077 plslabelfuncCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp,
4078  int argc, const char *argv[] )
4079 {
4080  if ( argc < 2 || argc > 3 )
4081  {
4082  Tcl_AppendResult( interp, "bogus syntax for plslabelfunc, see doc.",
4083  (char *) NULL );
4084  return TCL_ERROR;
4085  }
4086 
4087  tcl_interp = interp;
4088 
4089  if ( label_objs[0] != NULL )
4090  {
4091  Tcl_DecrRefCount( label_objs[0] );
4092  }
4093  if ( label_objs[3] != NULL )
4094  {
4095  Tcl_DecrRefCount( label_objs[3] );
4096  label_objs[3] = NULL;
4097  }
4098 
4099  if ( strlen( argv[1] ) == 0 )
4100  {
4101  plslabelfunc( NULL, NULL );
4102  return TCL_OK;
4103  }
4104  else
4105  {
4106  plslabelfunc( labelform, NULL );
4107  label_objs[0] = Tcl_NewStringObj( argv[1], (int) strlen( argv[1] ) );
4108  Tcl_IncrRefCount( label_objs[0] );
4109  }
4110 
4111  if ( argc == 3 )
4112  {
4113  label_objs[3] = Tcl_NewStringObj( argv[2], (int) strlen( argv[2] ) ); // Should change with Tcl_Obj interface
4114  Tcl_IncrRefCount( label_objs[3] );
4115  }
4116  else
4117  {
4118  label_objs[3] = NULL;
4119  }
4120 
4121  return TCL_OK;
4122 }
4123 
4124 //--------------------------------------------------------------------------
4125 // pllegendCmd
4126 //
4127 // Processes pllegend Tcl command.
4128 // C version takes:
4129 // function, data
4130 // (data argument is optional)
4131 //--------------------------------------------------------------------------
4132 
4133 static int *argv_to_ints( Tcl_Interp *interp, const char *list_numbers, int *number )
4134 {
4135  int i, retcode;
4136  int *array;
4137  Tcl_Obj *list;
4138  Tcl_Obj *elem;
4139 
4140  list = Tcl_NewStringObj( list_numbers, ( -1 ) );
4141 
4142  retcode = Tcl_ListObjLength( interp, list, number );
4143  if ( retcode != TCL_OK || ( *number ) == 0 )
4144  {
4145  *number = 0;
4146  return NULL;
4147  }
4148  else
4149  {
4150  array = (int *) malloc( sizeof ( int ) * (size_t) ( *number ) );
4151  for ( i = 0; i < ( *number ); i++ )
4152  {
4153  Tcl_ListObjIndex( interp, list, i, &elem );
4154  Tcl_GetIntFromObj( interp, elem, &array[i] );
4155  }
4156  }
4157  return array;
4158 }
4159 
4160 static double *argv_to_doubles( Tcl_Interp *interp, const char *list_numbers, int *number )
4161 {
4162  int i, retcode;
4163  double *array;
4164  Tcl_Obj *list;
4165  Tcl_Obj *elem;
4166 
4167  list = Tcl_NewStringObj( list_numbers, ( -1 ) );
4168 
4169  retcode = Tcl_ListObjLength( interp, list, number );
4170  if ( retcode != TCL_OK || ( *number ) == 0 )
4171  {
4172  *number = 0;
4173  return NULL;
4174  }
4175  else
4176  {
4177  array = (double *) malloc( sizeof ( double ) * (size_t) ( *number ) );
4178  for ( i = 0; i < ( *number ); i++ )
4179  {
4180  Tcl_ListObjIndex( interp, list, i, &elem );
4181  Tcl_GetDoubleFromObj( interp, elem, &array[i] );
4182  }
4183  }
4184  return array;
4185 }
4186 
4187 static char **argv_to_chars( Tcl_Interp *interp, const char *list_strings, int *number )
4188 {
4189  int i, retcode;
4190  char **array;
4191  char *string;
4192  int length;
4193  int idx;
4194  Tcl_Obj *list;
4195  Tcl_Obj *elem;
4196 
4197  list = Tcl_NewStringObj( list_strings, ( -1 ) );
4198 
4199  retcode = Tcl_ListObjLength( interp, list, number );
4200  if ( retcode != TCL_OK || ( *number ) == 0 )
4201  {
4202  *number = 0;
4203  return NULL;
4204  }
4205  else
4206  {
4207  array = (char **) malloc( sizeof ( char* ) * (size_t) ( *number ) );
4208  array[0] = (char *) malloc( sizeof ( char ) * ( strlen( list_strings ) + 1 ) );
4209  idx = 0;
4210  for ( i = 0; i < ( *number ); i++ )
4211  {
4212  Tcl_ListObjIndex( interp, list, i, &elem );
4213  string = Tcl_GetStringFromObj( elem, &length );
4214 
4215  array[i] = array[0] + idx;
4216  strncpy( array[i], string, (size_t) length );
4217  idx += length + 1;
4218  array[0][idx - 1] = '\0';
4219  }
4220  }
4221  return array;
4222 }
4223 
4224 static int
4225 pllegendCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp,
4226  int argc, const char *argv[] )
4227 {
4228  PLFLT legend_width, legend_height;
4229  PLFLT x, y, plot_width;
4230  PLINT opt, position;
4231  PLINT bg_color, bb_color, bb_style;
4232  PLINT nrow, ncolumn;
4233  PLINT nlegend;
4234  PLINT *opt_array;
4235  PLFLT text_offset, text_scale, text_spacing, text_justification;
4236  PLINT *text_colors;
4237  PLINT *box_colors, *box_patterns;
4238  PLFLT *box_scales;
4239  PLINT *line_colors, *line_styles;
4240  PLFLT *box_line_widths, *line_widths;
4241  PLINT *symbol_colors, *symbol_numbers;
4242  PLFLT *symbol_scales;
4243  char **text;
4244  char **symbols;
4245 
4246  int number_opts;
4247  int number_texts;
4248  int dummy;
4249  double value;
4250 
4251  Tcl_Obj *data[2];
4252 
4253  if ( argc != 29 )
4254  {
4255  Tcl_AppendResult( interp, "bogus syntax for pllegend, see doc.",
4256  (char *) NULL );
4257  return TCL_ERROR;
4258  }
4259 
4260  sscanf( argv[1], "%d", &opt );
4261  sscanf( argv[2], "%d", &position );
4262  sscanf( argv[3], "%lg", &value ); x = (PLFLT) value;
4263  sscanf( argv[4], "%lg", &value ); y = (PLFLT) value;
4264  sscanf( argv[5], "%lg", &value ); plot_width = (PLFLT) value;
4265  sscanf( argv[6], "%d", &bg_color );
4266  sscanf( argv[7], "%d", &bb_color );
4267  sscanf( argv[8], "%d", &bb_style );
4268  sscanf( argv[9], "%d", &nrow );
4269  sscanf( argv[10], "%d", &ncolumn );
4270  opt_array = argv_to_ints( interp, argv[11], &number_opts );
4271  sscanf( argv[12], "%lg", &value ); text_offset = (PLFLT) value;
4272  sscanf( argv[13], "%lg", &value ); text_scale = (PLFLT) value;
4273  sscanf( argv[14], "%lg", &value ); text_spacing = (PLFLT) value;
4274  sscanf( argv[15], "%lg", &value ); text_justification = (PLFLT) value;
4275 
4276  text_colors = argv_to_ints( interp, argv[16], &dummy );
4277  text = argv_to_chars( interp, argv[17], &number_texts );
4278  box_colors = argv_to_ints( interp, argv[18], &dummy );
4279  box_patterns = argv_to_ints( interp, argv[19], &dummy );
4280  box_scales = argv_to_doubles( interp, argv[20], &dummy );
4281  box_line_widths = argv_to_doubles( interp, argv[21], &dummy );
4282  line_colors = argv_to_ints( interp, argv[22], &dummy );
4283  line_styles = argv_to_ints( interp, argv[23], &dummy );
4284  line_widths = argv_to_doubles( interp, argv[24], &dummy );
4285  symbol_colors = argv_to_ints( interp, argv[25], &dummy );
4286  symbol_scales = argv_to_doubles( interp, argv[26], &dummy );
4287  symbol_numbers = argv_to_ints( interp, argv[27], &dummy );
4288  symbols = argv_to_chars( interp, argv[28], &dummy );
4289 
4290  nlegend = MIN( number_opts, number_texts );
4291 
4292  c_pllegend( &legend_width, &legend_height,
4293  opt, position, x, y, plot_width,
4294  bg_color, bb_color, bb_style,
4295  nrow, ncolumn,
4296  nlegend, opt_array,
4297  text_offset, text_scale, text_spacing,
4298  text_justification,
4299  text_colors, (const char * const *) text,
4300  box_colors, box_patterns,
4301  box_scales, box_line_widths,
4302  line_colors, line_styles,
4303  line_widths,
4304  symbol_colors, symbol_scales,
4305  symbol_numbers, (const char * const *) symbols );
4306 
4307  if ( opt_array != NULL )
4308  free( opt_array );
4309  if ( text_colors != NULL )
4310  free( text_colors );
4311  if ( text != NULL )
4312  {
4313  free( text[0] );
4314  free( text );
4315  }
4316  if ( box_colors != NULL )
4317  free( box_colors );
4318  if ( box_patterns != NULL )
4319  free( box_patterns );
4320  if ( box_scales != NULL )
4321  free( box_scales );
4322  if ( box_line_widths != NULL )
4323  free( box_line_widths );
4324  if ( line_colors != NULL )
4325  free( line_colors );
4326  if ( line_styles != NULL )
4327  free( line_styles );
4328  if ( line_widths != NULL )
4329  free( line_widths );
4330  if ( symbol_colors != NULL )
4331  free( symbol_colors );
4332  if ( symbol_scales != NULL )
4333  free( symbol_scales );
4334  if ( symbol_numbers != NULL )
4335  free( symbol_numbers );
4336  if ( symbols != NULL )
4337  {
4338  free( symbols[0] );
4339  free( symbols );
4340  }
4341 
4342  data[0] = Tcl_NewDoubleObj( legend_width );
4343  data[1] = Tcl_NewDoubleObj( legend_height );
4344  Tcl_SetObjResult( interp, Tcl_NewListObj( 2, data ) );
4345 
4346  return TCL_OK;
4347 }
4348 
4349 //--------------------------------------------------------------------------
4350 // plcolorbarCmd
4351 //
4352 // Processes plcolorbar Tcl command.
4353 //--------------------------------------------------------------------------
4354 
4355 static int
4356 plcolorbarCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp,
4357  int argc, const char *argv[] )
4358 {
4359  PLFLT colorbar_width, colorbar_height;
4360  PLINT opt, position;
4361  PLFLT x, y, x_length, y_length;
4362  PLINT bg_color, bb_color, bb_style;
4363  PLFLT low_cap_color, high_cap_color;
4364  PLINT cont_color;
4365  PLFLT cont_width;
4366  PLINT n_label_opts;
4367  PLINT n_labels;
4368  PLINT *label_opts;
4369  char **labels;
4370  PLINT n_axis_opts;
4371  PLINT n_ticks;
4372  PLINT n_sub_ticks;
4373  PLINT n_axes;
4374  char **axis_opts;
4375  PLFLT *ticks;
4376  PLINT *sub_ticks;
4377  Tcl_Obj *list_vectors;
4378  int n_vectors;
4379  PLINT *vector_sizes;
4380  PLFLT **vector_values;
4381  int retcode;
4382  int i;
4383  int length;
4384  Tcl_Obj *vector;
4385  tclMatrix *vectorPtr;
4386 
4387  double value;
4388 
4389  Tcl_Obj *data[2];
4390 
4391  if ( argc != 20 )
4392  {
4393  Tcl_AppendResult( interp, "bogus syntax for plcolorbar, see doc.",
4394  (char *) NULL );
4395  return TCL_ERROR;
4396  }
4397 
4398  // The first two arguments, the resulting width and height are returned via Tcl_SetObjResult()
4399  sscanf( argv[1], "%d", &opt );
4400  sscanf( argv[2], "%d", &position );
4401  sscanf( argv[3], "%lg", &value ); x = (PLFLT) value;
4402  sscanf( argv[4], "%lg", &value ); y = (PLFLT) value;
4403  sscanf( argv[5], "%lg", &value ); x_length = (PLFLT) value;
4404  sscanf( argv[6], "%lg", &value ); y_length = (PLFLT) value;
4405  sscanf( argv[7], "%d", &bg_color );
4406  sscanf( argv[8], "%d", &bb_color );
4407  sscanf( argv[9], "%d", &bb_style );
4408  sscanf( argv[10], "%lg", &value ); low_cap_color = (PLFLT) value;
4409  sscanf( argv[11], "%lg", &value ); high_cap_color = (PLFLT) value;
4410  sscanf( argv[12], "%d", &cont_color );
4411  sscanf( argv[13], "%lg", &value ); cont_width = (PLFLT) value;
4412  label_opts = argv_to_ints( interp, argv[14], &n_label_opts );
4413  labels = argv_to_chars( interp, argv[15], &n_labels );
4414  axis_opts = argv_to_chars( interp, argv[16], &n_axis_opts );
4415  ticks = argv_to_doubles( interp, argv[17], &n_ticks );
4416  sub_ticks = argv_to_ints( interp, argv[18], &n_sub_ticks );
4417  list_vectors = Tcl_NewStringObj( argv[19], ( -1 ) );
4418 
4419  // Check consistency
4420  if ( n_label_opts != n_labels )
4421  {
4422  Tcl_AppendResult( interp, "number of label options must equal number of labels.",
4423  (char *) NULL );
4424  return TCL_ERROR;
4425  }
4426  if ( n_axis_opts != n_ticks || n_axis_opts != n_sub_ticks )
4427  {
4428  Tcl_AppendResult( interp, "number of axis, tick and subtick options must be equal.",
4429  (char *) NULL );
4430  return TCL_ERROR;
4431  }
4432  n_axes = n_axis_opts;
4433 
4434  retcode = Tcl_ListObjLength( interp, list_vectors, &n_vectors );
4435  if ( retcode != TCL_OK || n_vectors == 0 )
4436  {
4437  Tcl_AppendResult( interp, "malformed list of vectors or no vector at all.",
4438  (char *) NULL );
4439  return TCL_ERROR;
4440  }
4441  else
4442  {
4443  vector_sizes = (int *) malloc( sizeof ( int ) * (size_t) n_vectors );
4444  vector_values = (PLFLT **) malloc( sizeof ( PLFLT * ) * (size_t) n_vectors );
4445  for ( i = 0; i < n_vectors; i++ )
4446  {
4447  Tcl_ListObjIndex( interp, list_vectors, i, &vector );
4448  vectorPtr = Tcl_GetMatrixPtr( interp, Tcl_GetStringFromObj( vector, &length ) );
4449  if ( vectorPtr == NULL || vectorPtr->dim != 1 )
4450  {
4451  Tcl_AppendResult( interp, "element in list of vectors is not a vector.",
4452  (char *) NULL );
4453  return TCL_ERROR;
4454  }
4455  vector_sizes[i] = vectorPtr->n[0];
4456  vector_values[i] = vectorPtr->fdata;
4457  }
4458  }
4459 
4460  c_plcolorbar( &colorbar_width, &colorbar_height,
4461  opt, position, x, y,
4462  x_length, y_length,
4463  bg_color, bb_color, bb_style,
4464  low_cap_color, high_cap_color,
4465  cont_color, cont_width,
4466  n_labels, label_opts, (const char * const *) labels,
4467  n_axes, (const char * const *) axis_opts,
4468  ticks, sub_ticks,
4469  vector_sizes, (const PLFLT * const *) vector_values );
4470 
4471  if ( label_opts != NULL )
4472  free( label_opts );
4473  if ( labels != NULL )
4474  {
4475  free( labels[0] );
4476  free( labels );
4477  }
4478  if ( axis_opts != NULL )
4479  {
4480  free( axis_opts[0] );
4481  free( axis_opts );
4482  }
4483  if ( ticks != NULL )
4484  free( ticks );
4485  if ( sub_ticks != NULL )
4486  free( sub_ticks );
4487  if ( vector_values != NULL )
4488  {
4489  free( vector_sizes );
4490  free( vector_values );
4491  }
4492 
4493  Tcl_DecrRefCount( list_vectors );
4494 
4495  data[0] = Tcl_NewDoubleObj( colorbar_width );
4496  data[1] = Tcl_NewDoubleObj( colorbar_height );
4497  Tcl_SetObjResult( interp, Tcl_NewListObj( 2, data ) );
4498 
4499  return TCL_OK;
4500 }