PLplot: tclAPI.c Source File

PLplot 5.10.0

- Main Page
- Namespaces
- Classes
- Files

- File List
- File Members

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