PLplot  5.11.0
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Macros
tclAPI.c
Go to the documentation of this file.
1 // Copyright 1994, 1995
2 // Maurice LeBrun mjl@dino.ph.utexas.edu
3 // Institute for Fusion Studies University of Texas at Austin
4 //
5 // Copyright (C) 2004 Joao Cardoso
6 // Copyright (C) 2004 Andrew Ross
7 //
8 // This file is part of PLplot.
9 //
10 // PLplot is free software; you can redistribute it and/or modify
11 // it under the terms of the GNU Library General Public License as published
12 // by the Free Software Foundation; either version 2 of the License, or
13 // (at your option) any later version.
14 //
15 // PLplot is distributed in the hope that it will be useful,
16 // but WITHOUT ANY WARRANTY; without even the implied warranty of
17 // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 // GNU Library General Public License for more details.
19 //
20 // You should have received a copy of the GNU Library General Public License
21 // along with PLplot; if not, write to the Free Software
22 // Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
23 //
24 //--------------------------------------------------------------------------
25 //
26 // This module implements a Tcl command set for interpretively calling
27 // PLplot functions. Each Tcl command is responsible for calling the
28 // appropriate underlying function in the C API. Can be used with any
29 // driver, in principle.
30 //
31 
32 #include "plplotP.h"
33 #include "pltcl.h"
34 #include "plplot_parameters.h"
35 #ifndef __WIN32__
36 #ifdef PL_HAVE_UNISTD_H
37 #include <unistd.h>
38 #endif
39 #else
40 #ifdef _MSC_VER
41 #define getcwd _getcwd
42 #include <direct.h>
43 #endif
44 #endif
45 
46 #include "tclgen.h"
47 
48 // PLplot/Tcl API handlers. Prototypes must come before Cmds struct
49 
50 static int loopbackCmd( ClientData, Tcl_Interp *, int, const char ** );
51 static int plcolorbarCmd( ClientData, Tcl_Interp *, int, const char ** );
52 static int plcontCmd( ClientData, Tcl_Interp *, int, const char ** );
53 static int pllegendCmd( ClientData, Tcl_Interp *, int, const char ** );
54 static int plmeshCmd( ClientData, Tcl_Interp *, int, const char ** );
55 static int plmeshcCmd( ClientData, Tcl_Interp *, int, const char ** );
56 static int plot3dCmd( ClientData, Tcl_Interp *, int, const char ** );
57 static int plot3dcCmd( ClientData, Tcl_Interp *, int, const char ** );
58 static int plsurf3dCmd( ClientData, Tcl_Interp *, int, const char ** );
59 static int 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 PLDLLIMPORT 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( 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 || argc > 7 )
3724  {
3725  Tcl_AppendResult( interp, "bogus syntax for plmap, see doc.",
3726  (char *) NULL );
3727  return TCL_ERROR;
3728  }
3729 
3730  if ( argc == 6 )
3731  {
3732  transform = 0;
3733  idxname = 1;
3734  transform_name = NULL;
3735  minlong = atof( argv[2] );
3736  maxlong = atof( argv[3] );
3737  minlat = atof( argv[4] );
3738  maxlat = atof( argv[5] );
3739  }
3740  else
3741  {
3742  transform = 1;
3743  idxname = 2;
3744  minlong = atof( argv[3] );
3745  maxlong = atof( argv[4] );
3746  minlat = atof( argv[5] );
3747  maxlat = atof( argv[6] );
3748 
3749  tcl_interp = interp;
3750  transform_name = argv[1];
3751  if ( strlen( transform_name ) == 0 )
3752  {
3753  transform = 0;
3754  }
3755  }
3756 
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  return return_code;
3769 }
3770 
3771 //--------------------------------------------------------------------------
3772 // GetEntries
3773 //
3774 // Return the list of plot entries (either from a list of from a matrix)
3775 //--------------------------------------------------------------------------
3776 
3777 static int *
3778 GetEntries( Tcl_Interp *interp, const char *string, int *n )
3779 {
3780  tclMatrix *mati;
3781  int argc;
3782  int *entries;
3783  char **argv;
3784  int i;
3785 
3786  mati = Tcl_GetMatrixPtr( interp, string );
3787  if ( mati == NULL )
3788  {
3789  if ( Tcl_SplitList( interp, string, n, (const char ***) &argv ) == TCL_OK )
3790  {
3791  entries = (int *) malloc( ( *n ) * sizeof ( int ) );
3792  for ( i = 0; i < *n; i++ )
3793  {
3794  entries[i] = atoi( argv[i] );
3795  }
3796  Tcl_Free( (char *) argv );
3797  }
3798  }
3799  else
3800  {
3801  *n = mati->n[0];
3802  entries = (int *) malloc( ( *n ) * sizeof ( int ) );
3803  for ( i = 0; i < *n; i++ )
3804  {
3805  entries[i] = mati->idata[i];
3806  }
3807  }
3808 
3809  return entries;
3810 }
3811 
3812 //--------------------------------------------------------------------------
3813 // plmapfillCmd
3814 //
3815 // Processes plmapfill Tcl command.
3816 // C version takes:
3817 // transform_proc, string, minlong, maxlong, minlat, maxlat, entries, nentries
3818 //
3819 // e.g. .p cmd plmapfill globe 0 360 -90 90
3820 //--------------------------------------------------------------------------
3821 
3822 static int
3823 plmapfillCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp,
3824  int argc, const char *argv[] )
3825 {
3826  PLFLT minlong, maxlong, minlat, maxlat;
3827  PLINT transform;
3828  PLINT idxname;
3829  PLINT *entries;
3830  PLINT nentries;
3831 
3832  return_code = TCL_OK;
3833  if ( argc < 6 || argc > 8 )
3834  {
3835  Tcl_AppendResult( interp, "bogus syntax for plmapfill, see doc.",
3836  (char *) NULL );
3837  return TCL_ERROR;
3838  }
3839 
3840  nentries = 0;
3841  entries = NULL;
3842 
3843  switch ( argc )
3844  {
3845  case 6: // No transform, no plotentries
3846  transform = 0;
3847  idxname = 1;
3848  transform_name = NULL;
3849  minlong = atof( argv[2] );
3850  maxlong = atof( argv[3] );
3851  minlat = atof( argv[4] );
3852  maxlat = atof( argv[5] );
3853  break;
3854 
3855  case 7: // Transform OR plotentries, not both - ambiguity
3856  // Heuristic: transformation name is either a name or empty. Therefore, if
3857  // the first argument is a number, a list of plotentries is given (not a matrix)
3858 
3859  transform = 1;
3860  idxname = 2;
3861  minlong = atof( argv[3] );
3862  maxlong = atof( argv[4] );
3863  minlat = atof( argv[5] );
3864  maxlat = atof( argv[6] );
3865 
3866  tcl_interp = interp;
3867  transform_name = argv[1];
3868  if ( strlen( transform_name ) == 0 )
3869  {
3870  transform = 0;
3871  }
3872  else
3873  {
3874  if ( Tcl_GetDouble( interp, argv[2], &minlong ) == TCL_OK )
3875  {
3876  transform = 0;
3877  minlong = atof( argv[2] );
3878  maxlong = atof( argv[3] );
3879  minlat = atof( argv[4] );
3880  maxlat = atof( argv[5] );
3881  idxname = 1;
3882  entries = GetEntries( interp, argv[6], &nentries );
3883  }
3884  }
3885  break;
3886 
3887  case 8: // Transform, plotentries
3888  transform = 1;
3889  entries = GetEntries( interp, argv[7], &nentries );
3890  idxname = 2;
3891  minlong = atof( argv[3] );
3892  maxlong = atof( argv[4] );
3893  minlat = atof( argv[5] );
3894  maxlat = atof( argv[6] );
3895 
3896  tcl_interp = interp;
3897  transform_name = argv[1];
3898  if ( strlen( transform_name ) == 0 )
3899  {
3900  transform = 0;
3901  }
3902  }
3903 
3904  if ( transform && idxname == 2 )
3905  {
3906  plmapfill( &mapform, argv[idxname], minlong, maxlong, minlat, maxlat, entries, nentries );
3907  }
3908  else
3909  {
3910  // No transformation given
3911  plmapfill( NULL, argv[idxname], minlong, maxlong, minlat, maxlat, entries, nentries );
3912  }
3913 
3914  if ( entries != NULL )
3915  {
3916  free( entries );
3917  }
3918 
3919  plflush();
3920  return return_code;
3921 }
3922 
3923 //--------------------------------------------------------------------------
3924 // plmaplineCmd
3925 //
3926 // Processes plmapline Tcl command.
3927 // C version takes:
3928 // transform_proc, string, minlong, maxlong, minlat, maxlat, entries, nentries
3929 //
3930 // e.g. .p cmd plmapline globe 0 360 -90 90
3931 //--------------------------------------------------------------------------
3932 
3933 static int
3934 plmaplineCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp,
3935  int argc, const char *argv[] )
3936 {
3937  PLFLT minlong, maxlong, minlat, maxlat;
3938  PLINT transform;
3939  PLINT idxname;
3940  PLINT *entries;
3941  PLINT nentries;
3942 
3943  return_code = TCL_OK;
3944  if ( argc < 6 || argc > 8 )
3945  {
3946  Tcl_AppendResult( interp, "bogus syntax for plmapline, see doc.",
3947  (char *) NULL );
3948  return TCL_ERROR;
3949  }
3950 
3951  nentries = 0;
3952  entries = NULL;
3953 
3954  switch ( argc )
3955  {
3956  case 6: // No transform, no plotentries
3957  transform = 0;
3958  idxname = 1;
3959  transform_name = NULL;
3960  minlong = atof( argv[2] );
3961  maxlong = atof( argv[3] );
3962  minlat = atof( argv[4] );
3963  maxlat = atof( argv[5] );
3964  break;
3965 
3966  case 7: // Transform OR plotentries, not both - ambiguity
3967  // Heuristic: transformation name is either a name or empty. Therefore, if
3968  // the first argument is a number, a list of plotentries is given (not a matrix)
3969 
3970  transform = 1;
3971  idxname = 2;
3972  minlong = atof( argv[3] );
3973  maxlong = atof( argv[4] );
3974  minlat = atof( argv[5] );
3975  maxlat = atof( argv[6] );
3976 
3977  tcl_interp = interp;
3978  transform_name = argv[1];
3979  if ( strlen( transform_name ) == 0 )
3980  {
3981  transform = 0;
3982  }
3983  else
3984  {
3985  if ( Tcl_GetDouble( interp, argv[2], &minlong ) == TCL_OK )
3986  {
3987  transform = 0;
3988  minlong = atof( argv[2] );
3989  maxlong = atof( argv[3] );
3990  minlat = atof( argv[4] );
3991  maxlat = atof( argv[5] );
3992  idxname = 1;
3993  entries = GetEntries( interp, argv[6], &nentries );
3994  }
3995  }
3996  break;
3997 
3998  case 8: // Transform, plotentries
3999  transform = 1;
4000  entries = GetEntries( interp, argv[7], &nentries );
4001  idxname = 2;
4002  minlong = atof( argv[3] );
4003  maxlong = atof( argv[4] );
4004  minlat = atof( argv[5] );
4005  maxlat = atof( argv[6] );
4006 
4007  tcl_interp = interp;
4008  transform_name = argv[1];
4009  if ( strlen( transform_name ) == 0 )
4010  {
4011  transform = 0;
4012  }
4013  }
4014 
4015  if ( transform && idxname == 2 )
4016  {
4017  plmapline( &mapform, argv[idxname], minlong, maxlong, minlat, maxlat, entries, nentries );
4018  }
4019  else
4020  {
4021  // No transformation given
4022  plmapline( NULL, argv[idxname], minlong, maxlong, minlat, maxlat, entries, nentries );
4023  }
4024 
4025  if ( entries != NULL )
4026  {
4027  free( entries );
4028  }
4029 
4030  plflush();
4031  return return_code;
4032 }
4033 
4034 //--------------------------------------------------------------------------
4035 // plmapstringCmd
4036 //
4037 // Processes plmapstring Tcl command.
4038 // C version takes:
4039 // transform_proc, string, minlong, maxlong, minlat, maxlat, entries, nentries
4040 //
4041 // e.g. .p cmd plmapstring globe "Town" 0 360 -90 90
4042 //--------------------------------------------------------------------------
4043 
4044 static int
4045 plmapstringCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp,
4046  int argc, const char *argv[] )
4047 {
4048  PLFLT minlong, maxlong, minlat, maxlat;
4049  PLINT transform;
4050  PLINT idxname;
4051  PLINT *entries;
4052  PLINT nentries;
4053  const char *string;
4054 
4055  return_code = TCL_OK;
4056  if ( argc < 7 || argc > 9 )
4057  {
4058  Tcl_AppendResult( interp, "bogus syntax for plmapstring, see doc.",
4059  (char *) NULL );
4060  return TCL_ERROR;
4061  }
4062 
4063  nentries = 0;
4064  entries = NULL;
4065 
4066  switch ( argc )
4067  {
4068  case 7: // No transform, no plotentries
4069  transform = 0;
4070  idxname = 1;
4071  transform_name = NULL;
4072  string = argv[2];
4073  minlong = atof( argv[3] );
4074  maxlong = atof( argv[4] );
4075  minlat = atof( argv[5] );
4076  maxlat = atof( argv[6] );
4077  break;
4078 
4079  case 8: // Transform OR plotentries, not both - ambiguity
4080  // Heuristic: transformation name is either a name or empty. Therefore, if
4081  // the first argument is a number, a list of plotentries is given (not a matrix)
4082 
4083  transform = 1;
4084  idxname = 2;
4085  string = argv[3];
4086  minlong = atof( argv[4] );
4087  maxlong = atof( argv[5] );
4088  minlat = atof( argv[6] );
4089  maxlat = atof( argv[7] );
4090 
4091  tcl_interp = interp;
4092  transform_name = argv[1];
4093  if ( strlen( transform_name ) == 0 )
4094  {
4095  transform = 0;
4096  }
4097  else
4098  {
4099  if ( Tcl_GetDouble( interp, argv[3], &minlong ) == TCL_OK )
4100  {
4101  transform = 0;
4102  idxname = 1;
4103  string = argv[2];
4104  minlong = atof( argv[3] );
4105  maxlong = atof( argv[4] );
4106  minlat = atof( argv[5] );
4107  maxlat = atof( argv[6] );
4108  entries = GetEntries( interp, argv[7], &nentries );
4109  }
4110  }
4111  break;
4112 
4113  case 9: // Transform, plotentries
4114  transform = 1;
4115  entries = GetEntries( interp, argv[8], &nentries );
4116  idxname = 2;
4117  string = argv[3];
4118  minlong = atof( argv[4] );
4119  maxlong = atof( argv[5] );
4120  minlat = atof( argv[6] );
4121  maxlat = atof( argv[7] );
4122 
4123  tcl_interp = interp;
4124  transform_name = argv[1];
4125  if ( strlen( transform_name ) == 0 )
4126  {
4127  transform = 0;
4128  }
4129  }
4130 
4131  if ( transform && idxname == 2 )
4132  {
4133  plmapstring( &mapform, argv[idxname], string, minlong, maxlong, minlat, maxlat, entries, nentries );
4134  }
4135  else
4136  {
4137  // No transformation given
4138  plmapstring( NULL, argv[idxname], string, minlong, maxlong, minlat, maxlat, entries, nentries );
4139  }
4140 
4141  if ( entries != NULL )
4142  {
4143  free( entries );
4144  }
4145 
4146  plflush();
4147  return return_code;
4148 }
4149 
4150 //--------------------------------------------------------------------------
4151 // plmaptexCmd
4152 //
4153 // Processes plmaptex Tcl command.
4154 // C version takes:
4155 // transform_proc, string, minlong, maxlong, minlat, maxlat, entries, nentries
4156 //
4157 // e.g. .p cmd plmaptex globe "Town" 0 360 -90 90
4158 //--------------------------------------------------------------------------
4159 
4160 static int
4161 plmaptexCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp,
4162  int argc, const char *argv[] )
4163 {
4164  PLFLT minlong, maxlong, minlat, maxlat;
4165  PLFLT dx, dy, just;
4166  PLINT transform;
4167  PLINT idxname;
4168  PLINT *entries;
4169  PLINT nentries;
4170  const char *text;
4171 
4172  return_code = TCL_OK;
4173  if ( argc < 10 || argc > 12 )
4174  {
4175  Tcl_AppendResult( interp, "bogus syntax for plmaptex, see doc.",
4176  (char *) NULL );
4177  return TCL_ERROR;
4178  }
4179 
4180  nentries = 0;
4181  entries = NULL;
4182 
4183  switch ( argc )
4184  {
4185  case 10: // No transform, no plotentries
4186  transform = 0;
4187  idxname = 1;
4188  transform_name = NULL;
4189  dx = atof( argv[2] );
4190  dy = atof( argv[3] );
4191  just = atof( argv[4] );
4192  text = argv[5];
4193  minlong = atof( argv[6] );
4194  maxlong = atof( argv[7] );
4195  minlat = atof( argv[8] );
4196  maxlat = atof( argv[9] );
4197  break;
4198 
4199  case 11: // Transform OR plotentries, not both - ambiguity
4200  // Heuristic: transformation name is either a name or empty. Therefore, if
4201  // the first argument is a number, a list of plotentries is given (not a matrix)
4202 
4203  transform = 1;
4204  idxname = 2;
4205  dx = atof( argv[3] );
4206  dy = atof( argv[4] );
4207  just = atof( argv[5] );
4208  text = argv[6];
4209  minlong = atof( argv[7] );
4210  maxlong = atof( argv[8] );
4211  minlat = atof( argv[9] );
4212  maxlat = atof( argv[10] );
4213 
4214  tcl_interp = interp;
4215  transform_name = argv[1];
4216  if ( strlen( transform_name ) == 0 )
4217  {
4218  transform = 0;
4219  }
4220  else
4221  {
4222  if ( Tcl_GetDouble( interp, argv[2], &minlong ) == TCL_OK )
4223  {
4224  transform = 0;
4225  idxname = 1;
4226  dx = atof( argv[2] );
4227  dy = atof( argv[3] );
4228  just = atof( argv[4] );
4229  text = argv[5];
4230  minlong = atof( argv[6] );
4231  maxlong = atof( argv[7] );
4232  minlat = atof( argv[8] );
4233  maxlat = atof( argv[9] );
4234  entries = GetEntries( interp, argv[10], &nentries );
4235  }
4236  }
4237  break;
4238 
4239  case 12: // Transform, plotentries
4240  transform = 1;
4241  entries = GetEntries( interp, argv[11], &nentries );
4242  idxname = 2;
4243  dx = atof( argv[3] );
4244  dy = atof( argv[4] );
4245  just = atof( argv[5] );
4246  text = argv[6];
4247  minlong = atof( argv[7] );
4248  maxlong = atof( argv[8] );
4249  minlat = atof( argv[9] );
4250  maxlat = atof( argv[10] );
4251 
4252  tcl_interp = interp;
4253  transform_name = argv[1];
4254  if ( strlen( transform_name ) == 0 )
4255  {
4256  transform = 0;
4257  }
4258  }
4259 
4260  if ( transform && idxname == 2 )
4261  {
4262  plmaptex( &mapform, argv[idxname], dx, dy, just, text, minlong, maxlong, minlat, maxlat, entries[0] );
4263  }
4264  else
4265  {
4266  // No transformation given
4267  plmaptex( NULL, argv[idxname], dx, dy, just, text, minlong, maxlong, minlat, maxlat, entries[0] );
4268  }
4269 
4270  if ( entries != NULL )
4271  {
4272  free( entries );
4273  }
4274 
4275  plflush();
4276  return return_code;
4277 }
4278 
4279 //--------------------------------------------------------------------------
4280 // plmeridiansCmd
4281 //
4282 // Processes plmeridians Tcl command.
4283 // C version takes:
4284 // dlong, dlat, minlong, maxlong, minlat, maxlat
4285 //
4286 // e.g. .p cmd plmeridians 1 ...
4287 //--------------------------------------------------------------------------
4288 
4289 static int
4290 plmeridiansCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp,
4291  int argc, const char *argv[] )
4292 {
4293  PLFLT dlong, dlat, minlong, maxlong, minlat, maxlat;
4294  PLINT transform;
4295 
4296  return_code = TCL_OK;
4297 
4298  if ( argc < 7 || argc > 8 )
4299  {
4300  Tcl_AppendResult( interp, "bogus syntax for plmeridians, see doc.",
4301  (char *) NULL );
4302  return TCL_ERROR;
4303  }
4304 
4305  if ( argc == 7 )
4306  {
4307  transform = 0;
4308  transform_name = NULL;
4309  dlong = atof( argv[1] );
4310  dlat = atof( argv[2] );
4311  minlong = atof( argv[3] );
4312  maxlong = atof( argv[4] );
4313  minlat = atof( argv[5] );
4314  maxlat = atof( argv[6] );
4315  }
4316  else
4317  {
4318  dlong = atof( argv[2] );
4319  dlat = atof( argv[3] );
4320  minlong = atof( argv[4] );
4321  maxlong = atof( argv[5] );
4322  minlat = atof( argv[6] );
4323  maxlat = atof( argv[7] );
4324 
4325  transform = 1;
4326  tcl_interp = interp;
4327  transform_name = argv[1];
4328  if ( strlen( transform_name ) == 0 )
4329  {
4330  transform = 0;
4331  }
4332  }
4333 
4334  if ( transform )
4335  {
4336  plmeridians( &mapform, dlong, dlat, minlong, maxlong, minlat, maxlat );
4337  }
4338  else
4339  {
4340  plmeridians( NULL, dlong, dlat, minlong, maxlong, minlat, maxlat );
4341  }
4342 
4343  plflush();
4344  return TCL_OK;
4345 }
4346 
4347 static Tcl_Interp *tcl_xform_interp = 0;
4348 static char *tcl_xform_procname = 0;
4349 static const char *tcl_xform_template =
4350 #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION < 5
4351  "set result [%s ${_##_x} ${_##_y}] ; set _##_x [lindex $result 0] ; set _##_y [lindex $result 1]"
4352 #else
4353  "set result [%s ${_##_x} ${_##_y}] ; lassign $result _##_x _##_y"
4354 #endif
4355 ;
4356 
4357 static char *tcl_xform_code = 0;
4358 
4359 static void
4361 {
4362  Tcl_Obj *objx, *objy;
4363  int code;
4364  double dx, dy;
4365 
4366 // Set Tcl x to x
4367  objx = Tcl_NewDoubleObj( x );
4368  Tcl_IncrRefCount( objx );
4369  Tcl_SetVar2Ex( tcl_xform_interp,
4370  "_##_x", NULL, objx, 0 );
4371  Tcl_DecrRefCount( objx );
4372 
4373 // Set Tcl y to y
4374  objy = Tcl_NewDoubleObj( y );
4375  Tcl_IncrRefCount( objy );
4376  Tcl_SetVar2Ex( tcl_xform_interp,
4377  "_##_y", NULL, objy, 0 );
4378  Tcl_DecrRefCount( objy );
4379 
4380 // printf( "objx=%x objy=%x\n", objx, objy );
4381 
4382 // printf( "Evaluating code: %s\n", tcl_xform_code );
4383 
4384 // Call identified Tcl proc. Forget data, Tcl can use namespaces and custom
4385 // procs to manage transmission of the custom client data.
4386 // Proc should return a two element list which is xt yt.
4387  code = Tcl_Eval( tcl_xform_interp, tcl_xform_code );
4388 
4389  if ( code != TCL_OK )
4390  {
4391  printf( "Unable to evaluate Tcl-side coordinate transform.\n" );
4392  printf( "code = %d\n", code );
4393  printf( "Error result: %s\n", Tcl_GetStringResult( tcl_xform_interp ) );
4394  return;
4395  }
4396 
4397  objx = Tcl_GetVar2Ex( tcl_xform_interp, "_##_x", NULL, 0 );
4398  objy = Tcl_GetVar2Ex( tcl_xform_interp, "_##_y", NULL, 0 );
4399 
4400 // In case PLFLT != double, we have to make sure we perform the extraction in
4401 // a safe manner.
4402  if ( Tcl_GetDoubleFromObj( tcl_xform_interp, objx, &dx ) != TCL_OK ||
4403  Tcl_GetDoubleFromObj( tcl_xform_interp, objy, &dy ) != TCL_OK )
4404  {
4405  printf( "Unable to extract Tcl results.\n" );
4406  return;
4407  }
4408 
4409  *xt = dx;
4410  *yt = dy;
4411 }
4412 
4413 //--------------------------------------------------------------------------
4414 // plstransform
4415 //
4416 // Implement Tcl-side global coordinate transformation setting/restoring API.
4417 //--------------------------------------------------------------------------
4418 
4419 static int
4420 plstransformCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp,
4421  int argc, const char *argv[] )
4422 {
4423  if ( argc == 1
4424  || strcmp( argv[1], "NULL" ) == 0 )
4425  {
4426  // The user has requested to clear the transform setting.
4427  plstransform( NULL, NULL );
4428  tcl_xform_interp = 0;
4429  if ( tcl_xform_procname )
4430  {
4431  free( tcl_xform_procname );
4432  tcl_xform_procname = 0;
4433  }
4434  }
4435  else
4436  {
4437  size_t len;
4438 
4439  tcl_xform_interp = interp;
4440  tcl_xform_procname = plstrdup( argv[1] );
4441 
4442  len = strlen( tcl_xform_template ) + strlen( tcl_xform_procname );
4443  tcl_xform_code = malloc( len );
4444  sprintf( tcl_xform_code, tcl_xform_template, tcl_xform_procname );
4445 
4446  plstransform( Tcl_transform, NULL );
4447  }
4448 
4449  return TCL_OK;
4450 }
4451 
4452 //--------------------------------------------------------------------------
4453 // plgriddataCmd
4454 //
4455 // Processes plgriddata Tcl command.
4456 //--------------------------------------------------------------------------
4457 static int
4458 plgriddataCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp,
4459  int argc, const char *argv[] )
4460 {
4461  tclMatrix *arrx, *arry, *arrz, *xcoord, *ycoord, *zvalue;
4462  PLINT pts, nx, ny, alg;
4463  PLFLT optalg;
4464  PLFLT **z;
4465 
4466  double value;
4467  int i, j;
4468 
4469  if ( argc != 9 )
4470  {
4471  Tcl_AppendResult( interp, "wrong # args: see documentation for ",
4472  argv[0], (char *) NULL );
4473  return TCL_ERROR;
4474  }
4475 
4476  arrx = Tcl_GetMatrixPtr( interp, argv[1] );
4477  arry = Tcl_GetMatrixPtr( interp, argv[2] );
4478  arrz = Tcl_GetMatrixPtr( interp, argv[3] );
4479 
4480  xcoord = Tcl_GetMatrixPtr( interp, argv[4] );
4481  ycoord = Tcl_GetMatrixPtr( interp, argv[5] );
4482 
4483  zvalue = Tcl_GetMatrixPtr( interp, argv[6] );
4484 
4485  sscanf( argv[7], "%d", &alg );
4486 
4487  sscanf( argv[8], "%lg", &value ); optalg = (PLFLT) value;
4488 
4489  if ( arrx == NULL || arrx->dim != 1 )
4490  {
4491  Tcl_AppendResult( interp, argv[0], ": argument 1 should be a \
4492 one-dimensional matrix - ", argv[1], (char *) NULL );
4493  return TCL_ERROR;
4494  }
4495  if ( arry == NULL || arry->dim != 1 )
4496  {
4497  Tcl_AppendResult( interp, argv[0], ": argument 2 should be a \
4498 one-dimensional matrix - ", argv[2], (char *) NULL );
4499  return TCL_ERROR;
4500  }
4501  if ( arrz == NULL || arrz->dim != 1 )
4502  {
4503  Tcl_AppendResult( interp, argv[0], ": argument 3 should be a \
4504 one-dimensional matrix - ", argv[3], (char *) NULL );
4505  return TCL_ERROR;
4506  }
4507 
4508  if ( xcoord == NULL || xcoord->dim != 1 )
4509  {
4510  Tcl_AppendResult( interp, argv[0], ": argument 4 should be a \
4511 one-dimensional matrix - ", argv[4], (char *) NULL );
4512  return TCL_ERROR;
4513  }
4514  if ( ycoord == NULL || ycoord->dim != 1 )
4515  {
4516  Tcl_AppendResult( interp, argv[0], ": argument 5 should be a \
4517 one-dimensional matrix - ", argv[5], (char *) NULL );
4518  return TCL_ERROR;
4519  }
4520  if ( zvalue == NULL || zvalue->dim != 2 )
4521  {
4522  Tcl_AppendResult( interp, argv[0], ": argument 6 should be a \
4523 two-dimensional matrix - ", argv[6], (char *) NULL );
4524  return TCL_ERROR;
4525  }
4526 
4527  pts = arrx->n[0];
4528  nx = zvalue->n[0];
4529  ny = zvalue->n[1];
4530 
4531  // convert zvalue to 2d-array so can use standard wrap approach
4532  // from now on in this code.
4533  plAlloc2dGrid( &z, nx, ny );
4534 
4535  // Interpolate the data
4536  plgriddata( arrx->fdata, arry->fdata, arrz->fdata, pts,
4537  xcoord->fdata, nx, ycoord->fdata, ny, z, alg, optalg );
4538 
4539  // Copy the result into the matrix
4540  for ( i = 0; i < nx; i++ )
4541  {
4542  for ( j = 0; j < ny; j++ )
4543  {
4544  zvalue->fdata[j + zvalue->n[1] * i] = z[i][j];
4545  }
4546  }
4547 
4548  plFree2dGrid( z, nx, ny );
4549  return TCL_OK;
4550 }
4551 
4552 //--------------------------------------------------------------------------
4553 // plimageCmd
4554 //
4555 // Processes plimage Tcl command.
4556 //--------------------------------------------------------------------------
4557 static int
4558 plimageCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp,
4559  int argc, const char *argv[] )
4560 {
4561  tclMatrix *zvalue;
4562  PLINT nx, ny;
4563  PLFLT **pidata;
4564  PLFLT xmin, xmax, ymin, ymax, zmin, zmax, Dxmin, Dxmax, Dymin, Dymax;
4565 
4566  double value;
4567  int i, j;
4568 
4569  if ( argc != 12 )
4570  {
4571  Tcl_AppendResult( interp, "wrong # args: see documentation for ",
4572  argv[0], (char *) NULL );
4573  return TCL_ERROR;
4574  }
4575 
4576  zvalue = Tcl_GetMatrixPtr( interp, argv[1] );
4577 
4578  if ( zvalue == NULL || zvalue->dim != 2 )
4579  {
4580  Tcl_AppendResult( interp, argv[0], ": argument 1 should be a \
4581 two-dimensional matrix - ", argv[1], (char *) NULL );
4582  return TCL_ERROR;
4583  }
4584 
4585  sscanf( argv[2], "%lg", &value ); xmin = (PLFLT) value;
4586  sscanf( argv[3], "%lg", &value ); xmax = (PLFLT) value;
4587  sscanf( argv[4], "%lg", &value ); ymin = (PLFLT) value;
4588  sscanf( argv[5], "%lg", &value ); ymax = (PLFLT) value;
4589  sscanf( argv[6], "%lg", &value ); zmin = (PLFLT) value;
4590  sscanf( argv[7], "%lg", &value ); zmax = (PLFLT) value;
4591  sscanf( argv[8], "%lg", &value ); Dxmin = (PLFLT) value;
4592  sscanf( argv[9], "%lg", &value ); Dxmax = (PLFLT) value;
4593  sscanf( argv[10], "%lg", &value ); Dymin = (PLFLT) value;
4594  sscanf( argv[11], "%lg", &value ); Dymax = (PLFLT) value;
4595 
4596  nx = zvalue->n[0];
4597  ny = zvalue->n[1];
4598 
4599  plAlloc2dGrid( &pidata, nx, ny );
4600 
4601  for ( i = 0; i < nx; i++ )
4602  {
4603  for ( j = 0; j < ny; j++ )
4604  {
4605  pidata[i][j] = zvalue->fdata[j + i * ny];
4606  }
4607  }
4608  //
4609  // fprintf(stderr,"nx, ny: %d %d\n", nx, ny);
4610  // fprintf(stderr,"xmin, xmax: %.17g %.17g\n", xmin, xmax);
4611  // fprintf(stderr,"ymin, ymax: %.17g %.17g\n", ymin, ymax);
4612  // fprintf(stderr,"zmin, zmax: %.17g %.17g\n", zmin, zmax);
4613  // fprintf(stderr,"Dxmin, Dxmax: %.17g %.17g\n", Dxmin, Dxmax);
4614  // fprintf(stderr,"Dymin, Dymax: %.17g %.17g\n", Dymin, Dymax);
4615  //
4616 
4617  c_plimage( (const PLFLT * const *) pidata, nx, ny, xmin, xmax, ymin, ymax, zmin, zmax,
4618  Dxmin, Dxmax, Dymin, Dymax );
4619 
4620  plFree2dGrid( pidata, nx, ny );
4621 
4622  return TCL_OK;
4623 }
4624 
4625 //--------------------------------------------------------------------------
4626 // plimagefrCmd
4627 //
4628 // Processes plimagefr Tcl command.
4629 //
4630 // Note:
4631 // Very basic! No user-defined interpolation routines
4632 //--------------------------------------------------------------------------
4633 static int
4634 plimagefrCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp,
4635  int argc, const char *argv[] )
4636 {
4637  tclMatrix *zvalue;
4638  tclMatrix *xg;
4639  tclMatrix *yg;
4640  PLINT nx, ny;
4641  PLFLT **pidata;
4642  PLcGrid2 cgrid2;
4643  PLFLT xmin, xmax, ymin, ymax, zmin, zmax, valuemin, valuemax;
4644 
4645  double value;
4646  int i, j;
4647 
4648  if ( argc != 12 && argc != 10 )
4649  {
4650  Tcl_AppendResult( interp, "wrong # args: see documentation for ",
4651  argv[0], (char *) NULL );
4652  return TCL_ERROR;
4653  }
4654 
4655  zvalue = Tcl_GetMatrixPtr( interp, argv[1] );
4656 
4657  if ( zvalue == NULL || zvalue->dim != 2 )
4658  {
4659  Tcl_AppendResult( interp, argv[0], ": argument 1 should be a \
4660 two-dimensional matrix - ", argv[1], (char *) NULL );
4661  return TCL_ERROR;
4662  }
4663 
4664  xg = NULL;
4665  yg = NULL;
4666  if ( argc == 12 )
4667  {
4668  xg = Tcl_GetMatrixPtr( interp, argv[10] );
4669  yg = Tcl_GetMatrixPtr( interp, argv[11] );
4670 
4671  if ( xg == NULL || xg->dim != 2 )
4672  {
4673  Tcl_AppendResult( interp, argv[0], ": argument 10 should be a \
4674 two-dimensional matrix - ", argv[10], (char *) NULL );
4675  return TCL_ERROR;
4676  }
4677 
4678  if ( yg == NULL || yg->dim != 2 )
4679  {
4680  Tcl_AppendResult( interp, argv[0], ": argument 11 should be a \
4681 two-dimensional matrix - ", argv[11], (char *) NULL );
4682  return TCL_ERROR;
4683  }
4684  }
4685 
4686  sscanf( argv[2], "%lg", &value ); xmin = (PLFLT) value;
4687  sscanf( argv[3], "%lg", &value ); xmax = (PLFLT) value;
4688  sscanf( argv[4], "%lg", &value ); ymin = (PLFLT) value;
4689  sscanf( argv[5], "%lg", &value ); ymax = (PLFLT) value;
4690  sscanf( argv[6], "%lg", &value ); zmin = (PLFLT) value;
4691  sscanf( argv[7], "%lg", &value ); zmax = (PLFLT) value;
4692  sscanf( argv[8], "%lg", &value ); valuemin = (PLFLT) value;
4693  sscanf( argv[9], "%lg", &value ); valuemax = (PLFLT) value;
4694 
4695  nx = zvalue->n[0];
4696  ny = zvalue->n[1];
4697 
4698  plAlloc2dGrid( &pidata, nx, ny );
4699 
4700  for ( i = 0; i < nx; i++ )
4701  {
4702  for ( j = 0; j < ny; j++ )
4703  {
4704  pidata[i][j] = zvalue->fdata[j + i * ny];
4705  }
4706  }
4707 
4708  if ( xg != NULL )
4709  {
4710  plAlloc2dGrid( &cgrid2.xg, nx + 1, ny + 1 );
4711  plAlloc2dGrid( &cgrid2.yg, nx + 1, ny + 1 );
4712 
4713  cgrid2.nx = nx + 1;
4714  cgrid2.ny = ny + 1;
4715  for ( i = 0; i <= nx; i++ )
4716  {
4717  for ( j = 0; j <= ny; j++ )
4718  {
4719  cgrid2.xg[i][j] = xg->fdata[j + i * ( ny + 1 )];
4720  cgrid2.yg[i][j] = yg->fdata[j + i * ( ny + 1 )];
4721  }
4722  }
4723  c_plimagefr( (const PLFLT * const *) pidata, nx, ny, xmin, xmax, ymin, ymax, zmin, zmax,
4724  valuemin, valuemax, pltr2, (void *) &cgrid2 );
4725  }
4726  else
4727  {
4728  c_plimagefr( (const PLFLT * const *) pidata, nx, ny, xmin, xmax, ymin, ymax, zmin, zmax,
4729  valuemin, valuemax, pltr0, NULL );
4730  }
4731 
4732  plFree2dGrid( pidata, nx, ny );
4733  if ( xg != NULL )
4734  {
4735  plFree2dGrid( cgrid2.xg, nx + 1, ny + 1 );
4736  plFree2dGrid( cgrid2.yg, nx + 1, ny + 1 );
4737  }
4738 
4739  return TCL_OK;
4740 }
4741 
4742 //--------------------------------------------------------------------------
4743 // plstripcCmd
4744 //
4745 // Processes plstripc Tcl command.
4746 //--------------------------------------------------------------------------
4747 static int
4748 plstripcCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp,
4749  int argc, const char *argv[] )
4750 {
4751  int i;
4752  int id;
4753  const char *xspec;
4754  const char *yspec;
4755  const char *idName;
4756  tclMatrix *colMat;
4757  tclMatrix *styleMat;
4758  double value;
4759  int ivalue;
4760  PLFLT xmin, xmax, xjump, ymin, ymax, xlpos, ylpos;
4761  PLBOOL y_ascl, acc;
4762  PLINT colbox, collab;
4763  PLINT colline[4], styline[4];
4764  int nlegend;
4765  const char **legline;
4766  const char *labx;
4767  const char *laby;
4768  const char *labtop;
4769  char idvalue[20];
4770 
4771  if ( argc != 21 )
4772  {
4773  Tcl_AppendResult( interp, "wrong # args: see documentation for ",
4774  argv[0], (char *) NULL );
4775  return TCL_ERROR;
4776  }
4777 
4778  colMat = Tcl_GetMatrixPtr( interp, argv[15] );
4779  styleMat = Tcl_GetMatrixPtr( interp, argv[16] );
4780 
4781  if ( colMat == NULL || colMat->dim != 1 || colMat->idata == NULL )
4782  {
4783  Tcl_AppendResult( interp, argv[0], ": argument 15 should be a \
4784 one-dimensional integer matrix - ", argv[15], (char *) NULL );
4785  return TCL_ERROR;
4786  }
4787 
4788  if ( styleMat == NULL || styleMat->dim != 1 || styleMat->idata == NULL )
4789  {
4790  Tcl_AppendResult( interp, argv[0], ": argument 16 should be a \
4791 one-dimensional integer matrix - ", argv[16], (char *) NULL );
4792  return TCL_ERROR;
4793  }
4794 
4795  idName = argv[1];
4796  xspec = argv[2];
4797  yspec = argv[3];
4798 
4799  sscanf( argv[4], "%lg", &value ); xmin = (PLFLT) value;
4800  sscanf( argv[5], "%lg", &value ); xmax = (PLFLT) value;
4801  sscanf( argv[6], "%lg", &value ); xjump = (PLFLT) value;
4802  sscanf( argv[7], "%lg", &value ); ymin = (PLFLT) value;
4803  sscanf( argv[8], "%lg", &value ); ymax = (PLFLT) value;
4804  sscanf( argv[9], "%lg", &value ); xlpos = (PLFLT) value;
4805  sscanf( argv[10], "%lg", &value ); ylpos = (PLFLT) value;
4806  sscanf( argv[11], "%d", &ivalue ); y_ascl = (PLBOOL) ivalue;
4807  sscanf( argv[12], "%d", &ivalue ); acc = (PLBOOL) ivalue;
4808  sscanf( argv[13], "%d", &ivalue ); colbox = ivalue;
4809  sscanf( argv[14], "%d", &ivalue ); collab = ivalue;
4810 
4811  labx = argv[18];
4812  laby = argv[19];
4813  labtop = argv[20];
4814 
4815  for ( i = 0; i < 4; i++ )
4816  {
4817  colline[i] = colMat->idata[i];
4818  styline[i] = styleMat->idata[i];
4819  }
4820 
4821  if ( Tcl_SplitList( interp, argv[17], &nlegend, &legline ) != TCL_OK )
4822  {
4823  return TCL_ERROR;
4824  }
4825  if ( nlegend < 4 )
4826  {
4827  Tcl_AppendResult( interp, argv[0], ": argument 18 should be a \
4828 list of at least four items - ", argv[17], (char *) NULL );
4829  return TCL_ERROR;
4830  }
4831 
4832  c_plstripc( &id, xspec, yspec,
4833  xmin, xmax, xjump, ymin, ymax,
4834  xlpos, ylpos,
4835  y_ascl, acc,
4836  colbox, collab,
4837  colline, styline, legline,
4838  labx, laby, labtop );
4839 
4840  sprintf( idvalue, "%d", id );
4841  Tcl_SetVar( interp, idName, idvalue, 0 );
4842 
4843  Tcl_Free( (char *) legline );
4844 
4845  return TCL_OK;
4846 }
4847 
4848 //--------------------------------------------------------------------------
4849 // labelform
4850 //
4851 // Call the Tcl custom label function.
4852 //--------------------------------------------------------------------------
4853 
4854 static Tcl_Obj *label_objs[4] = { NULL, NULL, NULL, NULL }; // Arguments for the Tcl procedure
4855  // that handles the custom labels
4856 
4857 void
4858 labelform( PLINT axis, PLFLT value, char *string, PLINT string_length, PLPointer PL_UNUSED( data ) )
4859 {
4860  int objc;
4861 
4862  label_objs[1] = Tcl_NewIntObj( axis );
4863  label_objs[2] = Tcl_NewDoubleObj( (double) value );
4864 
4865  Tcl_IncrRefCount( label_objs[1] );
4866  Tcl_IncrRefCount( label_objs[2] );
4867 
4868  // Call the Tcl procedure and store the result
4869  objc = 3;
4870  if ( label_objs[3] != NULL )
4871  {
4872  objc = 4;
4873  }
4874 
4875  return_code = Tcl_EvalObjv( tcl_interp, objc, label_objs, 0 );
4876 
4877  if ( return_code != TCL_OK )
4878  {
4879  strncpy( string, "ERROR", (size_t) string_length );
4880  }
4881  else
4882  {
4883  strncpy( string, Tcl_GetStringResult( tcl_interp ), (size_t) string_length );
4884  }
4885 
4886  Tcl_DecrRefCount( label_objs[1] );
4887  Tcl_DecrRefCount( label_objs[2] );
4888 }
4889 
4890 //--------------------------------------------------------------------------
4891 // plslabelfuncCmd
4892 //
4893 // Processes plslabelfunc Tcl command.
4894 // C version takes:
4895 // function, data
4896 // (data argument is optional)
4897 //--------------------------------------------------------------------------
4898 
4899 static int
4900 plslabelfuncCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp,
4901  int argc, const char *argv[] )
4902 {
4903  if ( argc < 2 || argc > 3 )
4904  {
4905  Tcl_AppendResult( interp, "bogus syntax for plslabelfunc, see doc.",
4906  (char *) NULL );
4907  return TCL_ERROR;
4908  }
4909 
4910  tcl_interp = interp;
4911 
4912  if ( label_objs[0] != NULL )
4913  {
4914  Tcl_DecrRefCount( label_objs[0] );
4915  }
4916  if ( label_objs[3] != NULL )
4917  {
4918  Tcl_DecrRefCount( label_objs[3] );
4919  label_objs[3] = NULL;
4920  }
4921 
4922  if ( strlen( argv[1] ) == 0 )
4923  {
4924  plslabelfunc( NULL, NULL );
4925  return TCL_OK;
4926  }
4927  else
4928  {
4929  plslabelfunc( labelform, NULL );
4930  label_objs[0] = Tcl_NewStringObj( argv[1], (int) strlen( argv[1] ) );
4931  Tcl_IncrRefCount( label_objs[0] );
4932  }
4933 
4934  if ( argc == 3 )
4935  {
4936  label_objs[3] = Tcl_NewStringObj( argv[2], (int) strlen( argv[2] ) ); // Should change with Tcl_Obj interface
4937  Tcl_IncrRefCount( label_objs[3] );
4938  }
4939  else
4940  {
4941  label_objs[3] = NULL;
4942  }
4943 
4944  return TCL_OK;
4945 }
4946 
4947 //--------------------------------------------------------------------------
4948 // pllegendCmd
4949 //
4950 // Processes pllegend Tcl command.
4951 // C version takes:
4952 // function, data
4953 // (data argument is optional)
4954 //--------------------------------------------------------------------------
4955 
4956 static int *argv_to_ints( Tcl_Interp *interp, const char *list_numbers, int *number )
4957 {
4958  int i, retcode;
4959  int *array;
4960  Tcl_Obj *list;
4961  Tcl_Obj *elem;
4962 
4963  list = Tcl_NewStringObj( list_numbers, ( -1 ) );
4964 
4965  retcode = Tcl_ListObjLength( interp, list, number );
4966  if ( retcode != TCL_OK || ( *number ) == 0 )
4967  {
4968  *number = 0;
4969  return NULL;
4970  }
4971  else
4972  {
4973  array = (int *) malloc( sizeof ( int ) * (size_t) ( *number ) );
4974  for ( i = 0; i < ( *number ); i++ )
4975  {
4976  Tcl_ListObjIndex( interp, list, i, &elem );
4977  Tcl_GetIntFromObj( interp, elem, &array[i] );
4978  }
4979  }
4980  return array;
4981 }
4982 
4983 static double *argv_to_doubles( Tcl_Interp *interp, const char *list_numbers, int *number )
4984 {
4985  int i, retcode;
4986  double *array;
4987  Tcl_Obj *list;
4988  Tcl_Obj *elem;
4989 
4990  list = Tcl_NewStringObj( list_numbers, ( -1 ) );
4991 
4992  retcode = Tcl_ListObjLength( interp, list, number );
4993  if ( retcode != TCL_OK || ( *number ) == 0 )
4994  {
4995  *number = 0;
4996  return NULL;
4997  }
4998  else
4999  {
5000  array = (double *) malloc( sizeof ( double ) * (size_t) ( *number ) );
5001  for ( i = 0; i < ( *number ); i++ )
5002  {
5003  Tcl_ListObjIndex( interp, list, i, &elem );
5004  Tcl_GetDoubleFromObj( interp, elem, &array[i] );
5005  }
5006  }
5007  return array;
5008 }
5009 
5010 static char **argv_to_chars( Tcl_Interp *interp, const char *list_strings, int *number )
5011 {
5012  int i, retcode;
5013  char **array;
5014  char *string;
5015  int length;
5016  int idx;
5017  Tcl_Obj *list;
5018  Tcl_Obj *elem;
5019 
5020  list = Tcl_NewStringObj( list_strings, ( -1 ) );
5021 
5022  retcode = Tcl_ListObjLength( interp, list, number );
5023  if ( retcode != TCL_OK || ( *number ) == 0 )
5024  {
5025  *number = 0;
5026  return NULL;
5027  }
5028  else
5029  {
5030  array = (char **) malloc( sizeof ( char* ) * (size_t) ( *number ) );
5031  array[0] = (char *) malloc( sizeof ( char ) * ( strlen( list_strings ) + 1 ) );
5032  idx = 0;
5033  for ( i = 0; i < ( *number ); i++ )
5034  {
5035  Tcl_ListObjIndex( interp, list, i, &elem );
5036  string = Tcl_GetStringFromObj( elem, &length );
5037 
5038  array[i] = array[0] + idx;
5039  strncpy( array[i], string, (size_t) length );
5040  idx += length + 1;
5041  array[0][idx - 1] = '\0';
5042  }
5043  }
5044  return array;
5045 }
5046 
5047 static int
5048 pllegendCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp,
5049  int argc, const char *argv[] )
5050 {
5051  PLFLT legend_width, legend_height;
5052  PLFLT x, y, plot_width;
5053  PLINT opt, position;
5054  PLINT bg_color, bb_color, bb_style;
5055  PLINT nrow, ncolumn;
5056  PLINT nlegend;
5057  PLINT *opt_array;
5058  PLFLT text_offset, text_scale, text_spacing, text_justification;
5059  PLINT *text_colors;
5060  PLINT *box_colors, *box_patterns;
5061  PLFLT *box_scales;
5062  PLINT *line_colors, *line_styles;
5063  PLFLT *box_line_widths, *line_widths;
5064  PLINT *symbol_colors, *symbol_numbers;
5065  PLFLT *symbol_scales;
5066  char **text;
5067  char **symbols;
5068 
5069  int number_opts;
5070  int number_texts;
5071  int dummy;
5072  double value;
5073 
5074  Tcl_Obj *data[2];
5075 
5076  if ( argc != 29 )
5077  {
5078  Tcl_AppendResult( interp, "bogus syntax for pllegend, see doc.",
5079  (char *) NULL );
5080  return TCL_ERROR;
5081  }
5082 
5083  sscanf( argv[1], "%d", &opt );
5084  sscanf( argv[2], "%d", &position );
5085  sscanf( argv[3], "%lg", &value ); x = (PLFLT) value;
5086  sscanf( argv[4], "%lg", &value ); y = (PLFLT) value;
5087  sscanf( argv[5], "%lg", &value ); plot_width = (PLFLT) value;
5088  sscanf( argv[6], "%d", &bg_color );
5089  sscanf( argv[7], "%d", &bb_color );
5090  sscanf( argv[8], "%d", &bb_style );
5091  sscanf( argv[9], "%d", &nrow );
5092  sscanf( argv[10], "%d", &ncolumn );
5093  opt_array = argv_to_ints( interp, argv[11], &number_opts );
5094  sscanf( argv[12], "%lg", &value ); text_offset = (PLFLT) value;
5095  sscanf( argv[13], "%lg", &value ); text_scale = (PLFLT) value;
5096  sscanf( argv[14], "%lg", &value ); text_spacing = (PLFLT) value;
5097  sscanf( argv[15], "%lg", &value ); text_justification = (PLFLT) value;
5098 
5099  text_colors = argv_to_ints( interp, argv[16], &dummy );
5100  text = argv_to_chars( interp, argv[17], &number_texts );
5101  box_colors = argv_to_ints( interp, argv[18], &dummy );
5102  box_patterns = argv_to_ints( interp, argv[19], &dummy );
5103  box_scales = argv_to_doubles( interp, argv[20], &dummy );
5104  box_line_widths = argv_to_doubles( interp, argv[21], &dummy );
5105  line_colors = argv_to_ints( interp, argv[22], &dummy );
5106  line_styles = argv_to_ints( interp, argv[23], &dummy );
5107  line_widths = argv_to_doubles( interp, argv[24], &dummy );
5108  symbol_colors = argv_to_ints( interp, argv[25], &dummy );
5109  symbol_scales = argv_to_doubles( interp, argv[26], &dummy );
5110  symbol_numbers = argv_to_ints( interp, argv[27], &dummy );
5111  symbols = argv_to_chars( interp, argv[28], &dummy );
5112 
5113  nlegend = MIN( number_opts, number_texts );
5114 
5115  c_pllegend( &legend_width, &legend_height,
5116  opt, position, x, y, plot_width,
5117  bg_color, bb_color, bb_style,
5118  nrow, ncolumn,
5119  nlegend, opt_array,
5120  text_offset, text_scale, text_spacing,
5121  text_justification,
5122  text_colors, (const char * const *) text,
5123  box_colors, box_patterns,
5124  box_scales, box_line_widths,
5125  line_colors, line_styles,
5126  line_widths,
5127  symbol_colors, symbol_scales,
5128  symbol_numbers, (const char * const *) symbols );
5129 
5130  if ( opt_array != NULL )
5131  free( opt_array );
5132  if ( text_colors != NULL )
5133  free( text_colors );
5134  if ( text != NULL )
5135  {
5136  free( text[0] );
5137  free( text );
5138  }
5139  if ( box_colors != NULL )
5140  free( box_colors );
5141  if ( box_patterns != NULL )
5142  free( box_patterns );
5143  if ( box_scales != NULL )
5144  free( box_scales );
5145  if ( box_line_widths != NULL )
5146  free( box_line_widths );
5147  if ( line_colors != NULL )
5148  free( line_colors );
5149  if ( line_styles != NULL )
5150  free( line_styles );
5151  if ( line_widths != NULL )
5152  free( line_widths );
5153  if ( symbol_colors != NULL )
5154  free( symbol_colors );
5155  if ( symbol_scales != NULL )
5156  free( symbol_scales );
5157  if ( symbol_numbers != NULL )
5158  free( symbol_numbers );
5159  if ( symbols != NULL )
5160  {
5161  free( symbols[0] );
5162  free( symbols );
5163  }
5164 
5165  data[0] = Tcl_NewDoubleObj( legend_width );
5166  data[1] = Tcl_NewDoubleObj( legend_height );
5167  Tcl_SetObjResult( interp, Tcl_NewListObj( 2, data ) );
5168 
5169  return TCL_OK;
5170 }
5171 
5172 //--------------------------------------------------------------------------
5173 // plcolorbarCmd
5174 //
5175 // Processes plcolorbar Tcl command.
5176 //--------------------------------------------------------------------------
5177 
5178 static int
5179 plcolorbarCmd( ClientData PL_UNUSED( clientData ), Tcl_Interp *interp,
5180  int argc, const char *argv[] )
5181 {
5182  PLFLT colorbar_width, colorbar_height;
5183  PLINT opt, position;
5184  PLFLT x, y, x_length, y_length;
5185  PLINT bg_color, bb_color, bb_style;
5186  PLFLT low_cap_color, high_cap_color;
5187  PLINT cont_color;
5188  PLFLT cont_width;
5189  PLINT n_label_opts;
5190  PLINT n_labels;
5191  PLINT *label_opts;
5192  char **labels;
5193  PLINT n_axis_opts;
5194  PLINT n_ticks;
5195  PLINT n_sub_ticks;
5196  PLINT n_axes;
5197  char **axis_opts;
5198  PLFLT *ticks;
5199  PLINT *sub_ticks;
5200  Tcl_Obj *list_vectors;
5201  int n_vectors;
5202  PLINT *vector_sizes;
5203  PLFLT **vector_values;
5204  int retcode;
5205  int i;
5206  int length;
5207  Tcl_Obj *vector;
5208  tclMatrix *vectorPtr;
5209 
5210  double value;
5211 
5212  Tcl_Obj *data[2];
5213 
5214  if ( argc != 20 )
5215  {
5216  Tcl_AppendResult( interp, "bogus syntax for plcolorbar, see doc.",
5217  (char *) NULL );
5218  return TCL_ERROR;
5219  }
5220 
5221  // The first two arguments, the resulting width and height are returned via Tcl_SetObjResult()
5222  sscanf( argv[1], "%d", &opt );
5223  sscanf( argv[2], "%d", &position );
5224  sscanf( argv[3], "%lg", &value ); x = (PLFLT) value;
5225  sscanf( argv[4], "%lg", &value ); y = (PLFLT) value;
5226  sscanf( argv[5], "%lg", &value ); x_length = (PLFLT) value;
5227  sscanf( argv[6], "%lg", &value ); y_length = (PLFLT) value;
5228  sscanf( argv[7], "%d", &bg_color );
5229  sscanf( argv[8], "%d", &bb_color );
5230  sscanf( argv[9], "%d", &bb_style );
5231  sscanf( argv[10], "%lg", &value ); low_cap_color = (PLFLT) value;
5232  sscanf( argv[11], "%lg", &value ); high_cap_color = (PLFLT) value;
5233  sscanf( argv[12], "%d", &cont_color );
5234  sscanf( argv[13], "%lg", &value ); cont_width = (PLFLT) value;
5235  label_opts = argv_to_ints( interp, argv[14], &n_label_opts );
5236  labels = argv_to_chars( interp, argv[15], &n_labels );
5237  axis_opts = argv_to_chars( interp, argv[16], &n_axis_opts );
5238  ticks = argv_to_doubles( interp, argv[17], &n_ticks );
5239  sub_ticks = argv_to_ints( interp, argv[18], &n_sub_ticks );
5240  list_vectors = Tcl_NewStringObj( argv[19], ( -1 ) );
5241 
5242  // Check consistency
5243  if ( n_label_opts != n_labels )
5244  {
5245  Tcl_AppendResult( interp, "number of label options must equal number of labels.",
5246  (char *) NULL );
5247  return TCL_ERROR;
5248  }
5249  if ( n_axis_opts != n_ticks || n_axis_opts != n_sub_ticks )
5250  {
5251  Tcl_AppendResult( interp, "number of axis, tick and subtick options must be equal.",
5252  (char *) NULL );
5253  return TCL_ERROR;
5254  }
5255  n_axes = n_axis_opts;
5256 
5257  retcode = Tcl_ListObjLength( interp, list_vectors, &n_vectors );
5258  if ( retcode != TCL_OK || n_vectors == 0 )
5259  {
5260  Tcl_AppendResult( interp, "malformed list of vectors or no vector at all.",
5261  (char *) NULL );
5262  return TCL_ERROR;
5263  }
5264  else
5265  {
5266  vector_sizes = (int *) malloc( sizeof ( int ) * (size_t) n_vectors );
5267  vector_values = (PLFLT **) malloc( sizeof ( PLFLT * ) * (size_t) n_vectors );
5268  for ( i = 0; i < n_vectors; i++ )
5269  {
5270  Tcl_ListObjIndex( interp, list_vectors, i, &vector );
5271  vectorPtr = Tcl_GetMatrixPtr( interp, Tcl_GetStringFromObj( vector, &length ) );
5272  if ( vectorPtr == NULL || vectorPtr->dim != 1 )
5273  {
5274  Tcl_AppendResult( interp, "element in list of vectors is not a vector.",
5275  (char *) NULL );
5276  return TCL_ERROR;
5277  }
5278  vector_sizes[i] = vectorPtr->n[0];
5279  vector_values[i] = vectorPtr->fdata;
5280  }
5281  }
5282 
5283  c_plcolorbar( &colorbar_width, &colorbar_height,
5284  opt, position, x, y,
5285  x_length, y_length,
5286  bg_color, bb_color, bb_style,
5287  low_cap_color, high_cap_color,
5288  cont_color, cont_width,
5289  n_labels, label_opts, (const char * const *) labels,
5290  n_axes, (const char * const *) axis_opts,
5291  ticks, sub_ticks,
5292  vector_sizes, (const PLFLT * const *) vector_values );
5293 
5294  if ( label_opts != NULL )
5295  free( label_opts );
5296  if ( labels != NULL )
5297  {
5298  free( labels[0] );
5299  free( labels );
5300  }
5301  if ( axis_opts != NULL )
5302  {
5303  free( axis_opts[0] );
5304  free( axis_opts );
5305  }
5306  if ( ticks != NULL )
5307  free( ticks );
5308  if ( sub_ticks != NULL )
5309  free( sub_ticks );
5310  if ( vector_values != NULL )
5311  {
5312  free( vector_sizes );
5313  free( vector_values );
5314  }
5315 
5316  Tcl_DecrRefCount( list_vectors );
5317 
5318  data[0] = Tcl_NewDoubleObj( colorbar_width );
5319  data[1] = Tcl_NewDoubleObj( colorbar_height );
5320  Tcl_SetObjResult( interp, Tcl_NewListObj( 2, data ) );
5321 
5322  return TCL_OK;
5323 }