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