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
debug
static int debug
Definition pdfutils.c:43
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
value
static PLFLT value(double n1, double n2, double hue)
Definition plctrl.c:1219
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
yg
static const char shade or gradient plots n n or n gradient plots(See pllegend for similar functionality for creating\n\ legends with discrete elements). The arguments of plcolorbar provide\n\ control over the location and size of the color bar as well as the\n\ location and characteristics of the elements(most of which are\n\ optional) within that color bar. The resulting color bar is clipped\n\ at the boundaries of the current subpage.(N.B. the adopted coordinate\n\ system used for some of the parameters is defined in the documentation\n\ of the position parameter.)\n\ \n\ Redacted form reads the desired grid location from the input vectors n xg[nptsx] and yg[nptsy]
Definition plplot_octaveOCTAVE_wrap.cxx:10818
plplot_parameters.h
set_plplot_parameters
static void set_plplot_parameters(Tcl_Interp *interp)
Definition plplot_parameters.h:13
sh_max
static PLFLT sh_max
Definition plshade.c:135
sh_min
static PLFLT sh_min
Definition plshade.c:135
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 **)
text
static int text
Definition ps.c:77
argc
static int argc
Definition qt.cpp:48
argv
static char ** argv
Definition qt.cpp:49
CmdInfo::name
const char * name
Definition tclAPI.c:117
CmdInfo::proc
int(* proc)(void *, struct Tcl_Interp *, int, const char **)
Definition tclAPI.c:118
Command::proc
int(* proc)(void *, struct Tcl_Interp *, int, const char **)
Definition tclAPI.c:107
Command::clientData
ClientData clientData
Definition tclAPI.c:108
Command::deleteProc
int * deleteProc
Definition tclAPI.c:109
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 **)
Pltcl_Init
int Pltcl_Init(Tcl_Interp *interp)
Definition tclAPI.c:639
tclmateval_modx
static int tclmateval_modx
Definition tclAPI.c:912
pls_auto_path
int pls_auto_path(Tcl_Interp *interp)
Definition tclAPI.c:722
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 **)
PlbasicInit
int PlbasicInit(Tcl_Interp *interp)
Definition tclAPI.c:424
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 **)
plTclCmd
int plTclCmd(char *cmdlist, Tcl_Interp *interp, int argc, const char **argv)
Definition tclAPI.c:295
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
plWait_Until
int plWait_Until(ClientData PL_UNUSED(clientData), Tcl_Interp *interp, int PL_UNUSED(argc), const char **argv)
Definition tclAPI.c:687
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
interp
static Tcl_Interp * interp
Definition tkMain.c:117
name
static const char * name
Definition tkMain.c:132