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