00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034 #include "plplotP.h"
00035 #include "pltcl.h"
00036 #include "plplot_parameters.h"
00037 #ifndef __WIN32__
00038 #ifdef PL_HAVE_UNISTD_H
00039 #include <unistd.h>
00040 #endif
00041 #else
00042 #ifdef _MSC_VER
00043 #define getcwd _getcwd
00044 #include <direct.h>
00045 #endif
00046 #endif
00047
00048 #include "tclgen.h"
00049
00050
00051
00052 static int loopbackCmd( ClientData, Tcl_Interp *, int, const char ** );
00053 static int plcontCmd( ClientData, Tcl_Interp *, int, const char ** );
00054 static int pllegendCmd( ClientData, Tcl_Interp *, int, const char ** );
00055 static int plmeshCmd( ClientData, Tcl_Interp *, int, const char ** );
00056 static int plmeshcCmd( ClientData, Tcl_Interp *, int, const char ** );
00057 static int plot3dCmd( ClientData, Tcl_Interp *, int, const char ** );
00058 static int plot3dcCmd( ClientData, Tcl_Interp *, int, const char ** );
00059 static int plsurf3dCmd( ClientData, Tcl_Interp *, int, const char ** );
00060 static int plsetoptCmd( ClientData, Tcl_Interp *, int, const char ** );
00061 static int plshadeCmd( ClientData, Tcl_Interp *, int, const char ** );
00062 static int plshadesCmd( ClientData, Tcl_Interp *, int, const char ** );
00063 static int plmapCmd( ClientData, Tcl_Interp *, int, const char ** );
00064 static int plmeridiansCmd( ClientData, Tcl_Interp *, int, const char ** );
00065 static int plstransformCmd( ClientData, Tcl_Interp *, int, const char ** );
00066 static int plvectCmd( ClientData, Tcl_Interp *, int, const char ** );
00067 static int plranddCmd( ClientData, Tcl_Interp *, int, const char ** );
00068 static int plgriddataCmd( ClientData, Tcl_Interp *, int, const char ** );
00069 static int plimageCmd( ClientData, Tcl_Interp *, int, const char ** );
00070 static int plimagefrCmd( ClientData, Tcl_Interp *, int, const char ** );
00071 static int plstripcCmd( ClientData, Tcl_Interp *, int, const char ** );
00072 static int plslabelfuncCmd( ClientData, Tcl_Interp *, int, const char ** );
00073
00074
00075
00076
00077
00078
00079 typedef struct Command
00080 {
00081 int ( *proc )();
00082 ClientData clientData;
00083 int *deleteProc;
00084
00085 ClientData deleteData;
00086
00087 } Command;
00088
00089 typedef struct
00090 {
00091 char *name;
00092 int ( *proc )( void *, struct Tcl_Interp *, int, const char ** );
00093 } CmdInfo;
00094
00095
00096
00097 static CmdInfo Cmds[] = {
00098 { "loopback", loopbackCmd },
00099 #include "tclgen_s.h"
00100 { "plcont", plcontCmd },
00101 { "pllegend", pllegendCmd },
00102 { "plmap", plmapCmd },
00103 { "plmeridians", plmeridiansCmd },
00104 { "plstransform", plstransformCmd },
00105 { "plmesh", plmeshCmd },
00106 { "plmeshc", plmeshcCmd },
00107 { "plot3d", plot3dCmd },
00108 { "plot3dc", plot3dcCmd },
00109 { "plsurf3d", plsurf3dCmd },
00110 { "plsetopt", plsetoptCmd },
00111 { "plshade", plshadeCmd },
00112 { "plshades", plshadesCmd },
00113 { "plvect", plvectCmd },
00114 { "plrandd", plranddCmd },
00115 { "plgriddata", plgriddataCmd },
00116 { "plimage", plimageCmd },
00117 { "plimagefr", plimagefrCmd },
00118 { "plstripc", plstripcCmd },
00119 { "plslabelfunc", plslabelfuncCmd },
00120 { NULL, NULL }
00121 };
00122
00123
00124
00125 static int cmdTable_initted;
00126 static Tcl_HashTable cmdTable;
00127
00128
00129
00130 static PLINT pl_errcode;
00131 static char errmsg[160];
00132
00133
00134
00135 #ifndef PL_LIBRARY
00136 #define PL_LIBRARY ""
00137 #endif
00138
00139 extern PLDLLIMPORT char * plplotLibDir;
00140
00141 #if ( !defined ( MAC_TCL ) && !defined ( __WIN32__ ) )
00142
00143
00144
00145
00146
00147 #define PLPLOT_EXTENDED_SEARCH
00148 #endif
00149
00150
00151
00152
00153
00154 static int
00155 tcl_cmd( Tcl_Interp *interp, char *cmd );
00156
00157
00158
00159
00160
00161
00162
00163 static void
00164 Append_Cmdlist( Tcl_Interp *interp )
00165 {
00166 static int inited = 0;
00167 static char** namelist;
00168 int i, j, ncmds = sizeof ( Cmds ) / sizeof ( CmdInfo );
00169
00170 if ( !inited )
00171 {
00172 namelist = (char **) malloc( ncmds * sizeof ( char * ) );
00173
00174 for ( i = 0; i < ncmds; i++ )
00175 namelist[i] = Cmds[i].name;
00176
00177
00178
00179 for ( i = 0; i < ncmds - 1; i++ )
00180 for ( j = i + 1; j < ncmds - 1; j++ )
00181 {
00182 if ( strcmp( namelist[i], namelist[j] ) > 0 )
00183 {
00184 char *t = namelist[i];
00185 namelist[i] = namelist[j];
00186 namelist[j] = t;
00187 }
00188 }
00189
00190 inited = 1;
00191 }
00192
00193 for ( i = 0; i < ncmds; i++ )
00194 Tcl_AppendResult( interp, " ", namelist[i], (char *) NULL );
00195 }
00196
00197
00198
00199
00200
00201
00202
00203
00204
00205
00206 static void
00207 plTclCmd_Init( Tcl_Interp *interp )
00208 {
00209 register Command *cmdPtr;
00210 register CmdInfo *cmdInfoPtr;
00211
00212
00213
00214 plsError( &pl_errcode, errmsg );
00215
00216
00217
00218 Tcl_InitHashTable( &cmdTable, TCL_STRING_KEYS );
00219
00220
00221
00222 for ( cmdInfoPtr = Cmds; cmdInfoPtr->name != NULL; cmdInfoPtr++ )
00223 {
00224 int new;
00225 Tcl_HashEntry *hPtr;
00226
00227 hPtr = Tcl_CreateHashEntry( &cmdTable, cmdInfoPtr->name, &new );
00228 if ( new )
00229 {
00230 cmdPtr = (Command *) ckalloc( sizeof ( Command ) );
00231 cmdPtr->proc = cmdInfoPtr->proc;
00232 cmdPtr->clientData = (ClientData) NULL;
00233 cmdPtr->deleteProc = NULL;
00234 cmdPtr->deleteData = (ClientData) NULL;
00235 Tcl_SetHashValue( hPtr, cmdPtr );
00236 }
00237 }
00238 }
00239
00240
00241
00242
00243
00244
00245
00246
00247
00248
00249
00250
00251
00252
00253
00254
00255
00256
00257
00258
00259
00260
00261 int
00262 plTclCmd( char *cmdlist, Tcl_Interp *interp, int argc, const char **argv )
00263 {
00264 register Tcl_HashEntry *hPtr;
00265 int result = TCL_OK;
00266
00267 pl_errcode = 0; errmsg[0] = '\0';
00268
00269
00270
00271 if ( !cmdTable_initted )
00272 {
00273 cmdTable_initted = 1;
00274 plTclCmd_Init( interp );
00275 }
00276
00277
00278
00279 if ( argc == 0 )
00280 {
00281 Tcl_AppendResult( interp, cmdlist, (char *) NULL );
00282 Append_Cmdlist( interp );
00283 return TCL_OK;
00284 }
00285
00286
00287
00288 hPtr = Tcl_FindHashEntry( &cmdTable, argv[0] );
00289 if ( hPtr == NULL )
00290 {
00291 Tcl_AppendResult( interp, "bad option \"", argv[0],
00292 "\" to \"cmd\": must be one of ",
00293 cmdlist, (char *) NULL );
00294 Append_Cmdlist( interp );
00295 result = TCL_ERROR;
00296 }
00297 else
00298 {
00299 register Command *cmdPtr = (Command *) Tcl_GetHashValue( hPtr );
00300 result = ( *cmdPtr->proc )( cmdPtr->clientData, interp, argc, argv );
00301 if ( result == TCL_OK )
00302 {
00303 if ( pl_errcode != 0 )
00304 {
00305 result = TCL_ERROR;
00306 Tcl_AppendResult( interp, errmsg, (char *) NULL );
00307 }
00308 }
00309 }
00310
00311 return result;
00312 }
00313
00314
00315
00316
00317
00318
00319
00320
00321
00322
00323
00324
00325
00326
00327
00328 static int
00329 loopbackCmd( ClientData clientData, Tcl_Interp *interp,
00330 int argc, const char **argv )
00331 {
00332 register Tcl_HashEntry *hPtr;
00333 int result = TCL_OK;
00334
00335 argc--; argv++;
00336 if ( argc == 0 || ( strcmp( argv[0], "cmd" ) != 0 ) )
00337 {
00338 Tcl_AppendResult( interp, "bad option \"", argv[0],
00339 "\" to \"loopback\": must be ",
00340 "\"cmd ?options?\" ", (char *) NULL );
00341 return TCL_ERROR;
00342 }
00343
00344
00345
00346 if ( !cmdTable_initted )
00347 {
00348 cmdTable_initted = 1;
00349 plTclCmd_Init( interp );
00350 }
00351
00352
00353
00354 argc--; argv++;
00355 if ( argc == 0 )
00356 {
00357 Append_Cmdlist( interp );
00358 return TCL_OK;
00359 }
00360
00361
00362
00363 hPtr = Tcl_FindHashEntry( &cmdTable, argv[0] );
00364 if ( hPtr == NULL )
00365 {
00366 Tcl_AppendResult( interp, "bad option \"", argv[0],
00367 "\" to \"loopback cmd\": must be one of ",
00368 (char *) NULL );
00369 Append_Cmdlist( interp );
00370 result = TCL_ERROR;
00371 }
00372 else
00373 {
00374 register Command *cmdPtr = (Command *) Tcl_GetHashValue( hPtr );
00375 result = ( *cmdPtr->proc )( cmdPtr->clientData, interp, argc, argv );
00376 }
00377
00378 return result;
00379 }
00380
00381
00382
00383
00384
00385
00386
00387
00388
00389
00390 int
00391 PlbasicInit( Tcl_Interp *interp )
00392 {
00393 int debug = plsc->debug;
00394 char *libDir = NULL;
00395 static char initScript[] =
00396 "tcl_findLibrary plplot " VERSION " \"\" plplot.tcl PL_LIBRARY pllibrary";
00397 #ifdef PLPLOT_EXTENDED_SEARCH
00398 static char initScriptExtended[] =
00399 "tcl_findLibrary plplot " VERSION "/tcl \"\" plplot.tcl PL_LIBRARY pllibrary";
00400 #endif
00401
00402 #ifdef USE_TCL_STUBS
00403
00404
00405
00406
00407
00408
00409 Tcl_InitStubs( interp, "8.1", 0 );
00410 #endif
00411
00412 #if 1
00413 if ( Matrix_Init( interp ) != TCL_OK )
00414 {
00415 if ( debug )
00416 fprintf( stderr, "error in matrix init\n" );
00417 return TCL_ERROR;
00418 }
00419 #else
00420
00421
00422
00423
00424
00425
00426
00427 #ifdef USE_MATRIX_STUBS
00428 if ( Matrix_InitStubs( interp, "0.1", 0 ) == NULL )
00429 {
00430 if ( debug )
00431 fprintf( stderr, "error in matrix stubs init\n" );
00432 return TCL_ERROR;
00433 }
00434 #else
00435 Tcl_PkgRequire( interp, "Matrix", "0.1", 0 );
00436 #endif
00437 #endif
00438
00439 Tcl_SetVar( interp, "plversion", VERSION, TCL_GLOBAL_ONLY );
00440
00441
00442
00443
00444
00445
00446 if ( plInBuildTree() )
00447 {
00448 if ( debug )
00449 fprintf( stderr, "trying BUILD_DIR\n" );
00450 libDir = BUILD_DIR "/bindings/tcl";
00451 Tcl_SetVar( interp, "pllibrary", libDir, TCL_GLOBAL_ONLY );
00452 if ( Tcl_Eval( interp, initScript ) != TCL_OK )
00453 {
00454 libDir = NULL;
00455 Tcl_UnsetVar( interp, "pllibrary", TCL_GLOBAL_ONLY );
00456 Tcl_ResetResult( interp );
00457 }
00458 }
00459
00460
00461 if ( libDir == NULL )
00462 {
00463 if ( debug )
00464 fprintf( stderr, "trying init script\n" );
00465 if ( Tcl_Eval( interp, initScript ) != TCL_OK )
00466 {
00467
00468 Tcl_UnsetVar( interp, "pllibrary", TCL_GLOBAL_ONLY );
00469
00470 Tcl_ResetResult( interp );
00471 }
00472 else
00473 libDir = (char *) Tcl_GetVar( interp, "pllibrary", TCL_GLOBAL_ONLY );
00474 }
00475
00476 #ifdef TCL_DIR
00477
00478 if ( libDir == NULL )
00479 {
00480 if ( debug )
00481 fprintf( stderr, "trying TCL_DIR\n" );
00482 libDir = TCL_DIR;
00483 Tcl_SetVar( interp, "pllibrary", libDir, TCL_GLOBAL_ONLY );
00484 if ( Tcl_Eval( interp, initScript ) != TCL_OK )
00485 {
00486 libDir = NULL;
00487 Tcl_UnsetVar( interp, "pllibrary", TCL_GLOBAL_ONLY );
00488 Tcl_ResetResult( interp );
00489 }
00490 }
00491 #endif
00492
00493 #ifdef PLPLOT_EXTENDED_SEARCH
00494
00495 if ( libDir == NULL )
00496 {
00497 if ( debug )
00498 fprintf( stderr, "trying extended init script\n" );
00499 if ( Tcl_Eval( interp, initScriptExtended ) != TCL_OK )
00500 {
00501
00502 Tcl_UnsetVar( interp, "pllibrary", TCL_GLOBAL_ONLY );
00503
00504 Tcl_ResetResult( interp );
00505 }
00506 else
00507 libDir = (char *) Tcl_GetVar( interp, "pllibrary", TCL_GLOBAL_ONLY );
00508 }
00509
00510
00511 if ( libDir == NULL )
00512 {
00513 Tcl_DString ds;
00514 if ( debug )
00515 fprintf( stderr, "trying curdir\n" );
00516 if ( Tcl_Access( "plplot.tcl", 0 ) != 0 )
00517 {
00518 if ( debug )
00519 fprintf( stderr, "couldn't find plplot.tcl in curdir\n" );
00520 return TCL_ERROR;
00521 }
00522
00523
00524 libDir = Tcl_GetCwd( interp, &ds );
00525 if ( libDir == NULL )
00526 {
00527 if ( debug )
00528 fprintf( stderr, "couldn't get curdir\n" );
00529 return TCL_ERROR;
00530 }
00531 libDir = plstrdup( libDir );
00532 Tcl_DStringFree( &ds );
00533 Tcl_SetVar( interp, "pllibrary", libDir, TCL_GLOBAL_ONLY );
00534
00535 if ( Tcl_EvalFile( interp, "plplot.tcl" ) != TCL_OK )
00536 {
00537 if ( debug )
00538 fprintf( stderr, "error evalling plplot.tcl\n" );
00539 return TCL_ERROR;
00540 }
00541 }
00542 #endif
00543
00544 if ( libDir == NULL )
00545 {
00546 if ( debug )
00547 fprintf( stderr, "libdir NULL at end of search\n" );
00548 return TCL_ERROR;
00549 }
00550
00551
00552 plplotLibDir = plstrdup( libDir );
00553
00554
00555
00556
00557 Tcl_CreateCommand( interp, "wait_until", (Tcl_CmdProc *) plWait_Until,
00558 (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL );
00559
00560 return TCL_OK;
00561 }
00562
00563
00564
00565
00566
00567
00568
00569
00570
00571 int
00572 Pltcl_Init( Tcl_Interp *interp )
00573 {
00574 register CmdInfo *cmdInfoPtr;
00575
00576 if ( PlbasicInit( interp ) != TCL_OK )
00577 {
00578 Tcl_AppendResult( interp, "Could not find plplot.tcl - please set \
00579 environment variable PL_LIBRARY to the directory containing that file",
00580 (char *) NULL );
00581
00582 return TCL_ERROR;
00583 }
00584
00585
00586
00587 plsError( &pl_errcode, errmsg );
00588
00589
00590
00591 for ( cmdInfoPtr = Cmds; cmdInfoPtr->name != NULL; cmdInfoPtr++ )
00592 {
00593 Tcl_CreateCommand( interp, cmdInfoPtr->name, cmdInfoPtr->proc,
00594 (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL );
00595 }
00596
00597
00598
00599 set_plplot_parameters( interp );
00600
00601
00602
00603
00604 Tcl_PkgProvide( interp, "Pltcl", VERSION );
00605 return TCL_OK;
00606 }
00607
00608
00609
00610
00611
00612
00613
00614
00615
00616
00617
00618
00619
00620
00621
00622
00623 int
00624 plWait_Until( ClientData clientData, Tcl_Interp *interp, int argc, const char **argv )
00625 {
00626 int result = 0;
00627
00628 dbug_enter( "plWait_Until" );
00629
00630 for (;; )
00631 {
00632 if ( Tcl_ExprBoolean( interp, argv[1], &result ) )
00633 {
00634 fprintf( stderr, "wait_until command \"%s\" failed:\n\t %s\n",
00635 argv[1], Tcl_GetStringResult( interp ) );
00636 break;
00637 }
00638 if ( result )
00639 break;
00640
00641 Tcl_DoOneEvent( 0 );
00642 }
00643 return TCL_OK;
00644 }
00645
00646
00647
00648
00649
00650
00651
00652
00653
00654
00655
00656
00657
00658 int
00659 pls_auto_path( Tcl_Interp *interp )
00660 {
00661 char *buf, *ptr = NULL, *dn;
00662 int return_code = TCL_OK;
00663 #ifdef DEBUG
00664 char *path;
00665 #endif
00666
00667 buf = (char *) malloc( 256 * sizeof ( char ) );
00668
00669
00670
00671 #ifdef TCL_DIR
00672 Tcl_SetVar( interp, "dir", TCL_DIR, TCL_GLOBAL_ONLY );
00673 if ( tcl_cmd( interp, "set auto_path [linsert $auto_path 0 $dir]" ) == TCL_ERROR )
00674 {
00675 return_code = TCL_ERROR;
00676 goto finish;
00677 }
00678 #ifdef DEBUG
00679 fprintf( stderr, "adding %s to auto_path\n", TCL_DIR );
00680 path = Tcl_GetVar( interp, "auto_path", 0 );
00681 fprintf( stderr, "auto_path is %s\n", path );
00682 #endif
00683 #endif
00684
00685
00686
00687 if ( ( dn = getenv( "HOME" ) ) != NULL )
00688 {
00689 plGetName( dn, "tcl", "", &ptr );
00690 Tcl_SetVar( interp, "dir", ptr, 0 );
00691 if ( tcl_cmd( interp, "set auto_path [linsert $auto_path 0 $dir]" ) == TCL_ERROR )
00692 {
00693 return_code = TCL_ERROR;
00694 goto finish;
00695 }
00696 #ifdef DEBUG
00697 fprintf( stderr, "adding %s to auto_path\n", ptr );
00698 path = Tcl_GetVar( interp, "auto_path", 0 );
00699 fprintf( stderr, "auto_path is %s\n", path );
00700 #endif
00701 }
00702
00703
00704
00705 #if defined ( PL_TCL_ENV )
00706 if ( ( dn = getenv( PL_TCL_ENV ) ) != NULL )
00707 {
00708 plGetName( dn, "", "", &ptr );
00709 Tcl_SetVar( interp, "dir", ptr, 0 );
00710 if ( tcl_cmd( interp, "set auto_path [linsert $auto_path 0 $dir]" ) == TCL_ERROR )
00711 {
00712 return_code = TCL_ERROR;
00713 goto finish;
00714 }
00715 #ifdef DEBUG
00716 fprintf( stderr, "adding %s to auto_path\n", ptr );
00717 path = Tcl_GetVar( interp, "auto_path", 0 );
00718 fprintf( stderr, "auto_path is %s\n", path );
00719 #endif
00720 }
00721 #endif // PL_TCL_ENV
00722
00723
00724
00725 #if defined ( PL_HOME_ENV )
00726 if ( ( dn = getenv( PL_HOME_ENV ) ) != NULL )
00727 {
00728 plGetName( dn, "tcl", "", &ptr );
00729 Tcl_SetVar( interp, "dir", ptr, 0 );
00730 if ( tcl_cmd( interp, "set auto_path [linsert $auto_path 0 $dir]" ) == TCL_ERROR )
00731 {
00732 return_code = TCL_ERROR;
00733 goto finish;
00734 }
00735 #ifdef DEBUG
00736 fprintf( stderr, "adding %s to auto_path\n", ptr );
00737 path = Tcl_GetVar( interp, "auto_path", 0 );
00738 fprintf( stderr, "auto_path is %s\n", path );
00739 #endif
00740 }
00741 #endif // PL_HOME_ENV
00742
00743
00744
00745 if ( getcwd( buf, 256 ) == 0 )
00746 {
00747 Tcl_SetResult( interp, "Problems with getcwd in pls_auto_path", TCL_STATIC );
00748 {
00749 return_code = TCL_ERROR;
00750 goto finish;
00751 }
00752 }
00753 Tcl_SetVar( interp, "dir", buf, 0 );
00754 if ( tcl_cmd( interp, "set auto_path [linsert $auto_path 0 $dir]" ) == TCL_ERROR )
00755 {
00756 return_code = TCL_ERROR;
00757 goto finish;
00758 }
00759
00760 if ( plInBuildTree() )
00761 {
00762 Tcl_SetVar( interp, "dir", BUILD_DIR "/bindings/tk", TCL_GLOBAL_ONLY );
00763 if ( tcl_cmd( interp, "set auto_path [linsert $auto_path 0 $dir]" ) == TCL_ERROR )
00764 {
00765 return_code = TCL_ERROR;
00766 goto finish;
00767 }
00768 }
00769
00770 #ifdef DEBUG
00771 fprintf( stderr, "adding %s to auto_path\n", buf );
00772 path = Tcl_GetVar( interp, "auto_path", 0 );
00773 fprintf( stderr, "auto_path is %s\n", path );
00774 #endif
00775
00776 finish: free_mem( buf );
00777 free_mem( ptr );
00778
00779 return return_code;
00780 }
00781
00782
00783
00784
00785
00786
00787
00788 static int
00789 tcl_cmd( Tcl_Interp *interp, char *cmd )
00790 {
00791 int result;
00792
00793 result = Tcl_VarEval( interp, cmd, (char **) NULL );
00794 if ( result != TCL_OK )
00795 {
00796 fprintf( stderr, "TCL command \"%s\" failed:\n\t %s\n",
00797 cmd, Tcl_GetStringResult( interp ) );
00798 }
00799 return result;
00800 }
00801
00802
00803
00804
00805
00806
00807
00808
00809
00810
00811
00812
00813
00814 static char buf[200];
00815
00816 #include "tclgen.c"
00817
00818
00819
00820
00821
00822
00823
00824
00825
00826
00827
00828
00829
00830
00831
00832
00833
00834
00835
00836
00837
00838
00839
00840
00841
00842
00843
00844
00845
00846
00847 static int tclmateval_modx, tclmateval_mody;
00848
00849 PLFLT tclMatrix_feval( PLINT i, PLINT j, PLPointer p )
00850 {
00851 tclMatrix *matPtr = (tclMatrix *) p;
00852
00853 i = i % tclmateval_modx;
00854 j = j % tclmateval_mody;
00855
00856
00857
00858
00859 return matPtr->fdata[I2D( i, j )];
00860 }
00861
00862 static int
00863 plcontCmd( ClientData clientData, Tcl_Interp *interp,
00864 int argc, const char *argv[] )
00865 {
00866 tclMatrix *matPtr, *matf, *matclev;
00867 PLINT nx, ny, kx = 0, lx = 0, ky = 0, ly = 0, nclev;
00868 const char *pltrname = "pltr0";
00869 tclMatrix *mattrx = NULL, *mattry = NULL;
00870 PLFLT **z, **zused, **zwrapped;
00871
00872 int arg3_is_kx = 1, i, j;
00873 void ( *pltr )( PLFLT, PLFLT, PLFLT *, PLFLT *, PLPointer );
00874 PLPointer pltr_data = NULL;
00875 PLcGrid cgrid1;
00876 PLcGrid2 cgrid2;
00877
00878 int wrap = 0;
00879
00880 if ( argc < 3 )
00881 {
00882 Tcl_AppendResult( interp, "wrong # args: see documentation for ",
00883 argv[0], (char *) NULL );
00884 return TCL_ERROR;
00885 }
00886
00887 matf = Tcl_GetMatrixPtr( interp, argv[1] );
00888 if ( matf == NULL )
00889 return TCL_ERROR;
00890
00891 if ( matf->dim != 2 )
00892 {
00893 Tcl_SetResult( interp, "Must use 2-d data.", TCL_STATIC );
00894 return TCL_ERROR;
00895 }
00896 else
00897 {
00898 nx = matf->n[0];
00899 ny = matf->n[1];
00900 tclmateval_modx = nx;
00901 tclmateval_mody = ny;
00902
00903
00904
00905 plAlloc2dGrid( &z, nx, ny );
00906 for ( i = 0; i < nx; i++ )
00907 {
00908 for ( j = 0; j < ny; j++ )
00909 {
00910 z[i][j] = tclMatrix_feval( i, j, matf );
00911 }
00912 }
00913 }
00914
00915
00916
00917
00918 for ( i = 0; i < (int) strlen( argv[2] ) && arg3_is_kx; i++ )
00919 if ( !isdigit( argv[2][i] ) )
00920 arg3_is_kx = 0;
00921
00922 if ( arg3_is_kx )
00923 {
00924
00925 if ( argc < 7 )
00926 {
00927 Tcl_SetResult( interp, "plcont, bogus syntax", TCL_STATIC );
00928 return TCL_ERROR;
00929 }
00930
00931
00932 kx = atoi( argv[3] );
00933 lx = atoi( argv[4] );
00934 ky = atoi( argv[5] );
00935 ly = atoi( argv[6] );
00936
00937
00938 argc -= 6, argv += 6;
00939 }
00940 else
00941 {
00942 argc -= 2, argv += 2;
00943 }
00944
00945
00946
00947 if ( argc < 1 )
00948 {
00949 Tcl_SetResult( interp, "plcont, bogus syntax", TCL_STATIC );
00950 return TCL_ERROR;
00951 }
00952
00953 matclev = Tcl_GetMatrixPtr( interp, argv[0] );
00954 if ( matclev == NULL )
00955 return TCL_ERROR;
00956 nclev = matclev->n[0];
00957
00958 if ( matclev->dim != 1 )
00959 {
00960 Tcl_SetResult( interp, "clev must be 1-d matrix.", TCL_STATIC );
00961 return TCL_ERROR;
00962 }
00963
00964 argc--, argv++;
00965
00966
00967
00968 if ( argc >= 3 )
00969 {
00970
00971 pltrname = argv[0];
00972 mattrx = Tcl_GetMatrixPtr( interp, argv[1] );
00973 if ( mattrx == NULL )
00974 return TCL_ERROR;
00975 mattry = Tcl_GetMatrixPtr( interp, argv[2] );
00976 if ( mattry == NULL )
00977 return TCL_ERROR;
00978
00979 argc -= 3, argv += 3;
00980 }
00981
00982 if ( argc )
00983 {
00984
00985 wrap = atoi( argv[0] );
00986
00987
00988
00989
00990 argc--, argv++;
00991 }
00992
00993
00994
00995 if ( argc )
00996 {
00997 Tcl_SetResult( interp, "plcont, bogus syntax, too many args.", TCL_STATIC );
00998 return TCL_ERROR;
00999 }
01000
01001
01002
01003 if ( !strcmp( pltrname, "pltr0" ) )
01004 {
01005 pltr = pltr0;
01006 zused = z;
01007
01008
01009 if ( wrap )
01010 {
01011 Tcl_SetResult( interp, "Must use pltr2 if want wrapping.", TCL_STATIC );
01012 return TCL_ERROR;
01013 }
01014 }
01015 else if ( !strcmp( pltrname, "pltr1" ) )
01016 {
01017 pltr = pltr1;
01018 cgrid1.xg = mattrx->fdata;
01019 cgrid1.nx = nx;
01020 cgrid1.yg = mattry->fdata;
01021 cgrid1.ny = ny;
01022 zused = z;
01023
01024
01025 if ( wrap )
01026 {
01027 Tcl_SetResult( interp, "Must use pltr2 if want wrapping.", TCL_STATIC );
01028 return TCL_ERROR;
01029 }
01030
01031 if ( mattrx->dim != 1 || mattry->dim != 1 )
01032 {
01033 Tcl_SetResult( interp, "Must use 1-d coord arrays with pltr1.", TCL_STATIC );
01034 return TCL_ERROR;
01035 }
01036
01037 pltr_data = &cgrid1;
01038 }
01039 else if ( !strcmp( pltrname, "pltr2" ) )
01040 {
01041
01042 if ( !wrap )
01043 {
01044
01045 plAlloc2dGrid( &cgrid2.xg, nx, ny );
01046 plAlloc2dGrid( &cgrid2.yg, nx, ny );
01047 cgrid2.nx = nx;
01048 cgrid2.ny = ny;
01049 zused = z;
01050
01051 matPtr = mattrx;
01052 for ( i = 0; i < nx; i++ )
01053 for ( j = 0; j < ny; j++ )
01054 cgrid2.xg[i][j] = mattrx->fdata[ I2D( i, j ) ];
01055
01056 matPtr = mattry;
01057 for ( i = 0; i < nx; i++ )
01058 for ( j = 0; j < ny; j++ )
01059 cgrid2.yg[i][j] = mattry->fdata[ I2D( i, j ) ];
01060 }
01061 else if ( wrap == 1 )
01062 {
01063 plAlloc2dGrid( &cgrid2.xg, nx + 1, ny );
01064 plAlloc2dGrid( &cgrid2.yg, nx + 1, ny );
01065 plAlloc2dGrid( &zwrapped, nx + 1, ny );
01066 cgrid2.nx = nx + 1;
01067 cgrid2.ny = ny;
01068 zused = zwrapped;
01069
01070 matPtr = mattrx;
01071 for ( i = 0; i < nx; i++ )
01072 for ( j = 0; j < ny; j++ )
01073 cgrid2.xg[i][j] = mattrx->fdata[ I2D( i, j ) ];
01074
01075 matPtr = mattry;
01076 for ( i = 0; i < nx; i++ )
01077 {
01078 for ( j = 0; j < ny; j++ )
01079 {
01080 cgrid2.yg[i][j] = mattry->fdata[ I2D( i, j ) ];
01081 zwrapped[i][j] = z[i][j];
01082 }
01083 }
01084
01085 for ( j = 0; j < ny; j++ )
01086 {
01087 cgrid2.xg[nx][j] = cgrid2.xg[0][j];
01088 cgrid2.yg[nx][j] = cgrid2.yg[0][j];
01089 zwrapped[nx][j] = zwrapped[0][j];
01090 }
01091
01092
01093
01094 plFree2dGrid( z, nx, ny );
01095
01096 nx++;
01097 }
01098 else if ( wrap == 2 )
01099 {
01100 plAlloc2dGrid( &cgrid2.xg, nx, ny + 1 );
01101 plAlloc2dGrid( &cgrid2.yg, nx, ny + 1 );
01102 plAlloc2dGrid( &zwrapped, nx, ny + 1 );
01103 cgrid2.nx = nx;
01104 cgrid2.ny = ny + 1;
01105 zused = zwrapped;
01106
01107 matPtr = mattrx;
01108 for ( i = 0; i < nx; i++ )
01109 for ( j = 0; j < ny; j++ )
01110 cgrid2.xg[i][j] = mattrx->fdata[ I2D( i, j ) ];
01111
01112 matPtr = mattry;
01113 for ( i = 0; i < nx; i++ )
01114 {
01115 for ( j = 0; j < ny; j++ )
01116 {
01117 cgrid2.yg[i][j] = mattry->fdata[ I2D( i, j ) ];
01118 zwrapped[i][j] = z[i][j];
01119 }
01120 }
01121
01122 for ( i = 0; i < nx; i++ )
01123 {
01124 cgrid2.xg[i][ny] = cgrid2.xg[i][0];
01125 cgrid2.yg[i][ny] = cgrid2.yg[i][0];
01126 zwrapped[i][ny] = zwrapped[i][0];
01127 }
01128
01129
01130
01131 plFree2dGrid( z, nx, ny );
01132
01133 ny++;
01134 }
01135 else
01136 {
01137 Tcl_SetResult( interp, "Invalid wrap specifier, must be <empty>, 0, 1, or 2.", TCL_STATIC );
01138 return TCL_ERROR;
01139 }
01140
01141 pltr = pltr2;
01142 pltr_data = &cgrid2;
01143 }
01144 else
01145 {
01146 Tcl_AppendResult( interp,
01147 "Unrecognized coordinate transformation spec:",
01148 pltrname, ", must be pltr0 pltr1 or pltr2.",
01149 (char *) NULL );
01150 return TCL_ERROR;
01151 }
01152 if ( !arg3_is_kx )
01153 {
01154
01155 kx = 1; lx = nx;
01156 ky = 1; ly = ny;
01157 }
01158
01159
01160
01161
01162
01163
01164
01165
01166 plcont( (const PLFLT **) zused, nx, ny,
01167 kx, lx, ky, ly,
01168 matclev->fdata, nclev,
01169 pltr, pltr_data );
01170
01171
01172
01173
01174
01175
01176
01177 plFree2dGrid( zused, nx, ny );
01178
01179 if ( pltr == pltr1 )
01180 {
01181
01182
01183 }
01184 else if ( pltr == pltr2 )
01185 {
01186
01187 plFree2dGrid( cgrid2.xg, nx, ny );
01188 plFree2dGrid( cgrid2.yg, nx, ny );
01189 }
01190
01191 plflush();
01192 return TCL_OK;
01193 }
01194
01195
01196
01197
01198 static int
01199 plvectCmd( ClientData clientData, Tcl_Interp *interp,
01200 int argc, const char *argv[] )
01201 {
01202 tclMatrix *matPtr, *matu, *matv;
01203 PLINT nx, ny;
01204 const char *pltrname = "pltr0";
01205 tclMatrix *mattrx = NULL, *mattry = NULL;
01206 PLFLT **u, **v, **uused, **vused, **uwrapped, **vwrapped;
01207 PLFLT scaling;
01208
01209 int i, j;
01210 void ( *pltr )( PLFLT, PLFLT, PLFLT *, PLFLT *, PLPointer );
01211 PLPointer pltr_data = NULL;
01212 PLcGrid cgrid1;
01213 PLcGrid2 cgrid2;
01214
01215 int wrap = 0;
01216
01217 if ( argc < 3 )
01218 {
01219 Tcl_AppendResult( interp, "wrong # args: see documentation for ",
01220 argv[0], (char *) NULL );
01221 return TCL_ERROR;
01222 }
01223
01224 matu = Tcl_GetMatrixPtr( interp, argv[1] );
01225 if ( matu == NULL )
01226 return TCL_ERROR;
01227
01228 if ( matu->dim != 2 )
01229 {
01230 Tcl_SetResult( interp, "Must use 2-d data.", TCL_STATIC );
01231 return TCL_ERROR;
01232 }
01233 else
01234 {
01235 nx = matu->n[0];
01236 ny = matu->n[1];
01237 tclmateval_modx = nx;
01238 tclmateval_mody = ny;
01239
01240
01241
01242 plAlloc2dGrid( &u, nx, ny );
01243 for ( i = 0; i < nx; i++ )
01244 {
01245 for ( j = 0; j < ny; j++ )
01246 {
01247 u[i][j] = tclMatrix_feval( i, j, matu );
01248 }
01249 }
01250 }
01251
01252 matv = Tcl_GetMatrixPtr( interp, argv[2] );
01253 if ( matv == NULL )
01254 return TCL_ERROR;
01255
01256 if ( matv->dim != 2 )
01257 {
01258 Tcl_SetResult( interp, "Must use 2-d data.", TCL_STATIC );
01259 return TCL_ERROR;
01260 }
01261 else
01262 {
01263 nx = matv->n[0];
01264 ny = matv->n[1];
01265 tclmateval_modx = nx;
01266 tclmateval_mody = ny;
01267
01268
01269
01270 plAlloc2dGrid( &v, nx, ny );
01271 for ( i = 0; i < nx; i++ )
01272 {
01273 for ( j = 0; j < ny; j++ )
01274 {
01275 v[i][j] = tclMatrix_feval( i, j, matv );
01276 }
01277 }
01278 }
01279
01280 argc -= 3, argv += 3;
01281
01282
01283
01284 if ( argc < 1 )
01285 {
01286 Tcl_SetResult( interp, "plvect, bogus syntax", TCL_STATIC );
01287 return TCL_ERROR;
01288 }
01289
01290 scaling = atof( argv[0] );
01291 argc--, argv++;
01292
01293
01294
01295 if ( argc >= 3 )
01296 {
01297
01298 pltrname = argv[0];
01299 mattrx = Tcl_GetMatrixPtr( interp, argv[1] );
01300 if ( mattrx == NULL )
01301 return TCL_ERROR;
01302 mattry = Tcl_GetMatrixPtr( interp, argv[2] );
01303 if ( mattry == NULL )
01304 return TCL_ERROR;
01305
01306 argc -= 3, argv += 3;
01307 }
01308
01309 if ( argc )
01310 {
01311
01312 wrap = atoi( argv[0] );
01313
01314
01315
01316
01317 argc--, argv++;
01318 }
01319
01320
01321
01322 if ( argc )
01323 {
01324 Tcl_SetResult( interp, "plvect, bogus syntax, too many args.", TCL_STATIC );
01325 return TCL_ERROR;
01326 }
01327
01328
01329
01330 if ( !strcmp( pltrname, "pltr0" ) )
01331 {
01332 pltr = pltr0;
01333 uused = u;
01334 vused = v;
01335
01336
01337 if ( wrap )
01338 {
01339 Tcl_SetResult( interp, "Must use pltr2 if want wrapping.", TCL_STATIC );
01340 return TCL_ERROR;
01341 }
01342 }
01343 else if ( !strcmp( pltrname, "pltr1" ) )
01344 {
01345 pltr = pltr1;
01346 cgrid1.xg = mattrx->fdata;
01347 cgrid1.nx = nx;
01348 cgrid1.yg = mattry->fdata;
01349 cgrid1.ny = ny;
01350 uused = u;
01351 vused = v;
01352
01353
01354 if ( wrap )
01355 {
01356 Tcl_SetResult( interp, "Must use pltr2 if want wrapping.", TCL_STATIC );
01357 return TCL_ERROR;
01358 }
01359
01360 if ( mattrx->dim != 1 || mattry->dim != 1 )
01361 {
01362 Tcl_SetResult( interp, "Must use 1-d coord arrays with pltr1.", TCL_STATIC );
01363 return TCL_ERROR;
01364 }
01365
01366 pltr_data = &cgrid1;
01367 }
01368 else if ( !strcmp( pltrname, "pltr2" ) )
01369 {
01370
01371 if ( !wrap )
01372 {
01373
01374 plAlloc2dGrid( &cgrid2.xg, nx, ny );
01375 plAlloc2dGrid( &cgrid2.yg, nx, ny );
01376 cgrid2.nx = nx;
01377 cgrid2.ny = ny;
01378 uused = u;
01379 vused = v;
01380
01381 matPtr = mattrx;
01382 for ( i = 0; i < nx; i++ )
01383 for ( j = 0; j < ny; j++ )
01384 cgrid2.xg[i][j] = mattrx->fdata[ I2D( i, j ) ];
01385 matPtr = mattry;
01386 for ( i = 0; i < nx; i++ )
01387 {
01388 for ( j = 0; j < ny; j++ )
01389 {
01390 cgrid2.yg[i][j] = mattry->fdata[ I2D( i, j ) ];
01391 }
01392 }
01393 }
01394 else if ( wrap == 1 )
01395 {
01396 plAlloc2dGrid( &cgrid2.xg, nx + 1, ny );
01397 plAlloc2dGrid( &cgrid2.yg, nx + 1, ny );
01398 plAlloc2dGrid( &uwrapped, nx + 1, ny );
01399 plAlloc2dGrid( &vwrapped, nx + 1, ny );
01400 cgrid2.nx = nx + 1;
01401 cgrid2.ny = ny;
01402 uused = uwrapped;
01403 vused = vwrapped;
01404
01405
01406 matPtr = mattrx;
01407 for ( i = 0; i < nx; i++ )
01408 for ( j = 0; j < ny; j++ )
01409 cgrid2.xg[i][j] = mattrx->fdata[ I2D( i, j ) ];
01410
01411 matPtr = mattry;
01412 for ( i = 0; i < nx; i++ )
01413 {
01414 for ( j = 0; j < ny; j++ )
01415 {
01416 cgrid2.yg[i][j] = mattry->fdata[ I2D( i, j ) ];
01417 uwrapped[i][j] = u[i][j];
01418 vwrapped[i][j] = v[i][j];
01419 }
01420 }
01421
01422 for ( j = 0; j < ny; j++ )
01423 {
01424 cgrid2.xg[nx][j] = cgrid2.xg[0][j];
01425 cgrid2.yg[nx][j] = cgrid2.yg[0][j];
01426 uwrapped[nx][j] = uwrapped[0][j];
01427 vwrapped[nx][j] = vwrapped[0][j];
01428 }
01429
01430
01431
01432 plFree2dGrid( u, nx, ny );
01433 plFree2dGrid( v, nx, ny );
01434 nx++;
01435 }
01436 else if ( wrap == 2 )
01437 {
01438 plAlloc2dGrid( &cgrid2.xg, nx, ny + 1 );
01439 plAlloc2dGrid( &cgrid2.yg, nx, ny + 1 );
01440 plAlloc2dGrid( &uwrapped, nx, ny + 1 );
01441 plAlloc2dGrid( &vwrapped, nx, ny + 1 );
01442 cgrid2.nx = nx;
01443 cgrid2.ny = ny + 1;
01444 uused = uwrapped;
01445 vused = vwrapped;
01446
01447 matPtr = mattrx;
01448 for ( i = 0; i < nx; i++ )
01449 for ( j = 0; j < ny; j++ )
01450 cgrid2.xg[i][j] = mattrx->fdata[ I2D( i, j ) ];
01451
01452 matPtr = mattry;
01453 for ( i = 0; i < nx; i++ )
01454 {
01455 for ( j = 0; j < ny; j++ )
01456 {
01457 cgrid2.yg[i][j] = mattry->fdata[ I2D( i, j ) ];
01458 uwrapped[i][j] = u[i][j];
01459 vwrapped[i][j] = v[i][j];
01460 }
01461 }
01462
01463 for ( i = 0; i < nx; i++ )
01464 {
01465 cgrid2.xg[i][ny] = cgrid2.xg[i][0];
01466 cgrid2.yg[i][ny] = cgrid2.yg[i][0];
01467 uwrapped[i][ny] = uwrapped[i][0];
01468 vwrapped[i][ny] = vwrapped[i][0];
01469 }
01470
01471
01472
01473 plFree2dGrid( u, nx, ny );
01474 plFree2dGrid( v, nx, ny );
01475
01476 ny++;
01477 }
01478 else
01479 {
01480 Tcl_SetResult( interp, "Invalid wrap specifier, must be <empty>, 0, 1, or 2.", TCL_STATIC );
01481 return TCL_ERROR;
01482 }
01483
01484 pltr = pltr2;
01485 pltr_data = &cgrid2;
01486 }
01487 else
01488 {
01489 Tcl_AppendResult( interp,
01490 "Unrecognized coordinate transformation spec:",
01491 pltrname, ", must be pltr0 pltr1 or pltr2.",
01492 (char *) NULL );
01493 return TCL_ERROR;
01494 }
01495
01496
01497
01498
01499 plvect( (const PLFLT **) uused, (const PLFLT **) vused, nx, ny,
01500 scaling, pltr, pltr_data );
01501
01502
01503
01504
01505
01506
01507 plFree2dGrid( uused, nx, ny );
01508 plFree2dGrid( vused, nx, ny );
01509
01510 if ( pltr == pltr1 )
01511 {
01512
01513
01514 }
01515 else if ( pltr == pltr2 )
01516 {
01517
01518 plFree2dGrid( cgrid2.xg, nx, ny );
01519 plFree2dGrid( cgrid2.yg, nx, ny );
01520 }
01521
01522 plflush();
01523 return TCL_OK;
01524 }
01525
01526
01527
01528
01529
01530
01531
01532
01533
01534
01535
01536
01537
01538
01539
01540
01541
01542 static int
01543 plmeshCmd( ClientData clientData, Tcl_Interp *interp,
01544 int argc, const char *argv[] )
01545 {
01546 PLINT nx, ny, opt;
01547 PLFLT *x, *y, **z;
01548 tclMatrix *matx, *maty, *matz, *matPtr;
01549 int i;
01550
01551 if ( argc == 7 )
01552 {
01553 nx = atoi( argv[4] );
01554 ny = atoi( argv[5] );
01555 opt = atoi( argv[6] );
01556
01557 matx = Tcl_GetMatrixPtr( interp, argv[1] );
01558 if ( matx == NULL )
01559 return TCL_ERROR;
01560 maty = Tcl_GetMatrixPtr( interp, argv[2] );
01561 if ( maty == NULL )
01562 return TCL_ERROR;
01563 matz = Tcl_GetMatrixPtr( interp, argv[3] );
01564 if ( matz == NULL )
01565 return TCL_ERROR;
01566 matPtr = matz;
01567
01568 if ( matx->type != TYPE_FLOAT ||
01569 maty->type != TYPE_FLOAT ||
01570 matz->type != TYPE_FLOAT )
01571 {
01572 Tcl_SetResult( interp, "x y and z must all be float", TCL_STATIC );
01573 return TCL_ERROR;
01574 }
01575
01576 if ( matx->dim != 1 || matx->n[0] != nx ||
01577 maty->dim != 1 || maty->n[0] != ny ||
01578 matz->dim != 2 || matz->n[0] != nx || matz->n[1] != ny )
01579 {
01580 Tcl_SetResult( interp, "Inconsistent dimensions", TCL_STATIC );
01581 return TCL_ERROR;
01582 }
01583
01584 x = matx->fdata;
01585 y = maty->fdata;
01586
01587 z = (PLFLT **) malloc( nx * sizeof ( PLFLT * ) );
01588 for ( i = 0; i < nx; i++ )
01589 z[i] = &matz->fdata[ I2D( i, 0 ) ];
01590 }
01591 else if ( argc == 5 )
01592 {
01593 opt = atoi( argv[4] );
01594
01595 matx = Tcl_GetMatrixPtr( interp, argv[1] );
01596 if ( matx == NULL )
01597 return TCL_ERROR;
01598 maty = Tcl_GetMatrixPtr( interp, argv[2] );
01599 if ( maty == NULL )
01600 return TCL_ERROR;
01601 matz = Tcl_GetMatrixPtr( interp, argv[3] );
01602 if ( matz == NULL )
01603 return TCL_ERROR;
01604 matPtr = matz;
01605
01606 if ( matx->type != TYPE_FLOAT ||
01607 maty->type != TYPE_FLOAT ||
01608 matz->type != TYPE_FLOAT )
01609 {
01610 Tcl_SetResult( interp, "x y and z must all be float", TCL_STATIC );
01611 return TCL_ERROR;
01612 }
01613
01614 nx = matx->n[0]; ny = maty->n[0];
01615
01616 if ( matx->dim != 1 || matx->n[0] != nx ||
01617 maty->dim != 1 || maty->n[0] != ny ||
01618 matz->dim != 2 || matz->n[0] != nx || matz->n[1] != ny )
01619 {
01620 Tcl_SetResult( interp, "Inconsistent dimensions", TCL_STATIC );
01621 return TCL_ERROR;
01622 }
01623
01624 x = matx->fdata;
01625 y = maty->fdata;
01626
01627 z = (PLFLT **) malloc( nx * sizeof ( PLFLT * ) );
01628 for ( i = 0; i < nx; i++ )
01629 z[i] = &matz->fdata[ I2D( i, 0 ) ];
01630 }
01631 else if ( argc == 3 )
01632 {
01633 Tcl_SetResult( interp, "unimplemented", TCL_STATIC );
01634 return TCL_ERROR;
01635 }
01636 else
01637 {
01638 Tcl_AppendResult( interp, "wrong # args: should be \"plmesh ",
01639 "x y z nx ny opt\", or a valid contraction ",
01640 "thereof.", (char *) NULL );
01641 return TCL_ERROR;
01642 }
01643
01644 plmesh( x, y, (const PLFLT **) z, nx, ny, opt );
01645
01646 if ( argc == 7 )
01647 {
01648 free( z );
01649 }
01650 else if ( argc == 5 )
01651 {
01652 free( z );
01653 }
01654 else
01655 {
01656 }
01657
01658 plflush();
01659 return TCL_OK;
01660 }
01661
01662
01663
01664
01665
01666
01667
01668
01669
01670
01671
01672
01673
01674
01675
01676
01677
01678
01679
01680 static int
01681 plmeshcCmd( ClientData clientData, Tcl_Interp *interp,
01682 int argc, const char *argv[] )
01683 {
01684 PLINT nx, ny, opt, nlev = 10;
01685 PLFLT *x, *y, **z;
01686 PLFLT *clev;
01687
01688 tclMatrix *matx, *maty, *matz, *matPtr, *matlev;
01689 int i;
01690
01691 if ( argc == 9 )
01692 {
01693 nlev = atoi( argv[8] );
01694 nx = atoi( argv[4] );
01695 ny = atoi( argv[5] );
01696 opt = atoi( argv[6] );
01697
01698 matx = Tcl_GetMatrixPtr( interp, argv[1] );
01699 if ( matx == NULL )
01700 return TCL_ERROR;
01701 maty = Tcl_GetMatrixPtr( interp, argv[2] );
01702 if ( maty == NULL )
01703 return TCL_ERROR;
01704 matz = Tcl_GetMatrixPtr( interp, argv[3] );
01705 if ( matz == NULL )
01706 return TCL_ERROR;
01707 matPtr = matz;
01708
01709 matlev = Tcl_GetMatrixPtr( interp, argv[7] );
01710 if ( matlev == NULL )
01711 return TCL_ERROR;
01712
01713 if ( matx->type != TYPE_FLOAT ||
01714 maty->type != TYPE_FLOAT ||
01715 matz->type != TYPE_FLOAT ||
01716 matlev->type != TYPE_FLOAT )
01717 {
01718 Tcl_SetResult( interp, "x y z and clevel must all be float", TCL_STATIC );
01719 return TCL_ERROR;
01720 }
01721
01722 if ( matx->dim != 1 || matx->n[0] != nx ||
01723 maty->dim != 1 || maty->n[0] != ny ||
01724 matz->dim != 2 || matz->n[0] != nx || matz->n[1] != ny ||
01725 matlev->dim != 1 || matlev->n[0] != nlev )
01726 {
01727 Tcl_SetResult( interp, "popo Inconsistent dimensions", TCL_STATIC );
01728 return TCL_ERROR;
01729 }
01730
01731 x = matx->fdata;
01732 y = maty->fdata;
01733 clev = matlev->fdata;
01734
01735 z = (PLFLT **) malloc( nx * sizeof ( PLFLT * ) );
01736 for ( i = 0; i < nx; i++ )
01737 z[i] = &matz->fdata[ I2D( i, 0 ) ];
01738 }
01739
01740 else if ( argc == 8 )
01741 {
01742 nx = atoi( argv[4] );
01743 ny = atoi( argv[5] );
01744 opt = atoi( argv[6] );
01745
01746 matx = Tcl_GetMatrixPtr( interp, argv[1] );
01747 if ( matx == NULL )
01748 return TCL_ERROR;
01749 maty = Tcl_GetMatrixPtr( interp, argv[2] );
01750 if ( maty == NULL )
01751 return TCL_ERROR;
01752 matz = Tcl_GetMatrixPtr( interp, argv[3] );
01753 if ( matz == NULL )
01754 return TCL_ERROR;
01755 matPtr = matz;
01756 matlev = Tcl_GetMatrixPtr( interp, argv[7] );
01757 if ( matlev == NULL )
01758 return TCL_ERROR;
01759
01760 if ( matx->type != TYPE_FLOAT ||
01761 maty->type != TYPE_FLOAT ||
01762 matz->type != TYPE_FLOAT ||
01763 matlev->type != TYPE_FLOAT )
01764 {
01765 Tcl_SetResult( interp, "x y z and clevel must all be float", TCL_STATIC );
01766 return TCL_ERROR;
01767 }
01768
01769 if ( matx->dim != 1 || matx->n[0] != nx ||
01770 maty->dim != 1 || maty->n[0] != ny ||
01771 matz->dim != 2 || matz->n[0] != nx || matz->n[1] != ny ||
01772 matlev->dim != 1 || matlev->n[0] != nlev )
01773 {
01774 Tcl_SetResult( interp, "Inconsistent dimensions", TCL_STATIC );
01775 return TCL_ERROR;
01776 }
01777
01778 x = matx->fdata;
01779 y = maty->fdata;
01780 clev = matlev->fdata;
01781 nlev = matlev->n[0];
01782
01783 z = (PLFLT **) malloc( nx * sizeof ( PLFLT * ) );
01784 for ( i = 0; i < nx; i++ )
01785 z[i] = &matz->fdata[ I2D( i, 0 ) ];
01786 }
01787
01788 else if ( argc == 7 )
01789 {
01790 nx = atoi( argv[4] );
01791 ny = atoi( argv[5] );
01792 opt = atoi( argv[6] );
01793 clev = NULL;
01794
01795 matx = Tcl_GetMatrixPtr( interp, argv[1] );
01796 if ( matx == NULL )
01797 return TCL_ERROR;
01798 maty = Tcl_GetMatrixPtr( interp, argv[2] );
01799 if ( maty == NULL )
01800 return TCL_ERROR;
01801 matz = Tcl_GetMatrixPtr( interp, argv[3] );
01802 if ( matz == NULL )
01803 return TCL_ERROR;
01804 matPtr = matz;
01805
01806 if ( matx->type != TYPE_FLOAT ||
01807 maty->type != TYPE_FLOAT ||
01808 matz->type != TYPE_FLOAT )
01809 {
01810 Tcl_SetResult( interp, "x y and z must all be float", TCL_STATIC );
01811 return TCL_ERROR;
01812 }
01813
01814 if ( matx->dim != 1 || matx->n[0] != nx ||
01815 maty->dim != 1 || maty->n[0] != ny ||
01816 matz->dim != 2 || matz->n[0] != nx || matz->n[1] != ny )
01817 {
01818 Tcl_SetResult( interp, "Inconsistent dimensions", TCL_STATIC );
01819 return TCL_ERROR;
01820 }
01821
01822 x = matx->fdata;
01823 y = maty->fdata;
01824
01825 z = (PLFLT **) malloc( nx * sizeof ( PLFLT * ) );
01826 for ( i = 0; i < nx; i++ )
01827 z[i] = &matz->fdata[ I2D( i, 0 ) ];
01828 }
01829 else if ( argc == 5 )
01830 {
01831 opt = atoi( argv[4] );
01832 clev = NULL;
01833
01834 matx = Tcl_GetMatrixPtr( interp, argv[1] );
01835 if ( matx == NULL )
01836 return TCL_ERROR;
01837 maty = Tcl_GetMatrixPtr( interp, argv[2] );
01838 if ( maty == NULL )
01839 return TCL_ERROR;
01840 matz = Tcl_GetMatrixPtr( interp, argv[3] );
01841 if ( matz == NULL )
01842 return TCL_ERROR;
01843 matPtr = matz;
01844
01845 if ( matx->type != TYPE_FLOAT ||
01846 maty->type != TYPE_FLOAT ||
01847 matz->type != TYPE_FLOAT )
01848 {
01849 Tcl_SetResult( interp, "x y and z must all be float", TCL_STATIC );
01850 return TCL_ERROR;
01851 }
01852
01853 nx = matx->n[0]; ny = maty->n[0];
01854
01855 if ( matx->dim != 1 || matx->n[0] != nx ||
01856 maty->dim != 1 || maty->n[0] != ny ||
01857 matz->dim != 2 || matz->n[0] != nx || matz->n[1] != ny )
01858 {
01859 Tcl_SetResult( interp, "Inconsistent dimensions", TCL_STATIC );
01860 return TCL_ERROR;
01861 }
01862
01863 x = matx->fdata;
01864 y = maty->fdata;
01865
01866 z = (PLFLT **) malloc( nx * sizeof ( PLFLT * ) );
01867 for ( i = 0; i < nx; i++ )
01868 z[i] = &matz->fdata[ I2D( i, 0 ) ];
01869 }
01870 else if ( argc == 3 )
01871 {
01872 Tcl_SetResult( interp, "unimplemented", TCL_STATIC );
01873 return TCL_ERROR;
01874 }
01875 else
01876 {
01877 Tcl_AppendResult( interp, "wrong # args: should be \"plmeshc ",
01878 "x y z nx ny opt clevel nlevel\", or a valid contraction ",
01879 "thereof.", (char *) NULL );
01880 return TCL_ERROR;
01881 }
01882
01883 plmeshc( x, y, (const PLFLT **) z, nx, ny, opt, clev, nlev );
01884
01885 if ( argc == 7 )
01886 {
01887 free( z );
01888 }
01889 else if ( argc == 5 )
01890 {
01891 free( z );
01892 }
01893 else
01894 {
01895 }
01896
01897 plflush();
01898 return TCL_OK;
01899 }
01900
01901
01902
01903
01904
01905
01906
01907
01908
01909
01910
01911
01912
01913
01914
01915
01916 static int
01917 plot3dCmd( ClientData clientData, Tcl_Interp *interp,
01918 int argc, const char *argv[] )
01919 {
01920 PLINT nx, ny, opt, side;
01921 PLFLT *x, *y, **z;
01922 tclMatrix *matx, *maty, *matz, *matPtr;
01923 int i;
01924
01925 if ( argc == 8 )
01926 {
01927 nx = atoi( argv[4] );
01928 ny = atoi( argv[5] );
01929 opt = atoi( argv[6] );
01930 side = atoi( argv[7] );
01931
01932 matx = Tcl_GetMatrixPtr( interp, argv[1] );
01933 if ( matx == NULL )
01934 return TCL_ERROR;
01935 maty = Tcl_GetMatrixPtr( interp, argv[2] );
01936 if ( maty == NULL )
01937 return TCL_ERROR;
01938 matz = Tcl_GetMatrixPtr( interp, argv[3] );
01939 if ( matz == NULL )
01940 return TCL_ERROR;
01941 matPtr = matz;
01942
01943 if ( matx->type != TYPE_FLOAT ||
01944 maty->type != TYPE_FLOAT ||
01945 matz->type != TYPE_FLOAT )
01946 {
01947 Tcl_SetResult( interp, "x y and z must all be float", TCL_STATIC );
01948 return TCL_ERROR;
01949 }
01950
01951 if ( matx->dim != 1 || matx->n[0] != nx ||
01952 maty->dim != 1 || maty->n[0] != ny ||
01953 matz->dim != 2 || matz->n[0] != nx || matz->n[1] != ny )
01954 {
01955 Tcl_SetResult( interp, "Inconsistent dimensions", TCL_STATIC );
01956 return TCL_ERROR;
01957 }
01958
01959 x = matx->fdata;
01960 y = maty->fdata;
01961
01962 z = (PLFLT **) malloc( nx * sizeof ( PLFLT * ) );
01963 for ( i = 0; i < nx; i++ )
01964 z[i] = &matz->fdata[ I2D( i, 0 ) ];
01965 }
01966 else if ( argc == 6 )
01967 {
01968 opt = atoi( argv[4] );
01969 side = atoi( argv[5] );
01970
01971 matx = Tcl_GetMatrixPtr( interp, argv[1] );
01972 if ( matx == NULL )
01973 return TCL_ERROR;
01974 maty = Tcl_GetMatrixPtr( interp, argv[2] );
01975 if ( maty == NULL )
01976 return TCL_ERROR;
01977 matz = Tcl_GetMatrixPtr( interp, argv[3] );
01978 if ( matz == NULL )
01979 return TCL_ERROR;
01980 matPtr = matz;
01981
01982 if ( matx->type != TYPE_FLOAT ||
01983 maty->type != TYPE_FLOAT ||
01984 matz->type != TYPE_FLOAT )
01985 {
01986 Tcl_SetResult( interp, "x y and z must all be float", TCL_STATIC );
01987 return TCL_ERROR;
01988 }
01989
01990 nx = matx->n[0]; ny = maty->n[0];
01991
01992 if ( matx->dim != 1 || matx->n[0] != nx ||
01993 maty->dim != 1 || maty->n[0] != ny ||
01994 matz->dim != 2 || matz->n[0] != nx || matz->n[1] != ny )
01995 {
01996 Tcl_SetResult( interp, "Inconsistent dimensions", TCL_STATIC );
01997 return TCL_ERROR;
01998 }
01999
02000 x = matx->fdata;
02001 y = maty->fdata;
02002
02003 z = (PLFLT **) malloc( nx * sizeof ( PLFLT * ) );
02004 for ( i = 0; i < nx; i++ )
02005 z[i] = &matz->fdata[ I2D( i, 0 ) ];
02006 }
02007 else if ( argc == 4 )
02008 {
02009 Tcl_SetResult( interp, "unimplemented", TCL_STATIC );
02010 return TCL_ERROR;
02011 }
02012 else
02013 {
02014 Tcl_AppendResult( interp, "wrong # args: should be \"plot3d ",
02015 "x y z nx ny opt side\", or a valid contraction ",
02016 "thereof.", (char *) NULL );
02017 return TCL_ERROR;
02018 }
02019
02020 plot3d( x, y, (const PLFLT **) z, nx, ny, opt, side );
02021
02022 if ( argc == 8 )
02023 {
02024 free( z );
02025 }
02026 else if ( argc == 6 )
02027 {
02028 free( z );
02029 }
02030 else
02031 {
02032 }
02033
02034 plflush();
02035 return TCL_OK;
02036 }
02037
02038
02039
02040
02041
02042
02043
02044
02045
02046
02047
02048
02049
02050
02051
02052
02053
02054
02055
02056 static int
02057 plot3dcCmd( ClientData clientData, Tcl_Interp *interp,
02058 int argc, const char *argv[] )
02059 {
02060 PLINT nx, ny, opt, nlev = 10;
02061 PLFLT *x, *y, **z;
02062 PLFLT *clev;
02063
02064 tclMatrix *matx, *maty, *matz, *matPtr, *matlev;
02065 int i;
02066
02067 if ( argc == 9 )
02068 {
02069 nlev = atoi( argv[8] );
02070 nx = atoi( argv[4] );
02071 ny = atoi( argv[5] );
02072 opt = atoi( argv[6] );
02073
02074 matx = Tcl_GetMatrixPtr( interp, argv[1] );
02075 if ( matx == NULL )
02076 return TCL_ERROR;
02077 maty = Tcl_GetMatrixPtr( interp, argv[2] );
02078 if ( maty == NULL )
02079 return TCL_ERROR;
02080 matz = Tcl_GetMatrixPtr( interp, argv[3] );
02081 if ( matz == NULL )
02082 return TCL_ERROR;
02083 matPtr = matz;
02084
02085 matlev = Tcl_GetMatrixPtr( interp, argv[7] );
02086 if ( matlev == NULL )
02087 return TCL_ERROR;
02088
02089 if ( matx->type != TYPE_FLOAT ||
02090 maty->type != TYPE_FLOAT ||
02091 matz->type != TYPE_FLOAT ||
02092 matlev->type != TYPE_FLOAT )
02093 {
02094 Tcl_SetResult( interp, "x y z and clevel must all be float", TCL_STATIC );
02095 return TCL_ERROR;
02096 }
02097
02098 if ( matx->dim != 1 || matx->n[0] != nx ||
02099 maty->dim != 1 || maty->n[0] != ny ||
02100 matz->dim != 2 || matz->n[0] != nx || matz->n[1] != ny ||
02101 matlev->dim != 1 || matlev->n[0] != nlev )
02102 {
02103 Tcl_SetResult( interp, "popo Inconsistent dimensions", TCL_STATIC );
02104 return TCL_ERROR;
02105 }
02106
02107 x = matx->fdata;
02108 y = maty->fdata;
02109 clev = matlev->fdata;
02110
02111 z = (PLFLT **) malloc( nx * sizeof ( PLFLT * ) );
02112 for ( i = 0; i < nx; i++ )
02113 z[i] = &matz->fdata[ I2D( i, 0 ) ];
02114 }
02115
02116 else if ( argc == 8 )
02117 {
02118 nx = atoi( argv[4] );
02119 ny = atoi( argv[5] );
02120 opt = atoi( argv[6] );
02121
02122 matx = Tcl_GetMatrixPtr( interp, argv[1] );
02123 if ( matx == NULL )
02124 return TCL_ERROR;
02125 maty = Tcl_GetMatrixPtr( interp, argv[2] );
02126 if ( maty == NULL )
02127 return TCL_ERROR;
02128 matz = Tcl_GetMatrixPtr( interp, argv[3] );
02129 if ( matz == NULL )
02130 return TCL_ERROR;
02131 matPtr = matz;
02132 matlev = Tcl_GetMatrixPtr( interp, argv[7] );
02133 if ( matlev == NULL )
02134 return TCL_ERROR;
02135
02136 if ( matx->type != TYPE_FLOAT ||
02137 maty->type != TYPE_FLOAT ||
02138 matz->type != TYPE_FLOAT ||
02139 matlev->type != TYPE_FLOAT )
02140 {
02141 Tcl_SetResult( interp, "x y z and clevel must all be float", TCL_STATIC );
02142 return TCL_ERROR;
02143 }
02144
02145 if ( matx->dim != 1 || matx->n[0] != nx ||
02146 maty->dim != 1 || maty->n[0] != ny ||
02147 matz->dim != 2 || matz->n[0] != nx || matz->n[1] != ny ||
02148 matlev->dim != 1 || matlev->n[0] != nlev )
02149 {
02150 Tcl_SetResult( interp, "Inconsistent dimensions", TCL_STATIC );
02151 return TCL_ERROR;
02152 }
02153
02154 x = matx->fdata;
02155 y = maty->fdata;
02156 clev = matlev->fdata;
02157 nlev = matlev->n[0];
02158
02159 z = (PLFLT **) malloc( nx * sizeof ( PLFLT * ) );
02160 for ( i = 0; i < nx; i++ )
02161 z[i] = &matz->fdata[ I2D( i, 0 ) ];
02162 }
02163
02164 else if ( argc == 7 )
02165 {
02166 nx = atoi( argv[4] );
02167 ny = atoi( argv[5] );
02168 opt = atoi( argv[6] );
02169 clev = NULL;
02170
02171 matx = Tcl_GetMatrixPtr( interp, argv[1] );
02172 if ( matx == NULL )
02173 return TCL_ERROR;
02174 maty = Tcl_GetMatrixPtr( interp, argv[2] );
02175 if ( maty == NULL )
02176 return TCL_ERROR;
02177 matz = Tcl_GetMatrixPtr( interp, argv[3] );
02178 if ( matz == NULL )
02179 return TCL_ERROR;
02180 matPtr = matz;
02181
02182 if ( matx->type != TYPE_FLOAT ||
02183 maty->type != TYPE_FLOAT ||
02184 matz->type != TYPE_FLOAT )
02185 {
02186 Tcl_SetResult( interp, "x y and z must all be float", TCL_STATIC );
02187 return TCL_ERROR;
02188 }
02189
02190 if ( matx->dim != 1 || matx->n[0] != nx ||
02191 maty->dim != 1 || maty->n[0] != ny ||
02192 matz->dim != 2 || matz->n[0] != nx || matz->n[1] != ny )
02193 {
02194 Tcl_SetResult( interp, "Inconsistent dimensions", TCL_STATIC );
02195 return TCL_ERROR;
02196 }
02197
02198 x = matx->fdata;
02199 y = maty->fdata;
02200
02201 z = (PLFLT **) malloc( nx * sizeof ( PLFLT * ) );
02202 for ( i = 0; i < nx; i++ )
02203 z[i] = &matz->fdata[ I2D( i, 0 ) ];
02204 }
02205 else if ( argc == 5 )
02206 {
02207 opt = atoi( argv[4] );
02208 clev = NULL;
02209
02210 matx = Tcl_GetMatrixPtr( interp, argv[1] );
02211 if ( matx == NULL )
02212 return TCL_ERROR;
02213 maty = Tcl_GetMatrixPtr( interp, argv[2] );
02214 if ( maty == NULL )
02215 return TCL_ERROR;
02216 matz = Tcl_GetMatrixPtr( interp, argv[3] );
02217 if ( matz == NULL )
02218 return TCL_ERROR;
02219 matPtr = matz;
02220
02221 if ( matx->type != TYPE_FLOAT ||
02222 maty->type != TYPE_FLOAT ||
02223 matz->type != TYPE_FLOAT )
02224 {
02225 Tcl_SetResult( interp, "x y and z must all be float", TCL_STATIC );
02226 return TCL_ERROR;
02227 }
02228
02229 nx = matx->n[0]; ny = maty->n[0];
02230
02231 if ( matx->dim != 1 || matx->n[0] != nx ||
02232 maty->dim != 1 || maty->n[0] != ny ||
02233 matz->dim != 2 || matz->n[0] != nx || matz->n[1] != ny )
02234 {
02235 Tcl_SetResult( interp, "Inconsistent dimensions", TCL_STATIC );
02236 return TCL_ERROR;
02237 }
02238
02239 x = matx->fdata;
02240 y = maty->fdata;
02241
02242 z = (PLFLT **) malloc( nx * sizeof ( PLFLT * ) );
02243 for ( i = 0; i < nx; i++ )
02244 z[i] = &matz->fdata[ I2D( i, 0 ) ];
02245 }
02246 else if ( argc == 3 )
02247 {
02248 Tcl_SetResult( interp, "unimplemented", TCL_STATIC );
02249 return TCL_ERROR;
02250 }
02251 else
02252 {
02253 Tcl_AppendResult( interp, "wrong # args: should be \"plot3dc ",
02254 "x y z nx ny opt clevel nlevel\", or a valid contraction ",
02255 "thereof.", (char *) NULL );
02256 return TCL_ERROR;
02257 }
02258
02259 plot3dc( x, y, (const PLFLT **) z, nx, ny, opt, clev, nlev );
02260
02261 if ( argc == 7 )
02262 {
02263 free( z );
02264 }
02265 else if ( argc == 5 )
02266 {
02267 free( z );
02268 }
02269 else
02270 {
02271 }
02272
02273 plflush();
02274 return TCL_OK;
02275 }
02276
02277
02278
02279
02280
02281
02282
02283
02284
02285
02286
02287
02288
02289
02290
02291
02292
02293
02294
02295 static int
02296 plsurf3dCmd( ClientData clientData, Tcl_Interp *interp,
02297 int argc, const char *argv[] )
02298 {
02299 PLINT nx, ny, opt, nlev = 10;
02300 PLFLT *x, *y, **z;
02301 PLFLT *clev;
02302
02303 tclMatrix *matx, *maty, *matz, *matPtr, *matlev;
02304 int i;
02305
02306 if ( argc == 9 )
02307 {
02308 nlev = atoi( argv[8] );
02309 nx = atoi( argv[4] );
02310 ny = atoi( argv[5] );
02311 opt = atoi( argv[6] );
02312
02313 matx = Tcl_GetMatrixPtr( interp, argv[1] );
02314 if ( matx == NULL )
02315 return TCL_ERROR;
02316 maty = Tcl_GetMatrixPtr( interp, argv[2] );
02317 if ( maty == NULL )
02318 return TCL_ERROR;
02319 matz = Tcl_GetMatrixPtr( interp, argv[3] );
02320 if ( matz == NULL )
02321 return TCL_ERROR;
02322 matPtr = matz;
02323
02324 matlev = Tcl_GetMatrixPtr( interp, argv[7] );
02325 if ( matlev == NULL )
02326 return TCL_ERROR;
02327
02328 if ( matx->type != TYPE_FLOAT ||
02329 maty->type != TYPE_FLOAT ||
02330 matz->type != TYPE_FLOAT ||
02331 matlev->type != TYPE_FLOAT )
02332 {
02333 Tcl_SetResult( interp, "x y z and clevel must all be float", TCL_STATIC );
02334 return TCL_ERROR;
02335 }
02336
02337 if ( matx->dim != 1 || matx->n[0] != nx ||
02338 maty->dim != 1 || maty->n[0] != ny ||
02339 matz->dim != 2 || matz->n[0] != nx || matz->n[1] != ny ||
02340 matlev->dim != 1 || matlev->n[0] != nlev )
02341 {
02342 Tcl_SetResult( interp, "popo Inconsistent dimensions", TCL_STATIC );
02343 return TCL_ERROR;
02344 }
02345
02346 x = matx->fdata;
02347 y = maty->fdata;
02348 clev = matlev->fdata;
02349
02350 z = (PLFLT **) malloc( nx * sizeof ( PLFLT * ) );
02351 for ( i = 0; i < nx; i++ )
02352 z[i] = &matz->fdata[ I2D( i, 0 ) ];
02353 }
02354
02355 else if ( argc == 8 )
02356 {
02357 nx = atoi( argv[4] );
02358 ny = atoi( argv[5] );
02359 opt = atoi( argv[6] );
02360
02361 matx = Tcl_GetMatrixPtr( interp, argv[1] );
02362 if ( matx == NULL )
02363 return TCL_ERROR;
02364 maty = Tcl_GetMatrixPtr( interp, argv[2] );
02365 if ( maty == NULL )
02366 return TCL_ERROR;
02367 matz = Tcl_GetMatrixPtr( interp, argv[3] );
02368 if ( matz == NULL )
02369 return TCL_ERROR;
02370 matPtr = matz;
02371 matlev = Tcl_GetMatrixPtr( interp, argv[7] );
02372 if ( matlev == NULL )
02373 return TCL_ERROR;
02374
02375 if ( matx->type != TYPE_FLOAT ||
02376 maty->type != TYPE_FLOAT ||
02377 matz->type != TYPE_FLOAT ||
02378 matlev->type != TYPE_FLOAT )
02379 {
02380 Tcl_SetResult( interp, "x y z and clevel must all be float", TCL_STATIC );
02381 return TCL_ERROR;
02382 }
02383
02384 if ( matx->dim != 1 || matx->n[0] != nx ||
02385 maty->dim != 1 || maty->n[0] != ny ||
02386 matz->dim != 2 || matz->n[0] != nx || matz->n[1] != ny ||
02387 matlev->dim != 1 || matlev->n[0] != nlev )
02388 {
02389 Tcl_SetResult( interp, "Inconsistent dimensions", TCL_STATIC );
02390 return TCL_ERROR;
02391 }
02392
02393 x = matx->fdata;
02394 y = maty->fdata;
02395 clev = matlev->fdata;
02396 nlev = matlev->n[0];
02397
02398 z = (PLFLT **) malloc( nx * sizeof ( PLFLT * ) );
02399 for ( i = 0; i < nx; i++ )
02400 z[i] = &matz->fdata[ I2D( i, 0 ) ];
02401 }
02402
02403 else if ( argc == 7 )
02404 {
02405 nx = atoi( argv[4] );
02406 ny = atoi( argv[5] );
02407 opt = atoi( argv[6] );
02408 clev = NULL;
02409
02410 matx = Tcl_GetMatrixPtr( interp, argv[1] );
02411 if ( matx == NULL )
02412 return TCL_ERROR;
02413 maty = Tcl_GetMatrixPtr( interp, argv[2] );
02414 if ( maty == NULL )
02415 return TCL_ERROR;
02416 matz = Tcl_GetMatrixPtr( interp, argv[3] );
02417 if ( matz == NULL )
02418 return TCL_ERROR;
02419 matPtr = matz;
02420
02421 if ( matx->type != TYPE_FLOAT ||
02422 maty->type != TYPE_FLOAT ||
02423 matz->type != TYPE_FLOAT )
02424 {
02425 Tcl_SetResult( interp, "x y and z must all be float", TCL_STATIC );
02426 return TCL_ERROR;
02427 }
02428
02429 if ( matx->dim != 1 || matx->n[0] != nx ||
02430 maty->dim != 1 || maty->n[0] != ny ||
02431 matz->dim != 2 || matz->n[0] != nx || matz->n[1] != ny )
02432 {
02433 Tcl_SetResult( interp, "Inconsistent dimensions", TCL_STATIC );
02434 return TCL_ERROR;
02435 }
02436
02437 x = matx->fdata;
02438 y = maty->fdata;
02439
02440 z = (PLFLT **) malloc( nx * sizeof ( PLFLT * ) );
02441 for ( i = 0; i < nx; i++ )
02442 z[i] = &matz->fdata[ I2D( i, 0 ) ];
02443 }
02444 else if ( argc == 5 )
02445 {
02446 opt = atoi( argv[4] );
02447 clev = NULL;
02448
02449 matx = Tcl_GetMatrixPtr( interp, argv[1] );
02450 if ( matx == NULL )
02451 return TCL_ERROR;
02452 maty = Tcl_GetMatrixPtr( interp, argv[2] );
02453 if ( maty == NULL )
02454 return TCL_ERROR;
02455 matz = Tcl_GetMatrixPtr( interp, argv[3] );
02456 if ( matz == NULL )
02457 return TCL_ERROR;
02458 matPtr = matz;
02459
02460 if ( matx->type != TYPE_FLOAT ||
02461 maty->type != TYPE_FLOAT ||
02462 matz->type != TYPE_FLOAT )
02463 {
02464 Tcl_SetResult( interp, "x y and z must all be float", TCL_STATIC );
02465 return TCL_ERROR;
02466 }
02467
02468 nx = matx->n[0]; ny = maty->n[0];
02469
02470 if ( matx->dim != 1 || matx->n[0] != nx ||
02471 maty->dim != 1 || maty->n[0] != ny ||
02472 matz->dim != 2 || matz->n[0] != nx || matz->n[1] != ny )
02473 {
02474 Tcl_SetResult( interp, "Inconsistent dimensions", TCL_STATIC );
02475 return TCL_ERROR;
02476 }
02477
02478 x = matx->fdata;
02479 y = maty->fdata;
02480
02481 z = (PLFLT **) malloc( nx * sizeof ( PLFLT * ) );
02482 for ( i = 0; i < nx; i++ )
02483 z[i] = &matz->fdata[ I2D( i, 0 ) ];
02484 }
02485 else if ( argc == 3 )
02486 {
02487 Tcl_SetResult( interp, "unimplemented", TCL_STATIC );
02488 return TCL_ERROR;
02489 }
02490 else
02491 {
02492 Tcl_AppendResult( interp, "wrong # args: should be \"plsurf3d ",
02493 "x y z nx ny opt clevel nlevel\", or a valid contraction ",
02494 "thereof.", (char *) NULL );
02495 return TCL_ERROR;
02496 }
02497
02498 plsurf3d( x, y, (const PLFLT **) z, nx, ny, opt, clev, nlev );
02499
02500 if ( argc == 7 )
02501 {
02502 free( z );
02503 }
02504 else if ( argc == 5 )
02505 {
02506 free( z );
02507 }
02508 else
02509 {
02510 }
02511
02512 plflush();
02513 return TCL_OK;
02514 }
02515
02516
02517
02518
02519
02520
02521
02522 static int
02523 plranddCmd( ClientData clientData, Tcl_Interp *interp,
02524 int argc, const char **argv )
02525 {
02526 if ( argc != 1 )
02527 {
02528 Tcl_AppendResult( interp, "wrong # args: ",
02529 argv[0], " takes no arguments", (char *) NULL );
02530 return TCL_ERROR;
02531 }
02532 else
02533 {
02534 Tcl_SetObjResult( interp, Tcl_NewDoubleObj( plrandd() ) );
02535 return TCL_OK;
02536 }
02537 }
02538
02539
02540
02541
02542
02543
02544
02545 static int
02546 plsetoptCmd( ClientData clientData, Tcl_Interp *interp,
02547 int argc, const char **argv )
02548 {
02549 if ( argc < 2 || argc > 3 )
02550 {
02551 Tcl_AppendResult( interp, "wrong # args: should be \"",
02552 argv[0], " option ?argument?\"", (char *) NULL );
02553 return TCL_ERROR;
02554 }
02555
02556 plsetopt( argv[1], argv[2] );
02557
02558 plflush();
02559 return TCL_OK;
02560 }
02561
02562
02563
02564
02565
02566
02567
02568
02569
02570
02571
02572
02573
02574
02575
02576
02577
02578
02579
02580
02581
02582
02583
02584
02585
02586
02587 static int
02588 plshadeCmd( ClientData clientData, Tcl_Interp *interp,
02589 int argc, const char *argv[] )
02590 {
02591 tclMatrix *matPtr, *matz, *mattrx = NULL, *mattry = NULL;
02592 PLFLT **z, **zused, **zwrapped;
02593 PLFLT xmin, xmax, ymin, ymax, sh_min, sh_max, sh_col;
02594
02595 PLINT sh_cmap = 1, sh_wid = 2;
02596 PLINT min_col = 1, min_wid = 0, max_col = 0, max_wid = 0;
02597 PLINT rect = 1;
02598 const char *pltrname = "pltr0";
02599 void ( *pltr )( PLFLT, PLFLT, PLFLT *, PLFLT *, PLPointer );
02600 PLPointer pltr_data = NULL;
02601 PLcGrid cgrid1;
02602 PLcGrid2 cgrid2;
02603 PLINT wrap = 0;
02604 int nx, ny, i, j;
02605
02606 if ( argc < 16 )
02607 {
02608 Tcl_AppendResult( interp, "bogus syntax for plshade, see doc.",
02609 (char *) NULL );
02610 return TCL_ERROR;
02611 }
02612
02613 matz = Tcl_GetMatrixPtr( interp, argv[1] );
02614 if ( matz == NULL )
02615 return TCL_ERROR;
02616 if ( matz->dim != 2 )
02617 {
02618 Tcl_SetResult( interp, "Must plot a 2-d matrix.", TCL_STATIC );
02619 return TCL_ERROR;
02620 }
02621
02622 nx = matz->n[0];
02623 ny = matz->n[1];
02624
02625 tclmateval_modx = nx;
02626 tclmateval_mody = ny;
02627
02628
02629
02630 plAlloc2dGrid( &z, nx, ny );
02631 for ( i = 0; i < nx; i++ )
02632 {
02633 for ( j = 0; j < ny; j++ )
02634 {
02635 z[i][j] = tclMatrix_feval( i, j, matz );
02636 }
02637 }
02638
02639 xmin = atof( argv[2] );
02640 xmax = atof( argv[3] );
02641 ymin = atof( argv[4] );
02642 ymax = atof( argv[5] );
02643 sh_min = atof( argv[6] );
02644 sh_max = atof( argv[7] );
02645 sh_cmap = atoi( argv[8] );
02646 sh_col = atof( argv[9] );
02647 sh_wid = atoi( argv[10] );
02648 min_col = atoi( argv[11] );
02649 min_wid = atoi( argv[12] );
02650 max_col = atoi( argv[13] );
02651 max_wid = atoi( argv[14] );
02652 rect = atoi( argv[15] );
02653
02654 argc -= 16, argv += 16;
02655
02656 if ( argc >= 3 )
02657 {
02658 pltrname = argv[0];
02659 mattrx = Tcl_GetMatrixPtr( interp, argv[1] );
02660 if ( mattrx == NULL )
02661 return TCL_ERROR;
02662 mattry = Tcl_GetMatrixPtr( interp, argv[2] );
02663 if ( mattry == NULL )
02664 return TCL_ERROR;
02665
02666 argc -= 3, argv += 3;
02667 }
02668 else if ( argc && !strcmp( argv[0], "NULL" ) )
02669 {
02670 pltrname = argv[0];
02671 argc -= 1, argv += 1;
02672 }
02673
02674 if ( argc )
02675 {
02676 wrap = atoi( argv[0] );
02677 argc--, argv++;
02678 }
02679
02680 if ( argc )
02681 {
02682 Tcl_SetResult( interp, "plshade: bogus arg list", TCL_STATIC );
02683 return TCL_ERROR;
02684 }
02685
02686
02687
02688
02689 if ( !strcmp( pltrname, "NULL" ) )
02690 {
02691 pltr = NULL;
02692 zused = z;
02693
02694
02695 if ( wrap )
02696 {
02697 Tcl_SetResult( interp, "Must use pltr2 if want wrapping.", TCL_STATIC );
02698 return TCL_ERROR;
02699 }
02700 }
02701 else if ( !strcmp( pltrname, "pltr0" ) )
02702 {
02703 pltr = pltr0;
02704 zused = z;
02705
02706
02707 if ( wrap )
02708 {
02709 Tcl_SetResult( interp, "Must use pltr2 if want wrapping.", TCL_STATIC );
02710 return TCL_ERROR;
02711 }
02712 }
02713 else if ( !strcmp( pltrname, "pltr1" ) )
02714 {
02715 pltr = pltr1;
02716 cgrid1.xg = mattrx->fdata;
02717 cgrid1.nx = nx;
02718 cgrid1.yg = mattry->fdata;
02719 cgrid1.ny = ny;
02720 zused = z;
02721
02722
02723 if ( wrap )
02724 {
02725 Tcl_SetResult( interp, "Must use pltr2 if want wrapping.", TCL_STATIC );
02726 return TCL_ERROR;
02727 }
02728
02729 if ( mattrx->dim != 1 || mattry->dim != 1 )
02730 {
02731 Tcl_SetResult( interp, "Must use 1-d coord arrays with pltr1.", TCL_STATIC );
02732 return TCL_ERROR;
02733 }
02734
02735 pltr_data = &cgrid1;
02736 }
02737 else if ( !strcmp( pltrname, "pltr2" ) )
02738 {
02739
02740 if ( !wrap )
02741 {
02742
02743 plAlloc2dGrid( &cgrid2.xg, nx, ny );
02744 plAlloc2dGrid( &cgrid2.yg, nx, ny );
02745 cgrid2.nx = nx;
02746 cgrid2.ny = ny;
02747 zused = z;
02748
02749 matPtr = mattrx;
02750 for ( i = 0; i < nx; i++ )
02751 for ( j = 0; j < ny; j++ )
02752 cgrid2.xg[i][j] = mattrx->fdata[ I2D( i, j ) ];
02753
02754 matPtr = mattry;
02755 for ( i = 0; i < nx; i++ )
02756 for ( j = 0; j < ny; j++ )
02757 cgrid2.yg[i][j] = mattry->fdata[ I2D( i, j ) ];
02758 }
02759 else if ( wrap == 1 )
02760 {
02761 plAlloc2dGrid( &cgrid2.xg, nx + 1, ny );
02762 plAlloc2dGrid( &cgrid2.yg, nx + 1, ny );
02763 plAlloc2dGrid( &zwrapped, nx + 1, ny );
02764 cgrid2.nx = nx + 1;
02765 cgrid2.ny = ny;
02766 zused = zwrapped;
02767
02768 matPtr = mattrx;
02769 for ( i = 0; i < nx; i++ )
02770 for ( j = 0; j < ny; j++ )
02771 cgrid2.xg[i][j] = mattrx->fdata[ I2D( i, j ) ];
02772
02773 matPtr = mattry;
02774 for ( i = 0; i < nx; i++ )
02775 {
02776 for ( j = 0; j < ny; j++ )
02777 {
02778 cgrid2.yg[i][j] = mattry->fdata[ I2D( i, j ) ];
02779 zwrapped[i][j] = z[i][j];
02780 }
02781 }
02782
02783 for ( j = 0; j < ny; j++ )
02784 {
02785 cgrid2.xg[nx][j] = cgrid2.xg[0][j];
02786 cgrid2.yg[nx][j] = cgrid2.yg[0][j];
02787 zwrapped[nx][j] = zwrapped[0][j];
02788 }
02789
02790
02791
02792 plFree2dGrid( z, nx, ny );
02793
02794 nx++;
02795 }
02796 else if ( wrap == 2 )
02797 {
02798 plAlloc2dGrid( &cgrid2.xg, nx, ny + 1 );
02799 plAlloc2dGrid( &cgrid2.yg, nx, ny + 1 );
02800 plAlloc2dGrid( &zwrapped, nx, ny + 1 );
02801 cgrid2.nx = nx;
02802 cgrid2.ny = ny + 1;
02803 zused = zwrapped;
02804
02805 matPtr = mattrx;
02806 for ( i = 0; i < nx; i++ )
02807 for ( j = 0; j < ny; j++ )
02808 cgrid2.xg[i][j] = mattrx->fdata[ I2D( i, j ) ];
02809
02810 matPtr = mattry;
02811 for ( i = 0; i < nx; i++ )
02812 {
02813 for ( j = 0; j < ny; j++ )
02814 {
02815 cgrid2.yg[i][j] = mattry->fdata[ I2D( i, j ) ];
02816 zwrapped[i][j] = z[i][j];
02817 }
02818 }
02819
02820 for ( i = 0; i < nx; i++ )
02821 {
02822 cgrid2.xg[i][ny] = cgrid2.xg[i][0];
02823 cgrid2.yg[i][ny] = cgrid2.yg[i][0];
02824 zwrapped[i][ny] = zwrapped[i][0];
02825 }
02826
02827
02828
02829 plFree2dGrid( z, nx, ny );
02830
02831 ny++;
02832 }
02833 else
02834 {
02835 Tcl_SetResult( interp, "Invalid wrap specifier, must be <empty>, 0, 1, or 2.", TCL_STATIC );
02836 return TCL_ERROR;
02837 }
02838
02839 pltr = pltr2;
02840 pltr_data = &cgrid2;
02841 }
02842 else
02843 {
02844 Tcl_AppendResult( interp,
02845 "Unrecognized coordinate transformation spec:",
02846 pltrname, ", must be NULL, pltr0, pltr1, or pltr2.",
02847 (char *) NULL );
02848 return TCL_ERROR;
02849 }
02850
02851
02852
02853 plshade( (const PLFLT **) zused, nx, ny, NULL,
02854 xmin, xmax, ymin, ymax,
02855 sh_min, sh_max, sh_cmap, sh_col, sh_wid,
02856 min_col, min_wid, max_col, max_wid,
02857 plfill, rect, pltr, pltr_data );
02858
02859
02860
02861
02862
02863
02864
02865 plFree2dGrid( zused, nx, ny );
02866
02867 if ( pltr == pltr1 )
02868 {
02869
02870
02871 }
02872 else if ( pltr == pltr2 )
02873 {
02874
02875 plFree2dGrid( cgrid2.xg, nx, ny );
02876 plFree2dGrid( cgrid2.yg, nx, ny );
02877 }
02878
02879 plflush();
02880 return TCL_OK;
02881 }
02882
02883
02884
02885
02886
02887
02888
02889
02890
02891
02892
02893
02894
02895
02896
02897
02898
02899
02900
02901
02902
02903
02904
02905
02906
02907
02908 static int
02909 plshadesCmd( ClientData clientData, Tcl_Interp *interp,
02910 int argc, const char *argv[] )
02911 {
02912 tclMatrix *matPtr, *matz, *mattrx = NULL, *mattry = NULL;
02913 tclMatrix *matclevel = NULL;
02914 PLFLT **z, **zused, **zwrapped;
02915 PLFLT xmin, xmax, ymin, ymax;
02916 PLINT fill_width = 0, cont_color = 0, cont_width = 0;
02917 PLINT rect = 1;
02918 const char *pltrname = "pltr0";
02919 void ( *pltr )( PLFLT, PLFLT, PLFLT *, PLFLT *, PLPointer );
02920 PLPointer pltr_data = NULL;
02921 PLcGrid cgrid1;
02922 PLcGrid2 cgrid2;
02923 PLINT wrap = 0;
02924 int nx, ny, nlevel, i, j;
02925
02926 if ( argc < 11 )
02927 {
02928 Tcl_AppendResult( interp, "bogus syntax for plshades, see doc.",
02929 (char *) NULL );
02930 return TCL_ERROR;
02931 }
02932
02933 matz = Tcl_GetMatrixPtr( interp, argv[1] );
02934 if ( matz == NULL )
02935 return TCL_ERROR;
02936 if ( matz->dim != 2 )
02937 {
02938 Tcl_SetResult( interp, "Must plot a 2-d matrix.", TCL_STATIC );
02939 return TCL_ERROR;
02940 }
02941
02942 nx = matz->n[0];
02943 ny = matz->n[1];
02944
02945 tclmateval_modx = nx;
02946 tclmateval_mody = ny;
02947
02948
02949
02950 plAlloc2dGrid( &z, nx, ny );
02951 for ( i = 0; i < nx; i++ )
02952 {
02953 for ( j = 0; j < ny; j++ )
02954 {
02955 z[i][j] = tclMatrix_feval( i, j, matz );
02956 }
02957 }
02958
02959 xmin = atof( argv[2] );
02960 xmax = atof( argv[3] );
02961 ymin = atof( argv[4] );
02962 ymax = atof( argv[5] );
02963
02964 matclevel = Tcl_GetMatrixPtr( interp, argv[6] );
02965 if ( matclevel == NULL )
02966 return TCL_ERROR;
02967 nlevel = matclevel->n[0];
02968 if ( matclevel->dim != 1 )
02969 {
02970 Tcl_SetResult( interp, "clevel must be 1-d matrix.", TCL_STATIC );
02971 return TCL_ERROR;
02972 }
02973
02974 fill_width = atoi( argv[7] );
02975 cont_color = atoi( argv[8] );
02976 cont_width = atoi( argv[9] );
02977 rect = atoi( argv[10] );
02978
02979 argc -= 11, argv += 11;
02980
02981 if ( argc >= 3 )
02982 {
02983 pltrname = argv[0];
02984 mattrx = Tcl_GetMatrixPtr( interp, argv[1] );
02985 if ( mattrx == NULL )
02986 return TCL_ERROR;
02987 mattry = Tcl_GetMatrixPtr( interp, argv[2] );
02988 if ( mattry == NULL )
02989 return TCL_ERROR;
02990
02991 argc -= 3, argv += 3;
02992 }
02993 else if ( argc && !strcmp( argv[0], "NULL" ) )
02994 {
02995 pltrname = argv[0];
02996 argc -= 1, argv += 1;
02997 }
02998
02999 if ( argc )
03000 {
03001 wrap = atoi( argv[0] );
03002 argc--, argv++;
03003 }
03004
03005 if ( argc )
03006 {
03007 Tcl_SetResult( interp, "plshades: bogus arg list", TCL_STATIC );
03008 return TCL_ERROR;
03009 }
03010
03011
03012
03013
03014 if ( !strcmp( pltrname, "NULL" ) )
03015 {
03016 pltr = NULL;
03017 zused = z;
03018
03019
03020 if ( wrap )
03021 {
03022 Tcl_SetResult( interp, "Must use pltr2 if want wrapping.", TCL_STATIC );
03023 return TCL_ERROR;
03024 }
03025 }
03026 else if ( !strcmp( pltrname, "pltr0" ) )
03027 {
03028 pltr = pltr0;
03029 zused = z;
03030
03031
03032 if ( wrap )
03033 {
03034 Tcl_SetResult( interp, "Must use pltr2 if want wrapping.", TCL_STATIC );
03035 return TCL_ERROR;
03036 }
03037 }
03038 else if ( !strcmp( pltrname, "pltr1" ) )
03039 {
03040 pltr = pltr1;
03041 cgrid1.xg = mattrx->fdata;
03042 cgrid1.nx = nx;
03043 cgrid1.yg = mattry->fdata;
03044 cgrid1.ny = ny;
03045 zused = z;
03046
03047
03048 if ( wrap )
03049 {
03050 Tcl_SetResult( interp, "Must use pltr2 if want wrapping.", TCL_STATIC );
03051 return TCL_ERROR;
03052 }
03053
03054 if ( mattrx->dim != 1 || mattry->dim != 1 )
03055 {
03056 Tcl_SetResult( interp, "Must use 1-d coord arrays with pltr1.", TCL_STATIC );
03057 return TCL_ERROR;
03058 }
03059
03060 pltr_data = &cgrid1;
03061 }
03062 else if ( !strcmp( pltrname, "pltr2" ) )
03063 {
03064
03065 if ( !wrap )
03066 {
03067
03068 plAlloc2dGrid( &cgrid2.xg, nx, ny );
03069 plAlloc2dGrid( &cgrid2.yg, nx, ny );
03070 cgrid2.nx = nx;
03071 cgrid2.ny = ny;
03072 zused = z;
03073
03074 matPtr = mattrx;
03075 for ( i = 0; i < nx; i++ )
03076 for ( j = 0; j < ny; j++ )
03077 cgrid2.xg[i][j] = mattrx->fdata[ I2D( i, j ) ];
03078
03079 matPtr = mattry;
03080 for ( i = 0; i < nx; i++ )
03081 for ( j = 0; j < ny; j++ )
03082 cgrid2.yg[i][j] = mattry->fdata[ I2D( i, j ) ];
03083 }
03084 else if ( wrap == 1 )
03085 {
03086 plAlloc2dGrid( &cgrid2.xg, nx + 1, ny );
03087 plAlloc2dGrid( &cgrid2.yg, nx + 1, ny );
03088 plAlloc2dGrid( &zwrapped, nx + 1, ny );
03089 cgrid2.nx = nx + 1;
03090 cgrid2.ny = ny;
03091 zused = zwrapped;
03092
03093 matPtr = mattrx;
03094 for ( i = 0; i < nx; i++ )
03095 for ( j = 0; j < ny; j++ )
03096 cgrid2.xg[i][j] = mattrx->fdata[ I2D( i, j ) ];
03097
03098 matPtr = mattry;
03099 for ( i = 0; i < nx; i++ )
03100 {
03101 for ( j = 0; j < ny; j++ )
03102 {
03103 cgrid2.yg[i][j] = mattry->fdata[ I2D( i, j ) ];
03104 zwrapped[i][j] = z[i][j];
03105 }
03106 }
03107
03108 for ( j = 0; j < ny; j++ )
03109 {
03110 cgrid2.xg[nx][j] = cgrid2.xg[0][j];
03111 cgrid2.yg[nx][j] = cgrid2.yg[0][j];
03112 zwrapped[nx][j] = zwrapped[0][j];
03113 }
03114
03115
03116
03117 plFree2dGrid( z, nx, ny );
03118
03119 nx++;
03120 }
03121 else if ( wrap == 2 )
03122 {
03123 plAlloc2dGrid( &cgrid2.xg, nx, ny + 1 );
03124 plAlloc2dGrid( &cgrid2.yg, nx, ny + 1 );
03125 plAlloc2dGrid( &zwrapped, nx, ny + 1 );
03126 cgrid2.nx = nx;
03127 cgrid2.ny = ny + 1;
03128 zused = zwrapped;
03129
03130 matPtr = mattrx;
03131 for ( i = 0; i < nx; i++ )
03132 for ( j = 0; j < ny; j++ )
03133 cgrid2.xg[i][j] = mattrx->fdata[ I2D( i, j ) ];
03134
03135 matPtr = mattry;
03136 for ( i = 0; i < nx; i++ )
03137 {
03138 for ( j = 0; j < ny; j++ )
03139 {
03140 cgrid2.yg[i][j] = mattry->fdata[ I2D( i, j ) ];
03141 zwrapped[i][j] = z[i][j];
03142 }
03143 }
03144
03145 for ( i = 0; i < nx; i++ )
03146 {
03147 cgrid2.xg[i][ny] = cgrid2.xg[i][0];
03148 cgrid2.yg[i][ny] = cgrid2.yg[i][0];
03149 zwrapped[i][ny] = zwrapped[i][0];
03150 }
03151
03152
03153
03154 plFree2dGrid( z, nx, ny );
03155
03156 ny++;
03157 }
03158 else
03159 {
03160 Tcl_SetResult( interp, "Invalid wrap specifier, must be <empty>, 0, 1, or 2.", TCL_STATIC );
03161 return TCL_ERROR;
03162 }
03163
03164 pltr = pltr2;
03165 pltr_data = &cgrid2;
03166 }
03167 else
03168 {
03169 Tcl_AppendResult( interp,
03170 "Unrecognized coordinate transformation spec:",
03171 pltrname, ", must be NULL, pltr0, pltr1, or pltr2.",
03172 (char *) NULL );
03173 return TCL_ERROR;
03174 }
03175
03176
03177
03178 plshades( (const PLFLT **) zused, nx, ny, NULL,
03179 xmin, xmax, ymin, ymax,
03180 matclevel->fdata, nlevel, fill_width, cont_color, cont_width,
03181 plfill, rect, pltr, pltr_data );
03182
03183
03184
03185
03186
03187
03188
03189 plFree2dGrid( zused, nx, ny );
03190
03191 if ( pltr == pltr1 )
03192 {
03193
03194
03195 }
03196 else if ( pltr == pltr2 )
03197 {
03198
03199 plFree2dGrid( cgrid2.xg, nx, ny );
03200 plFree2dGrid( cgrid2.yg, nx, ny );
03201 }
03202
03203 plflush();
03204 return TCL_OK;
03205 }
03206
03207
03208
03209
03210
03211
03212
03213
03214 static const char *transform_name;
03215
03216 static Tcl_Interp *tcl_interp;
03217 static int return_code;
03218
03219 void
03220 mapform( PLINT n, PLFLT *x, PLFLT *y )
03221 {
03222 int i;
03223 char *cmd;
03224 tclMatrix *xPtr, *yPtr;
03225
03226 cmd = (char *) malloc( strlen( transform_name ) + 40 );
03227
03228
03229 sprintf( cmd, "matrix %cx f %d", (char) 1, n );
03230 if ( Tcl_Eval( tcl_interp, cmd ) != TCL_OK )
03231 {
03232 return_code = TCL_ERROR;
03233 free( cmd );
03234 return;
03235 }
03236 sprintf( cmd, "matrix %cy f %d", (char) 1, n );
03237 if ( Tcl_Eval( tcl_interp, cmd ) != TCL_OK )
03238 {
03239 return_code = TCL_ERROR;
03240 free( cmd );
03241 return;
03242 }
03243
03244 sprintf( cmd, "%cx", (char) 1 );
03245 xPtr = Tcl_GetMatrixPtr( tcl_interp, cmd );
03246 sprintf( cmd, "%cy", (char) 1 );
03247 yPtr = Tcl_GetMatrixPtr( tcl_interp, cmd );
03248
03249 if ( xPtr == NULL || yPtr == NULL )
03250 return;
03251
03252 for ( i = 0; i < n; i++ )
03253 {
03254 xPtr->fdata[i] = x[i];
03255 yPtr->fdata[i] = y[i];
03256 }
03257
03258
03259 sprintf( cmd, "%s %d %cx %cy", transform_name, n, (char) 1, (char) 1 );
03260 return_code = Tcl_Eval( tcl_interp, cmd );
03261 if ( return_code != TCL_OK )
03262 {
03263 free( cmd );
03264 return;
03265 }
03266
03267
03268
03269 for ( i = 0; i < n; i++ )
03270 {
03271 x[i] = xPtr->fdata[i];
03272 y[i] = yPtr->fdata[i];
03273 }
03274
03275
03276
03277
03278 sprintf( cmd, "rename %cx {}; rename %cy {}", (char) 1, (char) 1 );
03279 return_code = Tcl_Eval( tcl_interp, cmd );
03280
03281 free( cmd );
03282 }
03283
03284
03285
03286
03287
03288
03289
03290
03291
03292
03293
03294 static int
03295 plmapCmd( ClientData clientData, Tcl_Interp *interp,
03296 int argc, const char *argv[] )
03297 {
03298 PLFLT minlong, maxlong, minlat, maxlat;
03299 PLINT transform;
03300 PLINT idxname;
03301
03302 return_code = TCL_OK;
03303 if ( argc < 6 || argc > 7 )
03304 {
03305 Tcl_AppendResult( interp, "bogus syntax for plmap, see doc.",
03306 (char *) NULL );
03307 return TCL_ERROR;
03308 }
03309
03310 if ( argc == 6 )
03311 {
03312 transform = 0;
03313 idxname = 1;
03314 transform_name = NULL;
03315 minlong = atof( argv[2] );
03316 maxlong = atof( argv[3] );
03317 minlat = atof( argv[4] );
03318 maxlat = atof( argv[5] );
03319 }
03320 else
03321 {
03322 transform = 1;
03323 idxname = 2;
03324 minlong = atof( argv[3] );
03325 maxlong = atof( argv[4] );
03326 minlat = atof( argv[5] );
03327 maxlat = atof( argv[6] );
03328
03329 tcl_interp = interp;
03330 transform_name = argv[1];
03331 if ( strlen( transform_name ) == 0 )
03332 {
03333 idxname = 1;
03334 }
03335 }
03336
03337 if ( transform && idxname == 2 )
03338 {
03339 plmap( &mapform, argv[idxname], minlong, maxlong, minlat, maxlat );
03340 }
03341 else
03342 {
03343
03344 plmap( NULL, argv[idxname], minlong, maxlong, minlat, maxlat );
03345 }
03346
03347 plflush();
03348 return return_code;
03349 }
03350
03351
03352
03353
03354
03355
03356
03357
03358
03359
03360
03361 static int
03362 plmeridiansCmd( ClientData clientData, Tcl_Interp *interp,
03363 int argc, const char *argv[] )
03364 {
03365 PLFLT dlong, dlat, minlong, maxlong, minlat, maxlat;
03366 PLINT transform;
03367
03368 return_code = TCL_OK;
03369
03370 if ( argc < 7 || argc > 8 )
03371 {
03372 Tcl_AppendResult( interp, "bogus syntax for plmeridians, see doc.",
03373 (char *) NULL );
03374 return TCL_ERROR;
03375 }
03376
03377 if ( argc == 7 )
03378 {
03379 transform = 0;
03380 transform_name = NULL;
03381 dlong = atof( argv[1] );
03382 dlat = atof( argv[2] );
03383 minlong = atof( argv[3] );
03384 maxlong = atof( argv[4] );
03385 minlat = atof( argv[5] );
03386 maxlat = atof( argv[6] );
03387 }
03388 else
03389 {
03390 dlong = atof( argv[2] );
03391 dlat = atof( argv[3] );
03392 minlong = atof( argv[4] );
03393 maxlong = atof( argv[5] );
03394 minlat = atof( argv[6] );
03395 maxlat = atof( argv[7] );
03396
03397 transform = 1;
03398 tcl_interp = interp;
03399 transform_name = argv[1];
03400 if ( strlen( transform_name ) == 0 )
03401 {
03402 transform = 0;
03403 }
03404 }
03405
03406 if ( transform )
03407 {
03408 plmeridians( &mapform, dlong, dlat, minlong, maxlong, minlat, maxlat );
03409 }
03410 else
03411 {
03412 plmeridians( NULL, dlong, dlat, minlong, maxlong, minlat, maxlat );
03413 }
03414
03415 plflush();
03416 return TCL_OK;
03417 }
03418
03419 static Tcl_Interp *tcl_xform_interp = 0;
03420 static char *tcl_xform_procname = 0;
03421 static const char *tcl_xform_template =
03422 #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION < 5
03423 "set result [%s ${_##_x} ${_##_y}] ; set _##_x [lindex $result 0] ; set _##_y [lindex $result 1]"
03424 #else
03425 "set result [%s ${_##_x} ${_##_y}] ; lassign $result _##_x _##_y"
03426 #endif
03427 ;
03428
03429 static char *tcl_xform_code = 0;
03430
03431 static void
03432 Tcl_transform( PLFLT x, PLFLT y, PLFLT *xt, PLFLT *yt, PLPointer data )
03433 {
03434 Tcl_Obj *objx, *objy;
03435 int code;
03436 double dx, dy;
03437
03438
03439 objx = Tcl_NewDoubleObj( x );
03440 Tcl_IncrRefCount( objx );
03441 Tcl_SetVar2Ex( tcl_xform_interp,
03442 "_##_x", NULL, objx, 0 );
03443 Tcl_DecrRefCount( objx );
03444
03445
03446 objy = Tcl_NewDoubleObj( y );
03447 Tcl_IncrRefCount( objy );
03448 Tcl_SetVar2Ex( tcl_xform_interp,
03449 "_##_y", NULL, objy, 0 );
03450 Tcl_DecrRefCount( objy );
03451
03452
03453
03454
03455
03456
03457
03458
03459 code = Tcl_Eval( tcl_xform_interp, tcl_xform_code );
03460
03461 if ( code != TCL_OK )
03462 {
03463 printf( "Unable to evaluate Tcl-side coordinate transform.\n" );
03464 printf( "code = %d\n", code );
03465 printf( "Error result: %s\n", Tcl_GetStringResult( tcl_xform_interp ) );
03466 return;
03467 }
03468
03469 objx = Tcl_GetVar2Ex( tcl_xform_interp, "_##_x", NULL, 0 );
03470 objy = Tcl_GetVar2Ex( tcl_xform_interp, "_##_y", NULL, 0 );
03471
03472
03473
03474 if ( Tcl_GetDoubleFromObj( tcl_xform_interp, objx, &dx ) != TCL_OK ||
03475 Tcl_GetDoubleFromObj( tcl_xform_interp, objy, &dy ) != TCL_OK )
03476 {
03477 printf( "Unable to extract Tcl results.\n" );
03478 return;
03479 }
03480
03481 *xt = dx;
03482 *yt = dy;
03483 }
03484
03485
03486
03487
03488
03489
03490
03491 static int
03492 plstransformCmd( ClientData clientData, Tcl_Interp *interp,
03493 int argc, const char *argv[] )
03494 {
03495 if ( argc == 1
03496 || strcmp( argv[1], "NULL" ) == 0 )
03497 {
03498
03499 plstransform( NULL, NULL );
03500 tcl_xform_interp = 0;
03501 if ( tcl_xform_procname )
03502 {
03503 free( tcl_xform_procname );
03504 tcl_xform_procname = 0;
03505 }
03506 }
03507 else
03508 {
03509 int len;
03510 const char *data = argc > 2 ? argv[2] : 0;
03511
03512 tcl_xform_interp = interp;
03513 tcl_xform_procname = strdup( argv[1] );
03514
03515 len = strlen( tcl_xform_template ) + strlen( tcl_xform_procname );
03516 tcl_xform_code = malloc( len );
03517 sprintf( tcl_xform_code, tcl_xform_template, tcl_xform_procname );
03518
03519 plstransform( Tcl_transform, NULL );
03520 }
03521
03522 return TCL_OK;
03523 }
03524
03525
03526
03527
03528
03529
03530 static int
03531 plgriddataCmd( ClientData clientData, Tcl_Interp *interp,
03532 int argc, const char *argv[] )
03533 {
03534 tclMatrix *arrx, *arry, *arrz, *xcoord, *ycoord, *zvalue;
03535 PLINT pts, nx, ny, alg;
03536 PLFLT optalg;
03537 PLFLT **z;
03538
03539 double value;
03540 int i, j;
03541
03542 if ( argc != 9 )
03543 {
03544 Tcl_AppendResult( interp, "wrong # args: see documentation for ",
03545 argv[0], (char *) NULL );
03546 return TCL_ERROR;
03547 }
03548
03549 arrx = Tcl_GetMatrixPtr( interp, argv[1] );
03550 arry = Tcl_GetMatrixPtr( interp, argv[2] );
03551 arrz = Tcl_GetMatrixPtr( interp, argv[3] );
03552
03553 xcoord = Tcl_GetMatrixPtr( interp, argv[4] );
03554 ycoord = Tcl_GetMatrixPtr( interp, argv[5] );
03555
03556 zvalue = Tcl_GetMatrixPtr( interp, argv[6] );
03557
03558 sscanf( argv[7], "%d", &alg );
03559
03560 sscanf( argv[8], "%lg", &value ); optalg = (PLFLT) value;
03561
03562 if ( arrx == NULL || arrx->dim != 1 )
03563 {
03564 Tcl_AppendResult( interp, argv[0], ": argument 1 should be a \
03565 one-dimensional matrix - ", argv[1], (char *) NULL );
03566 return TCL_ERROR;
03567 }
03568 if ( arry == NULL || arry->dim != 1 )
03569 {
03570 Tcl_AppendResult( interp, argv[0], ": argument 2 should be a \
03571 one-dimensional matrix - ", argv[2], (char *) NULL );
03572 return TCL_ERROR;
03573 }
03574 if ( arrz == NULL || arrz->dim != 1 )
03575 {
03576 Tcl_AppendResult( interp, argv[0], ": argument 3 should be a \
03577 one-dimensional matrix - ", argv[3], (char *) NULL );
03578 return TCL_ERROR;
03579 }
03580
03581 if ( xcoord == NULL || xcoord->dim != 1 )
03582 {
03583 Tcl_AppendResult( interp, argv[0], ": argument 4 should be a \
03584 one-dimensional matrix - ", argv[4], (char *) NULL );
03585 return TCL_ERROR;
03586 }
03587 if ( ycoord == NULL || ycoord->dim != 1 )
03588 {
03589 Tcl_AppendResult( interp, argv[0], ": argument 5 should be a \
03590 one-dimensional matrix - ", argv[5], (char *) NULL );
03591 return TCL_ERROR;
03592 }
03593 if ( zvalue == NULL || zvalue->dim != 2 )
03594 {
03595 Tcl_AppendResult( interp, argv[0], ": argument 6 should be a \
03596 two-dimensional matrix - ", argv[6], (char *) NULL );
03597 return TCL_ERROR;
03598 }
03599
03600 pts = arrx->n[0];
03601 nx = zvalue->n[0];
03602 ny = zvalue->n[1];
03603
03604
03605
03606 plAlloc2dGrid( &z, nx, ny );
03607
03608
03609 plgriddata( arrx->fdata, arry->fdata, arrz->fdata, pts,
03610 xcoord->fdata, nx, ycoord->fdata, ny, z, alg, optalg );
03611
03612
03613 for ( i = 0; i < nx; i++ )
03614 {
03615 for ( j = 0; j < ny; j++ )
03616 {
03617 zvalue->fdata[j + zvalue->n[1] * i] = z[i][j];
03618 }
03619 }
03620
03621 plFree2dGrid( z, nx, ny );
03622 return TCL_OK;
03623 }
03624
03625
03626
03627
03628
03629
03630 static int
03631 plimageCmd( ClientData clientData, Tcl_Interp *interp,
03632 int argc, const char *argv[] )
03633 {
03634 tclMatrix *zvalue;
03635 PLINT nx, ny;
03636 PLFLT **pidata;
03637 PLFLT xmin, xmax, ymin, ymax, zmin, zmax, Dxmin, Dxmax, Dymin, Dymax;
03638
03639 double value;
03640 int i, j;
03641
03642 if ( argc != 12 )
03643 {
03644 Tcl_AppendResult( interp, "wrong # args: see documentation for ",
03645 argv[0], (char *) NULL );
03646 return TCL_ERROR;
03647 }
03648
03649 zvalue = Tcl_GetMatrixPtr( interp, argv[1] );
03650
03651 if ( zvalue == NULL || zvalue->dim != 2 )
03652 {
03653 Tcl_AppendResult( interp, argv[0], ": argument 1 should be a \
03654 two-dimensional matrix - ", argv[1], (char *) NULL );
03655 return TCL_ERROR;
03656 }
03657
03658 sscanf( argv[2], "%lg", &value ); xmin = (PLFLT) value;
03659 sscanf( argv[3], "%lg", &value ); xmax = (PLFLT) value;
03660 sscanf( argv[4], "%lg", &value ); ymin = (PLFLT) value;
03661 sscanf( argv[5], "%lg", &value ); ymax = (PLFLT) value;
03662 sscanf( argv[6], "%lg", &value ); zmin = (PLFLT) value;
03663 sscanf( argv[7], "%lg", &value ); zmax = (PLFLT) value;
03664 sscanf( argv[8], "%lg", &value ); Dxmin = (PLFLT) value;
03665 sscanf( argv[9], "%lg", &value ); Dxmax = (PLFLT) value;
03666 sscanf( argv[10], "%lg", &value ); Dymin = (PLFLT) value;
03667 sscanf( argv[11], "%lg", &value ); Dymax = (PLFLT) value;
03668
03669 nx = zvalue->n[0];
03670 ny = zvalue->n[1];
03671
03672 plAlloc2dGrid( &pidata, nx, ny );
03673
03674 for ( i = 0; i < nx; i++ )
03675 {
03676 for ( j = 0; j < ny; j++ )
03677 {
03678 pidata[i][j] = zvalue->fdata[j + i * ny];
03679 }
03680 }
03681
03682
03683
03684
03685
03686
03687
03688
03689
03690 c_plimage( (const PLFLT **) pidata, nx, ny, xmin, xmax, ymin, ymax, zmin, zmax,
03691 Dxmin, Dxmax, Dymin, Dymax );
03692
03693 plFree2dGrid( pidata, nx, ny );
03694
03695 return TCL_OK;
03696 }
03697
03698
03699
03700
03701
03702
03703
03704
03705
03706 static int
03707 plimagefrCmd( ClientData clientData, Tcl_Interp *interp,
03708 int argc, const char *argv[] )
03709 {
03710 tclMatrix *zvalue;
03711 tclMatrix *xg;
03712 tclMatrix *yg;
03713 PLINT nx, ny;
03714 PLFLT **pidata;
03715 PLcGrid2 cgrid2;
03716 PLFLT xmin, xmax, ymin, ymax, zmin, zmax, valuemin, valuemax;
03717
03718 double value;
03719 int i, j;
03720
03721 if ( argc != 12 && argc != 10 )
03722 {
03723 Tcl_AppendResult( interp, "wrong # args: see documentation for ",
03724 argv[0], (char *) NULL );
03725 return TCL_ERROR;
03726 }
03727
03728 zvalue = Tcl_GetMatrixPtr( interp, argv[1] );
03729
03730 if ( zvalue == NULL || zvalue->dim != 2 )
03731 {
03732 Tcl_AppendResult( interp, argv[0], ": argument 1 should be a \
03733 two-dimensional matrix - ", argv[1], (char *) NULL );
03734 return TCL_ERROR;
03735 }
03736
03737 xg = NULL;
03738 yg = NULL;
03739 if ( argc == 12 )
03740 {
03741 xg = Tcl_GetMatrixPtr( interp, argv[10] );
03742 yg = Tcl_GetMatrixPtr( interp, argv[11] );
03743
03744 if ( xg == NULL || xg->dim != 2 )
03745 {
03746 Tcl_AppendResult( interp, argv[0], ": argument 10 should be a \
03747 two-dimensional matrix - ", argv[10], (char *) NULL );
03748 return TCL_ERROR;
03749 }
03750
03751 if ( yg == NULL || yg->dim != 2 )
03752 {
03753 Tcl_AppendResult( interp, argv[0], ": argument 11 should be a \
03754 two-dimensional matrix - ", argv[11], (char *) NULL );
03755 return TCL_ERROR;
03756 }
03757 }
03758
03759 sscanf( argv[2], "%lg", &value ); xmin = (PLFLT) value;
03760 sscanf( argv[3], "%lg", &value ); xmax = (PLFLT) value;
03761 sscanf( argv[4], "%lg", &value ); ymin = (PLFLT) value;
03762 sscanf( argv[5], "%lg", &value ); ymax = (PLFLT) value;
03763 sscanf( argv[6], "%lg", &value ); zmin = (PLFLT) value;
03764 sscanf( argv[7], "%lg", &value ); zmax = (PLFLT) value;
03765 sscanf( argv[8], "%lg", &value ); valuemin = (PLFLT) value;
03766 sscanf( argv[9], "%lg", &value ); valuemax = (PLFLT) value;
03767
03768 nx = zvalue->n[0];
03769 ny = zvalue->n[1];
03770
03771 plAlloc2dGrid( &pidata, nx, ny );
03772
03773 for ( i = 0; i < nx; i++ )
03774 {
03775 for ( j = 0; j < ny; j++ )
03776 {
03777 pidata[i][j] = zvalue->fdata[j + i * ny];
03778 }
03779 }
03780
03781 if ( xg != NULL )
03782 {
03783 plAlloc2dGrid( &cgrid2.xg, nx + 1, ny + 1 );
03784 plAlloc2dGrid( &cgrid2.yg, nx + 1, ny + 1 );
03785
03786 cgrid2.nx = nx + 1;
03787 cgrid2.ny = ny + 1;
03788 for ( i = 0; i <= nx; i++ )
03789 {
03790 for ( j = 0; j <= ny; j++ )
03791 {
03792 cgrid2.xg[i][j] = xg->fdata[j + i * ( ny + 1 )];
03793 cgrid2.yg[i][j] = yg->fdata[j + i * ( ny + 1 )];
03794 }
03795 }
03796 c_plimagefr( (const PLFLT **) pidata, nx, ny, xmin, xmax, ymin, ymax, zmin, zmax,
03797 valuemin, valuemax, pltr2, (void *) &cgrid2 );
03798 }
03799 else
03800 {
03801 c_plimagefr( (const PLFLT **) pidata, nx, ny, xmin, xmax, ymin, ymax, zmin, zmax,
03802 valuemin, valuemax, pltr0, NULL );
03803 }
03804
03805 plFree2dGrid( pidata, nx, ny );
03806 if ( xg != NULL )
03807 {
03808 plFree2dGrid( cgrid2.xg, nx + 1, ny + 1 );
03809 plFree2dGrid( cgrid2.yg, nx + 1, ny + 1 );
03810 }
03811
03812 return TCL_OK;
03813 }
03814
03815
03816
03817
03818
03819
03820 static int
03821 plstripcCmd( ClientData clientData, Tcl_Interp *interp,
03822 int argc, const char *argv[] )
03823 {
03824 int i;
03825 int id;
03826 const char *xspec;
03827 const char *yspec;
03828 const char *idName;
03829 tclMatrix *colMat;
03830 tclMatrix *styleMat;
03831 double value;
03832 int ivalue;
03833 PLFLT xmin, xmax, xjump, ymin, ymax, xlpos, ylpos;
03834 PLBOOL y_ascl, acc;
03835 PLINT colbox, collab;
03836 PLINT colline[4], styline[4];
03837 int nlegend;
03838 const char **legline;
03839 const char *labx;
03840 const char *laby;
03841 const char *labtop;
03842 char idvalue[20];
03843
03844 if ( argc != 21 )
03845 {
03846 Tcl_AppendResult( interp, "wrong # args: see documentation for ",
03847 argv[0], (char *) NULL );
03848 return TCL_ERROR;
03849 }
03850
03851 colMat = Tcl_GetMatrixPtr( interp, argv[15] );
03852 styleMat = Tcl_GetMatrixPtr( interp, argv[16] );
03853
03854 if ( colMat == NULL || colMat->dim != 1 || colMat->idata == NULL )
03855 {
03856 Tcl_AppendResult( interp, argv[0], ": argument 15 should be a \
03857 one-dimensional integer matrix - ", argv[15], (char *) NULL );
03858 return TCL_ERROR;
03859 }
03860
03861 if ( styleMat == NULL || styleMat->dim != 1 || styleMat->idata == NULL )
03862 {
03863 Tcl_AppendResult( interp, argv[0], ": argument 16 should be a \
03864 one-dimensional integer matrix - ", argv[16], (char *) NULL );
03865 return TCL_ERROR;
03866 }
03867
03868 idName = argv[1];
03869 xspec = argv[2];
03870 yspec = argv[3];
03871
03872 sscanf( argv[4], "%lg", &value ); xmin = (PLFLT) value;
03873 sscanf( argv[5], "%lg", &value ); xmax = (PLFLT) value;
03874 sscanf( argv[6], "%lg", &value ); xjump = (PLFLT) value;
03875 sscanf( argv[7], "%lg", &value ); ymin = (PLFLT) value;
03876 sscanf( argv[8], "%lg", &value ); ymax = (PLFLT) value;
03877 sscanf( argv[9], "%lg", &value ); xlpos = (PLFLT) value;
03878 sscanf( argv[10], "%lg", &value ); ylpos = (PLFLT) value;
03879 sscanf( argv[11], "%d", &ivalue ); y_ascl = (PLBOOL) ivalue;
03880 sscanf( argv[12], "%d", &ivalue ); acc = (PLBOOL) ivalue;
03881 sscanf( argv[13], "%d", &ivalue ); colbox = ivalue;
03882 sscanf( argv[14], "%d", &ivalue ); collab = ivalue;
03883
03884 labx = argv[18];
03885 laby = argv[19];
03886 labtop = argv[20];
03887
03888 for ( i = 0; i < 4; i++ )
03889 {
03890 colline[i] = colMat->idata[i];
03891 styline[i] = styleMat->idata[i];
03892 }
03893
03894 if ( Tcl_SplitList( interp, argv[17], &nlegend, &legline ) != TCL_OK )
03895 {
03896 return TCL_ERROR;
03897 }
03898 if ( nlegend < 4 )
03899 {
03900 Tcl_AppendResult( interp, argv[0], ": argument 18 should be a \
03901 list of at least four items - ", argv[17], (char *) NULL );
03902 return TCL_ERROR;
03903 }
03904
03905 c_plstripc( &id, xspec, yspec,
03906 xmin, xmax, xjump, ymin, ymax,
03907 xlpos, ylpos,
03908 y_ascl, acc,
03909 colbox, collab,
03910 colline, styline, legline,
03911 labx, laby, labtop );
03912
03913 sprintf( idvalue, "%d", id );
03914 Tcl_SetVar( interp, idName, idvalue, 0 );
03915
03916 Tcl_Free( (char *) legline );
03917
03918 return TCL_OK;
03919 }
03920
03921
03922
03923
03924
03925
03926
03927 static Tcl_Obj *label_objs[4] = { NULL, NULL, NULL, NULL };
03928
03929
03930 void
03931 labelform( PLINT axis, PLFLT value, char *string, PLINT string_length, PLPointer data )
03932 {
03933 int objc;
03934
03935 label_objs[1] = Tcl_NewIntObj( axis );
03936 label_objs[2] = Tcl_NewDoubleObj( (double) value );
03937
03938 Tcl_IncrRefCount( label_objs[1] );
03939 Tcl_IncrRefCount( label_objs[2] );
03940
03941
03942 objc = 3;
03943 if ( label_objs[3] != NULL )
03944 {
03945 objc = 4;
03946 }
03947
03948 return_code = Tcl_EvalObjv( tcl_interp, objc, label_objs, 0 );
03949
03950 if ( return_code != TCL_OK )
03951 {
03952 strncpy( string, "ERROR", string_length );
03953 }
03954 else
03955 {
03956 strncpy( string, Tcl_GetStringResult( tcl_interp ), string_length );
03957 }
03958
03959 Tcl_DecrRefCount( label_objs[1] );
03960 Tcl_DecrRefCount( label_objs[2] );
03961 }
03962
03963
03964
03965
03966
03967
03968
03969
03970
03971
03972 static int
03973 plslabelfuncCmd( ClientData clientData, Tcl_Interp *interp,
03974 int argc, const char *argv[] )
03975 {
03976 if ( argc < 2 || argc > 3 )
03977 {
03978 Tcl_AppendResult( interp, "bogus syntax for plslabelfunc, see doc.",
03979 (char *) NULL );
03980 return TCL_ERROR;
03981 }
03982
03983 tcl_interp = interp;
03984
03985 if ( label_objs[0] != NULL )
03986 {
03987 Tcl_DecrRefCount( label_objs[0] );
03988 }
03989 if ( label_objs[3] != NULL )
03990 {
03991 Tcl_DecrRefCount( label_objs[3] );
03992 label_objs[3] = NULL;
03993 }
03994
03995 if ( strlen( argv[1] ) == 0 )
03996 {
03997 plslabelfunc( NULL, NULL );
03998 return TCL_OK;
03999 }
04000 else
04001 {
04002 plslabelfunc( labelform, NULL );
04003 label_objs[0] = Tcl_NewStringObj( argv[1], strlen( argv[1] ) );
04004 Tcl_IncrRefCount( label_objs[0] );
04005 }
04006
04007 if ( argc == 3 )
04008 {
04009 label_objs[3] = Tcl_NewStringObj( argv[2], strlen( argv[2] ) );
04010 Tcl_IncrRefCount( label_objs[3] );
04011 }
04012 else
04013 {
04014 label_objs[3] = NULL;
04015 }
04016
04017 return TCL_OK;
04018 }
04019
04020
04021
04022
04023
04024
04025
04026
04027
04028
04029 static int *argv_to_ints( Tcl_Interp *interp, const char *list_numbers, int *number )
04030 {
04031 int i, retcode;
04032 int *array;
04033 Tcl_Obj *list;
04034 Tcl_Obj *elem;
04035
04036 list = Tcl_NewStringObj( list_numbers, ( -1 ) );
04037
04038 retcode = Tcl_ListObjLength( interp, list, number );
04039 if ( retcode != TCL_OK || ( *number ) == 0 )
04040 {
04041 *number = 0;
04042 return NULL;
04043 }
04044 else
04045 {
04046 array = (int *) malloc( sizeof ( int ) * ( *number ) );
04047 for ( i = 0; i < ( *number ); i++ )
04048 {
04049 Tcl_ListObjIndex( interp, list, i, &elem );
04050 Tcl_GetIntFromObj( interp, elem, &array[i] );
04051 }
04052 }
04053 return array;
04054 }
04055
04056 static double *argv_to_doubles( Tcl_Interp *interp, const char *list_numbers, int *number )
04057 {
04058 int i, retcode;
04059 double *array;
04060 Tcl_Obj *list;
04061 Tcl_Obj *elem;
04062
04063 list = Tcl_NewStringObj( list_numbers, ( -1 ) );
04064
04065 retcode = Tcl_ListObjLength( interp, list, number );
04066 if ( retcode != TCL_OK || ( *number ) == 0 )
04067 {
04068 *number = 0;
04069 return NULL;
04070 }
04071 else
04072 {
04073 array = (double *) malloc( sizeof ( double ) * ( *number ) );
04074 for ( i = 0; i < ( *number ); i++ )
04075 {
04076 Tcl_ListObjIndex( interp, list, i, &elem );
04077 Tcl_GetDoubleFromObj( interp, elem, &array[i] );
04078 }
04079 }
04080 return array;
04081 }
04082
04083 static char **argv_to_chars( Tcl_Interp *interp, const char *list_strings, int *number )
04084 {
04085 int i, retcode;
04086 char **array;
04087 char *string;
04088 int length;
04089 int idx;
04090 Tcl_Obj *list;
04091 Tcl_Obj *elem;
04092
04093 list = Tcl_NewStringObj( list_strings, ( -1 ) );
04094
04095 retcode = Tcl_ListObjLength( interp, list, number );
04096 if ( retcode != TCL_OK || ( *number ) == 0 )
04097 {
04098 *number = 0;
04099 return NULL;
04100 }
04101 else
04102 {
04103 array = (char **) malloc( sizeof ( char* ) * ( *number ) );
04104 array[0] = (char *) malloc( sizeof ( char ) * ( strlen( list_strings ) + 1 ) );
04105 idx = 0;
04106 for ( i = 0; i < ( *number ); i++ )
04107 {
04108 Tcl_ListObjIndex( interp, list, i, &elem );
04109 string = Tcl_GetStringFromObj( elem, &length );
04110
04111 array[i] = array[0] + idx;
04112 strncpy( array[i], string, length );
04113 idx += length + 1;
04114 array[0][idx - 1] = '\0';
04115 }
04116 }
04117 return array;
04118 }
04119
04120 static int
04121 pllegendCmd( ClientData clientData, Tcl_Interp *interp,
04122 int argc, const char *argv[] )
04123 {
04124 PLFLT legend_width, legend_height;
04125 PLFLT x, y, plot_width;
04126 PLINT opt, position;
04127 PLINT bg_color, bb_color, bb_style;
04128 PLINT nrow, ncolumn;
04129 PLINT nlegend;
04130 PLINT *opt_array;
04131 PLFLT text_offset, text_scale, text_spacing, text_justification;
04132 PLINT *text_colors;
04133 PLINT *box_colors, *box_patterns;
04134 PLFLT *box_scales;
04135 PLINT *box_line_widths, *line_colors, *line_styles, *line_widths;
04136 PLINT *symbol_colors, *symbol_numbers;
04137 PLFLT *symbol_scales;
04138 char **text;
04139 char **symbols;
04140
04141 char string[20];
04142 int number_opts;
04143 int number_texts;
04144 int dummy;
04145 double value;
04146
04147 Tcl_Obj *result;
04148 Tcl_Obj *data[2];
04149
04150 if ( argc != 29 )
04151 {
04152 Tcl_AppendResult( interp, "bogus syntax for pllegend, see doc.",
04153 (char *) NULL );
04154 return TCL_ERROR;
04155 }
04156
04157 sscanf( argv[1], "%d", &opt );
04158 sscanf( argv[2], "%d", &position );
04159 sscanf( argv[3], "%lg", &value ); x = (PLFLT) value;
04160 sscanf( argv[4], "%lg", &value ); y = (PLFLT) value;
04161 sscanf( argv[5], "%lg", &value ); plot_width = (PLFLT) value;
04162 sscanf( argv[6], "%d", &bg_color );
04163 sscanf( argv[7], "%d", &bb_color );
04164 sscanf( argv[8], "%d", &bb_style );
04165 sscanf( argv[9], "%d", &nrow );
04166 sscanf( argv[10], "%d", &ncolumn );
04167 opt_array = argv_to_ints( interp, argv[11], &number_opts );
04168 sscanf( argv[12], "%lg", &value ); text_offset = (PLFLT) value;
04169 sscanf( argv[13], "%lg", &value ); text_scale = (PLFLT) value;
04170 sscanf( argv[14], "%lg", &value ); text_spacing = (PLFLT) value;
04171 sscanf( argv[15], "%lg", &value ); text_justification = (PLFLT) value;
04172
04173 text_colors = argv_to_ints( interp, argv[16], &dummy );
04174 text = argv_to_chars( interp, argv[17], &number_texts );
04175 box_colors = argv_to_ints( interp, argv[18], &dummy );
04176 box_patterns = argv_to_ints( interp, argv[19], &dummy );
04177 box_scales = argv_to_doubles( interp, argv[20], &dummy );
04178 box_line_widths = argv_to_ints( interp, argv[21], &dummy );
04179 line_colors = argv_to_ints( interp, argv[22], &dummy );
04180 line_styles = argv_to_ints( interp, argv[23], &dummy );
04181 line_widths = argv_to_ints( interp, argv[24], &dummy );
04182 symbol_colors = argv_to_ints( interp, argv[25], &dummy );
04183 symbol_scales = argv_to_doubles( interp, argv[26], &dummy );
04184 symbol_numbers = argv_to_ints( interp, argv[27], &dummy );
04185 symbols = argv_to_chars( interp, argv[28], &dummy );
04186
04187 nlegend = MIN( number_opts, number_texts );
04188
04189 c_pllegend( &legend_width, &legend_height,
04190 opt, position, x, y, plot_width,
04191 bg_color, bb_color, bb_style,
04192 nrow, ncolumn,
04193 nlegend, opt_array,
04194 text_offset, text_scale, text_spacing,
04195 text_justification,
04196 text_colors, (const char **) text,
04197 box_colors, box_patterns,
04198 box_scales, box_line_widths,
04199 line_colors, line_styles,
04200 line_widths,
04201 symbol_colors, symbol_scales,
04202 symbol_numbers, (const char **) symbols );
04203
04204 if ( opt_array != NULL )
04205 free( opt_array );
04206 if ( text_colors != NULL )
04207 free( text_colors );
04208 if ( text != NULL )
04209 {
04210 free( text[0] );
04211 free( text );
04212 }
04213 if ( box_colors != NULL )
04214 free( box_colors );
04215 if ( box_patterns != NULL )
04216 free( box_patterns );
04217 if ( box_scales != NULL )
04218 free( box_scales );
04219 if ( box_line_widths != NULL )
04220 free( box_line_widths );
04221 if ( line_colors != NULL )
04222 free( line_colors );
04223 if ( line_styles != NULL )
04224 free( line_styles );
04225 if ( line_widths != NULL )
04226 free( line_widths );
04227 if ( symbol_colors != NULL )
04228 free( symbol_colors );
04229 if ( symbol_scales != NULL )
04230 free( symbol_scales );
04231 if ( symbol_numbers != NULL )
04232 free( symbol_numbers );
04233 if ( symbols != NULL )
04234 {
04235 free( symbols[0] );
04236 free( symbols );
04237 }
04238
04239 data[0] = Tcl_NewDoubleObj( legend_width );
04240 data[1] = Tcl_NewDoubleObj( legend_height );
04241 Tcl_SetObjResult( interp, Tcl_NewListObj( 2, data ) );
04242
04243 return TCL_OK;
04244 }