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