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 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
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