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