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