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