PLplot  5.10.0
plplot_impl.c
Go to the documentation of this file.
00001 //
00002 // Copyright 2007, 2008, 2009, 2010, 2011  Hezekiah M. Carty
00003 //
00004 // This file is part of PLplot.
00005 //
00006 // PLplot is free software: you can redistribute it and/or modify
00007 // it under the terms of the GNU Lesser General Public License as published by
00008 // the Free Software Foundation, either version 2 of the License, or
00009 // (at your option) any later version.
00010 //
00011 // PLplot is distributed in the hope that it will be useful,
00012 // but WITHOUT ANY WARRANTY; without even the implied warranty of
00013 // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
00014 // GNU Lesser General Public License for more details.
00015 //
00016 // You should have received a copy of the GNU Lesser General Public License
00017 // along with PLplot.  If not, see <http://www.gnu.org/licenses/>.
00018 //
00019 
00020 // The "usual" OCaml includes
00021 #include <caml/alloc.h>
00022 #include <caml/callback.h>
00023 #include <caml/fail.h>
00024 #include <caml/memory.h>
00025 #include <caml/misc.h>
00026 #include <caml/mlvalues.h>
00027 #include <caml/bigarray.h>
00028 
00029 #include <plplotP.h>
00030 #include <plplot.h>
00031 
00032 #undef snprintf
00033 
00034 #include <stdio.h>
00035 
00036 #define MAX_EXCEPTION_MESSAGE_LENGTH       1000
00037 #define CAML_PLPLOT_PLOTTER_FUNC_NAME      "caml_plplot_plotter"
00038 #define CAML_PLPLOT_MAPFORM_FUNC_NAME      "caml_plplot_mapform"
00039 #define CAML_PLPLOT_DEFINED_FUNC_NAME      "caml_plplot_defined"
00040 #define CAML_PLPLOT_LABEL_FUNC_NAME        "caml_plplot_customlabel"
00041 #define CAML_PLPLOT_ABORT_FUNC_NAME        "caml_plplot_abort"
00042 #define CAML_PLPLOT_EXIT_FUNC_NAME         "caml_plplot_exit"
00043 #define CAML_PLPLOT_TRANSFORM_FUNC_NAME    "caml_plplot_transform"
00044 
00045 typedef void ( *ML_PLOTTER_FUNC )( PLFLT, PLFLT, PLFLT*, PLFLT*, PLPointer );
00046 typedef PLINT ( *ML_DEFINED_FUNC )( PLFLT, PLFLT );
00047 typedef void ( *ML_MAPFORM_FUNC )( PLINT, PLFLT*, PLFLT* );
00048 typedef void ( *ML_LABEL_FUNC )( PLINT, PLFLT, char*, PLINT, PLPointer );
00049 typedef PLINT ( *ML_VARIANT_FUNC )( PLINT );
00050 
00051 //
00052 //
00053 // CALLBACK WRAPPERS
00054 //
00055 //
00056 
00057 // A simple routine to wrap a properly registered OCaml callback in a form
00058 // usable by PLPlot routines.  If an appropriate callback is not registered
00059 // then the PLPlot built-in pltr0 function is used instead.
00060 void ml_plotter( PLFLT x, PLFLT y, PLFLT *tx, PLFLT *ty, PLPointer pltr_data )
00061 {
00062     CAMLparam0();
00063     CAMLlocal1( result );
00064 
00065     // Get the OCaml callback function (if there is one)
00066     static value * pltr = NULL;
00067     if ( pltr == NULL )
00068         pltr = caml_named_value( CAML_PLPLOT_PLOTTER_FUNC_NAME );
00069 
00070     // No check to see if a callback function has been designated yet,
00071     // because that is checked before we get to this point.
00072     result =
00073         caml_callback2( *pltr, caml_copy_double( x ), caml_copy_double( y ) );
00074     double new_x, new_y;
00075     new_x = Double_val( Field( result, 0 ) );
00076     new_y = Double_val( Field( result, 1 ) );
00077 
00078     *tx = new_x;
00079     *ty = new_y;
00080 
00081     CAMLreturn0;
00082 }
00083 
00084 // A simple routine to wrap a properly registered OCaml callback in a form
00085 // usable by PLPlot routines.  If an appropriate callback is not registered
00086 // then the result is always 1 (the data point is defined).
00087 // This function is used in the plshade* functions to determine if a given data
00088 // point is valid/defined or not.
00089 PLINT ml_defined( PLFLT x, PLFLT y )
00090 {
00091     CAMLparam0();
00092     CAMLlocal1( result );
00093 
00094     // The result which will be returned to the user.
00095     PLINT is_it_defined;
00096 
00097     // Get the OCaml callback function (if there is one)
00098     static value * defined = NULL;
00099     if ( defined == NULL )
00100         defined = caml_named_value( CAML_PLPLOT_DEFINED_FUNC_NAME );
00101 
00102     // No check to see if a callback function has been designated yet,
00103     // because that is checked before we get to this point.
00104     result =
00105         caml_callback2( *defined, caml_copy_double( x ), caml_copy_double( y ) );
00106     is_it_defined = Int_val( result );
00107 
00108     CAMLreturn( is_it_defined );
00109 }
00110 
00111 // A simple routine to wrap a properly registered OCaml callback in a form
00112 // usable by PLPlot routines.  If an appropriate callback is not registered
00113 // then nothing is done.
00114 void ml_mapform( PLINT n, PLFLT *x, PLFLT *y )
00115 {
00116     CAMLparam0();
00117     CAMLlocal1( result );
00118 
00119     // Get the OCaml callback function (if there is one)
00120     static value * mapform = NULL;
00121     if ( mapform == NULL )
00122         mapform = caml_named_value( CAML_PLPLOT_MAPFORM_FUNC_NAME );
00123 
00124     // No check to see if a callback function has been designated yet,
00125     // because that is checked before we get to this point.
00126     int i;
00127     for ( i = 0; i < n; i++ )
00128     {
00129         result =
00130             caml_callback2( *mapform,
00131                 caml_copy_double( x[i] ), caml_copy_double( y[i] ) );
00132 
00133         double new_x, new_y;
00134         new_x = Double_val( Field( result, 0 ) );
00135         new_y = Double_val( Field( result, 1 ) );
00136 
00137         x[i] = new_x;
00138         y[i] = new_y;
00139     }
00140 
00141     CAMLreturn0;
00142 }
00143 
00144 // A simple routine to wrap a properly registered OCaml callback in a form
00145 // usable by PLPlot routines.
00146 void ml_labelfunc( PLINT axis, PLFLT n, char *label, PLINT length, PLPointer d )
00147 {
00148     CAMLparam0();
00149     CAMLlocal1( result );
00150 
00151     // Get the OCaml callback function (if there is one)
00152     static value * callback = NULL;
00153     if ( callback == NULL )
00154         callback = caml_named_value( CAML_PLPLOT_LABEL_FUNC_NAME );
00155 
00156     // No check to see if a callback function has been designated yet,
00157     // because that is checked before we get to this point.
00158     result =
00159         caml_callback2( *callback, Val_int( axis - 1 ), caml_copy_double( n ) );
00160 
00161     // Copy the OCaml callback output to the proper location.
00162     snprintf( label, length, "%s", String_val( result ) );
00163 
00164     CAMLreturn0;
00165 }
00166 
00167 // OCaml callback for plsabort
00168 void ml_abort( const char* message )
00169 {
00170     CAMLparam0();
00171     CAMLlocal1( result );
00172 
00173     // Get the OCaml callback function (if there is one)
00174     static value * handler = NULL;
00175     if ( handler == NULL )
00176         handler = caml_named_value( CAML_PLPLOT_ABORT_FUNC_NAME );
00177 
00178     // No check to see if a callback function has been designated yet,
00179     // because that is checked before we get to this point.
00180     result =
00181         caml_callback( *handler, caml_copy_string( message ) );
00182 
00183     CAMLreturn0;
00184 }
00185 
00186 // OCaml callback for plsexit
00187 int ml_exit( const char* message )
00188 {
00189     CAMLparam0();
00190     CAMLlocal1( result );
00191 
00192     // Get the OCaml callback function (if there is one)
00193     static value * handler = NULL;
00194     if ( handler == NULL )
00195         handler = caml_named_value( CAML_PLPLOT_EXIT_FUNC_NAME );
00196 
00197     // No check to see if a callback function has been designated yet,
00198     // because that is checked before we get to this point.
00199     result =
00200         caml_callback( *handler, caml_copy_string( message ) );
00201 
00202     CAMLreturn( Int_val( result ) );
00203 }
00204 
00205 // A simple routine to wrap a properly registered OCaml callback in a form
00206 // usable by PLPlot routines.  If an appropriate callback is not registered
00207 // then nothing is done.
00208 void ml_transform( PLFLT x, PLFLT y, PLFLT *xt, PLFLT *yt, PLPointer data )
00209 {
00210     CAMLparam0();
00211     CAMLlocal1( result );
00212 
00213     // Get the OCaml callback function (if there is one)
00214     static value * transform = NULL;
00215     if ( transform == NULL )
00216         transform = caml_named_value( CAML_PLPLOT_TRANSFORM_FUNC_NAME );
00217 
00218     // No check to see if a callback function has been designated yet,
00219     // because that is checked before we get to this point.
00220     result =
00221         caml_callback2( *transform, caml_copy_double( x ), caml_copy_double( y ) );
00222 
00223     *xt = Double_val( Field( result, 0 ) );
00224     *yt = Double_val( Field( result, 1 ) );
00225 
00226     CAMLreturn0;
00227 }
00228 
00229 // Check if the matching OCaml callback is defined.  Return NULL if it is not,
00230 // and the proper function pointer if it is.
00231 ML_PLOTTER_FUNC get_ml_plotter_func()
00232 {
00233     static value * pltr = NULL;
00234     if ( pltr == NULL )
00235         pltr = caml_named_value( CAML_PLPLOT_PLOTTER_FUNC_NAME );
00236 
00237     if ( pltr == NULL || Val_int( 0 ) == *pltr )
00238     {
00239         // No plotter defined
00240         return NULL;
00241     }
00242     else
00243     {
00244         // Plotter is defined
00245         return ml_plotter;
00246     }
00247 }
00248 ML_DEFINED_FUNC get_ml_defined_func()
00249 {
00250     static value * defined = NULL;
00251     if ( defined == NULL )
00252         defined = caml_named_value( CAML_PLPLOT_DEFINED_FUNC_NAME );
00253 
00254     if ( defined == NULL || Val_int( 0 ) == *defined )
00255     {
00256         // No plotter defined
00257         return NULL;
00258     }
00259     else
00260     {
00261         // Plotter is defined
00262         return ml_defined;
00263     }
00264 }
00265 ML_MAPFORM_FUNC get_ml_mapform_func()
00266 {
00267     static value * mapform = NULL;
00268     if ( mapform == NULL )
00269         mapform = caml_named_value( CAML_PLPLOT_MAPFORM_FUNC_NAME );
00270 
00271     if ( mapform == NULL || Val_int( 0 ) == *mapform )
00272     {
00273         // No plotter defined
00274         return NULL;
00275     }
00276     else
00277     {
00278         // Plotter is defined
00279         return ml_mapform;
00280     }
00281 }
00282 
00283 // Custom wrapper for plslabelfunc
00284 value ml_plslabelfunc( value unit )
00285 {
00286     CAMLparam1( unit );
00287     static value * label = NULL;
00288     if ( label == NULL )
00289         label = caml_named_value( CAML_PLPLOT_LABEL_FUNC_NAME );
00290 
00291     if ( label == NULL || Val_int( 0 ) == *label )
00292     {
00293         // No plotter defined
00294         plslabelfunc( NULL, NULL );
00295     }
00296     else
00297     {
00298         // Plotter is defined
00299         plslabelfunc( ml_labelfunc, NULL );
00300     }
00301 
00302     CAMLreturn( Val_unit );
00303 }
00304 
00305 // Custom wrappers for plsabort and plsexit
00306 value ml_plsabort( value unit )
00307 {
00308     CAMLparam1( unit );
00309     static value * handler = NULL;
00310     if ( handler == NULL )
00311         handler = caml_named_value( CAML_PLPLOT_ABORT_FUNC_NAME );
00312 
00313     if ( handler == NULL || Val_int( 0 ) == *handler )
00314     {
00315         // No handler defined
00316         plsabort( NULL );
00317     }
00318     else
00319     {
00320         // Handler is defined
00321         plsabort( ml_abort );
00322     }
00323     CAMLreturn( Val_unit );
00324 }
00325 value ml_plsexit( value unit )
00326 {
00327     CAMLparam1( unit );
00328     static value * handler = NULL;
00329     if ( handler == NULL )
00330         handler = caml_named_value( CAML_PLPLOT_EXIT_FUNC_NAME );
00331 
00332     if ( handler == NULL || Val_int( 0 ) == *handler )
00333     {
00334         // No handler defined
00335         plsexit( NULL );
00336     }
00337     else
00338     {
00339         // Handler is defined
00340         plsexit( ml_exit );
00341     }
00342     CAMLreturn( Val_unit );
00343 }
00344 
00345 // Set a global coordinate transform
00346 value ml_plstransform( value unit )
00347 {
00348     CAMLparam1( unit );
00349     static value * handler = NULL;
00350     if ( handler == NULL )
00351         handler = caml_named_value( CAML_PLPLOT_TRANSFORM_FUNC_NAME );
00352 
00353     if ( handler == NULL || Val_int( 0 ) == *handler )
00354     {
00355         // No handler defined
00356         plstransform( NULL, NULL );
00357     }
00358     else
00359     {
00360         // Handler is defined
00361         plstransform( ml_transform, NULL );
00362     }
00363     CAMLreturn( Val_unit );
00364 }
00365 
00366 //
00367 //
00368 // CONTOURING, SHADING and IMAGE FUNCTIONS
00369 //
00370 //
00371 
00372 //
00373 // void
00374 // c_plcont(PLFLT **f, PLINT nx, PLINT ny, PLINT kx, PLINT lx,
00375 // PLINT ky, PLINT ly, PLFLT *clevel, PLINT nlevel,
00376 // void (*pltr) (PLFLT, PLFLT, PLFLT *, PLFLT *, PLPointer),
00377 // PLPointer pltr_data);
00378 //
00379 void ml_plcont( const PLFLT **f, PLINT nx, PLINT ny,
00380                 PLINT kx, PLINT lx, PLINT ky, PLINT ly,
00381                 PLFLT *clevel, PLINT nlevel )
00382 {
00383     if ( get_ml_plotter_func() == NULL )
00384     {
00385         // This is handled in PLplot, but the error is raised here to clarify
00386         // what the user needs to do since the custom plotter is defined
00387         // separately from the call to plcont.
00388         caml_invalid_argument( "A custom plotter must be defined \
00389                                before calling plcont" );
00390     }
00391     else
00392     {
00393         c_plcont( f, nx, ny, kx, lx, ky, ly, clevel, nlevel,
00394             get_ml_plotter_func(), (void *) 1 );
00395     }
00396 }
00397 
00398 //
00399 // void
00400 // c_plshade(PLFLT **a, PLINT nx, PLINT ny, PLINT (*defined) (PLFLT, PLFLT),
00401 // PLFLT left, PLFLT right, PLFLT bottom, PLFLT top,
00402 // PLFLT shade_min, PLFLT shade_max,
00403 // PLINT sh_cmap, PLFLT sh_color, PLINT sh_width,
00404 // PLINT min_color, PLINT min_width,
00405 // PLINT max_color, PLINT max_width,
00406 // void (*fill) (PLINT, PLFLT *, PLFLT *), PLBOOL rectangular,
00407 // void (*pltr) (PLFLT, PLFLT, PLFLT *, PLFLT *, PLPointer),
00408 // PLPointer pltr_data);
00409 //
00410 void ml_plshade( const PLFLT **a, PLINT nx, PLINT ny,
00411                  PLFLT left, PLFLT right, PLFLT bottom, PLFLT top,
00412                  PLFLT shade_min, PLFLT shade_max,
00413                  PLINT sh_cmap, PLFLT sh_color, PLFLT sh_width,
00414                  PLINT min_color, PLFLT min_width,
00415                  PLINT max_color, PLFLT max_width,
00416                  PLBOOL rectangular )
00417 {
00418     c_plshade( a, nx, ny,
00419         get_ml_defined_func(),
00420         left, right, bottom, top,
00421         shade_min, shade_max,
00422         sh_cmap, sh_color, sh_width, min_color, min_width,
00423         max_color, max_width, plfill, rectangular,
00424         get_ml_plotter_func(), (void *) 1 );
00425 }
00426 
00427 //
00428 // void
00429 // c_plshade1(PLFLT *a, PLINT nx, PLINT ny, PLINT (*defined) (PLFLT, PLFLT),
00430 // PLFLT left, PLFLT right, PLFLT bottom, PLFLT top,
00431 // PLFLT shade_min, PLFLT shade_max,
00432 // PLINT sh_cmap, PLFLT sh_color, PLINT sh_width,
00433 // PLINT min_color, PLINT min_width,
00434 // PLINT max_color, PLINT max_width,
00435 // void (*fill) (PLINT, PLFLT *, PLFLT *), PLBOOL rectangular,
00436 // void (*pltr) (PLFLT, PLFLT, PLFLT *, PLFLT *, PLPointer),
00437 // PLPointer pltr_data);
00438 //
00439 
00440 //
00441 // void
00442 // c_plshades( PLFLT **a, PLINT nx, PLINT ny, PLINT (*defined) (PLFLT, PLFLT),
00443 // PLFLT xmin, PLFLT xmax, PLFLT ymin, PLFLT ymax,
00444 // PLFLT *clevel, PLINT nlevel, PLINT fill_width,
00445 // PLINT cont_color, PLINT cont_width,
00446 // void (*fill) (PLINT, PLFLT *, PLFLT *), PLBOOL rectangular,
00447 // void (*pltr) (PLFLT, PLFLT, PLFLT *, PLFLT *, PLPointer),
00448 // PLPointer pltr_data);
00449 //
00450 void ml_plshades( const PLFLT **a, PLINT nx, PLINT ny,
00451                   PLFLT xmin, PLFLT xmax, PLFLT ymin, PLFLT ymax,
00452                   PLFLT *clevel, PLINT nlevel, PLFLT fill_width,
00453                   PLINT cont_color, PLFLT cont_width,
00454                   PLBOOL rectangular )
00455 {
00456     c_plshades( a, nx, ny,
00457         get_ml_defined_func(),
00458         xmin, xmax, ymin, ymax,
00459         clevel, nlevel, fill_width,
00460         cont_color, cont_width,
00461         plfill, rectangular,
00462         get_ml_plotter_func(),
00463         (void *) 1 );
00464 }
00465 
00466 //
00467 // void
00468 // c_plimagefr(PLFLT **idata, PLINT nx, PLINT ny,
00469 //      PLFLT xmin, PLFLT xmax, PLFLT ymin, PLFLT ymax, PLFLT zmin, PLFLT zmax,
00470 //      PLFLT valuemin, PLFLT valuemax,
00471 //      void (*pltr) (PLFLT, PLFLT, PLFLT *, PLFLT *, PLPointer),
00472 //      PLPointer pltr_data);
00473 //
00474 void ml_plimagefr( const PLFLT **idata, PLINT nx, PLINT ny,
00475                    PLFLT xmin, PLFLT xmax, PLFLT ymin, PLFLT ymax,
00476                    PLFLT zmin, PLFLT zmax,
00477                    PLFLT valuemin, PLFLT valuemax )
00478 {
00479     c_plimagefr( idata, nx, ny,
00480         xmin, xmax, ymin, ymax,
00481         zmin, zmax,
00482         valuemin, valuemax,
00483         get_ml_plotter_func(),
00484         (void *) 1 );
00485 }
00486 
00487 //
00488 // void
00489 // c_plvect(PLFLT **u, PLFLT **v, PLINT nx, PLINT ny, PLFLT scale,
00490 // void (*pltr) (PLFLT, PLFLT, PLFLT *, PLFLT *, PLPointer),
00491 //      PLPointer pltr_data);
00492 //
00493 void ml_plvect( const PLFLT **u, const PLFLT **v, PLINT nx, PLINT ny, PLFLT scale )
00494 {
00495     c_plvect( u, v, nx, ny, scale,
00496         get_ml_plotter_func(),
00497         (void *) 1 );
00498 }
00499 
00500 //
00501 // Wrapper to reset vector rendering
00502 //
00503 void ml_plsvect_reset()
00504 {
00505     c_plsvect( NULL, NULL, 0, 0 );
00506 }
00507 
00508 //
00509 // void
00510 // c_plmap( void (*mapform)(PLINT, PLFLT *, PLFLT *), const char *type,
00511 //       PLFLT minlong, PLFLT maxlong, PLFLT minlat, PLFLT maxlat );
00512 //
00513 void ml_plmap( const char *type,
00514                PLFLT minlong, PLFLT maxlong, PLFLT minlat, PLFLT maxlat )
00515 {
00516     c_plmap( get_ml_mapform_func(),
00517         type, minlong, maxlong, minlat, maxlat );
00518 }
00519 
00520 //
00521 // void
00522 // c_plmeridians( void (*mapform)(PLINT, PLFLT *, PLFLT *),
00523 //             PLFLT dlong, PLFLT dlat,
00524 //             PLFLT minlong, PLFLT maxlong, PLFLT minlat, PLFLT maxlat );
00525 //
00526 void ml_plmeridians( PLFLT dlong, PLFLT dlat,
00527                      PLFLT minlong, PLFLT maxlong, PLFLT minlat, PLFLT maxlat )
00528 {
00529     c_plmeridians( get_ml_mapform_func(),
00530         dlong, dlat, minlong, maxlong, minlat, maxlat );
00531 }
00532 
00533 //
00534 // void
00535 // c_plgriddata(PLFLT *x, PLFLT *y, PLFLT *z, PLINT npts,
00536 //  PLFLT *xg, PLINT nptsx, PLFLT *yg, PLINT nptsy,
00537 //  PLFLT **zg, PLINT type, PLFLT data);
00538 //
00539 // This one is currently wrapped by hand, as I am not sure how to get camlidl
00540 // to allocate zg in a way that makes plgriddata happy and doesn't require the
00541 // user to pre-allocate the space.
00542 value ml_plgriddata( value x, value y, value z,
00543                      value xg, value yg,
00544                      value type, value data )
00545 {
00546     CAMLparam5( x, y, z, xg, yg );
00547     CAMLxparam2( type, data );
00548 
00549     // zg holds the OCaml float array array.
00550     // y_ml_array is a temporary structure which will be used to form each
00551     // float array making up zg.
00552     CAMLlocal2( zg, y_ml_array );
00553 
00554     PLFLT **zg_local;
00555 
00556     int   npts, nptsx, nptsy;
00557     int   i, j;
00558 
00559     // Check to make sure x, y and z are all the same length.
00560     npts = Wosize_val( x ) / Double_wosize;
00561     if ( ( Wosize_val( y ) / Double_wosize != Wosize_val( z ) / Double_wosize ) ||
00562          ( Wosize_val( y ) / Double_wosize != npts ) ||
00563          ( Wosize_val( z ) / Double_wosize != npts )
00564          )
00565     {
00566         caml_failwith( "ml_plgriddata: x, y, z must all have the same dimensions" );
00567     }
00568 
00569     nptsx = Wosize_val( xg ) / Double_wosize;
00570     nptsy = Wosize_val( yg ) / Double_wosize;
00571 
00572     // Allocate the 2D grid in a way that will make PLplot happy
00573     plAlloc2dGrid( &zg_local, nptsx, nptsy );
00574 
00575     // Using "type + 1" because "type" is passed in as a variant type, so
00576     // the indexing starts from 0 rather than 1.
00577     c_plgriddata( (double *) x, (double *) y, (double *) z, npts, (double *) xg, nptsx,
00578         (double *) yg, nptsy, zg_local, Int_val( type ) + 1,
00579         Double_val( data ) );
00580 
00581     // Allocate the X-dimension of the to-be-returned OCaml array
00582     zg = caml_alloc( nptsx, 0 );
00583 
00584     for ( i = 0; i < nptsx; i++ )
00585     {
00586         // Allocate each Y-dimension array of the OCaml array
00587         y_ml_array = caml_alloc( nptsy * Double_wosize, Double_array_tag );
00588         for ( j = 0; j < nptsy; j++ )
00589         {
00590             Store_double_field( y_ml_array, j, zg_local[i][j] );
00591         }
00592         caml_modify( &Field( zg, i ), y_ml_array );
00593     }
00594 
00595     // Free the memory used by the C array
00596     plFree2dGrid( zg_local, nptsx, nptsy );
00597 
00598     CAMLreturn( zg );
00599 }
00600 
00601 value ml_plgriddata_bytecode( value* argv, int argn )
00602 {
00603     return ml_plgriddata( argv[0], argv[1], argv[2], argv[3], argv[4],
00604         argv[5], argv[6] );
00605 }
00606 
00607 //
00608 // void
00609 // c_plpoly3(PLINT n, PLFLT *x, PLFLT *y, PLFLT *z, PLBOOL *draw, PLBOOL ifcc);
00610 //
00611 // plpoly3 is wrapped by hand because draw has a length of (n - 1) and camlidl
00612 // does not have a way to indicate this automatically.
00613 void ml_plpoly3( PLINT n, PLFLT *x, PLFLT *y, PLFLT *z, PLINT ndraw, PLBOOL *draw, PLBOOL ifcc )
00614 {
00615     plpoly3( n, x, y, z, draw, ifcc );
00616 }
00617 
00618 // Raise Invalid_argument if the given value is <> 0
00619 void plplot_check_nonzero_result( int result )
00620 {
00621     if ( result != 0 )
00622     {
00623         char exception_message[MAX_EXCEPTION_MESSAGE_LENGTH];
00624         sprintf( exception_message, "Error, return code %d", result );
00625         caml_invalid_argument( exception_message );
00626     }
00627     return;
00628 }
00629 
00630 // Translate the integer version of the OCaml variant to the appropriate
00631 // PLplot constant.
00632 int translate_parse_option( int parse_option )
00633 {
00634     int translated_option;
00635     switch ( parse_option )
00636     {
00637     case 0: translated_option  = PL_PARSE_PARTIAL; break;
00638     case 1: translated_option  = PL_PARSE_FULL; break;
00639     case 2: translated_option  = PL_PARSE_QUIET; break;
00640     case 3: translated_option  = PL_PARSE_NODELETE; break;
00641     case 4: translated_option  = PL_PARSE_SHOWALL; break;
00642     case 5: translated_option  = PL_PARSE_OVERRIDE; break;
00643     case 6: translated_option  = PL_PARSE_NOPROGRAM; break;
00644     case 7: translated_option  = PL_PARSE_NODASH; break;
00645     case 8: translated_option  = PL_PARSE_SKIP; break;
00646     default: translated_option = -1;
00647     }
00648     return translated_option;
00649 }
00650 
00651 // Copy a string array
00652 #define INIT_STRING_ARRAY( o )         \
00653     int o ## _length;                  \
00654     o ## _length = Wosize_val( o );    \
00655     const char *c_ ## o[o ## _length]; \
00656     for ( i = 0; i < o ## _length; i++ ) { c_ ## o[i] = String_val( Field( o, i ) ); }
00657 
00658 // Copy an int array, o, of n element to the C array c
00659 #define INIT_INT_ARRAY( o )         \
00660     int o ## _length;               \
00661     o ## _length = Wosize_val( o ); \
00662     int c_ ## o[o ## _length];      \
00663     for ( i = 0; i < ( o ## _length ); i++ ) { ( c_ ## o )[i] = Int_val( Field( ( o ), i ) ); }
00664 
00665 // Copy an int array, o, of n element to the C array c
00666 #define INIT_INT_ARRAYS( o )                   \
00667     int o ## _length, o ## _inner;             \
00668     o ## _length = Wosize_val( o );            \
00669     int *c_ ## o[o ## _length];                \
00670     for ( i = 0; i < ( o ## _length ); i++ ) { \
00671         INIT_INT_ARRAY( o ## _subarray );      \
00672         ( c_ ## o )[i] = c_ ## o ## _subarray; \
00673     }
00674 
00675 int lor_ml_list( value list, ML_VARIANT_FUNC variant_f )
00676 {
00677     CAMLparam1( list );
00678     int result;
00679 
00680     result = 0;
00681     while ( list != Val_emptylist )
00682     {
00683         // Accumulate the elements of the list
00684         result = result | variant_f( Int_val( Field( list, 0 ) ) );
00685         // Point to the tail of the list for the next loop
00686         list = Field( list, 1 );
00687     }
00688 
00689     CAMLreturn( result );
00690 }
00691 
00692 value ml_plparseopts( value argv, value parse_method )
00693 {
00694     CAMLparam2( argv, parse_method );
00695     int i;
00696     int result;
00697     int combined_parse_method;
00698     // Make a copy of the command line argument strings
00699     INIT_STRING_ARRAY( argv )
00700 
00701     // OR the elements of the parse_method list together
00702     combined_parse_method = lor_ml_list( parse_method, translate_parse_option );
00703 
00704     result = plparseopts( &argv_length, c_argv, combined_parse_method );
00705     if ( result != 0 )
00706     {
00707         char exception_message[MAX_EXCEPTION_MESSAGE_LENGTH];
00708         sprintf( exception_message, "Invalid arguments in plparseopts, error %d", result );
00709         caml_invalid_argument( exception_message );
00710     }
00711     CAMLreturn( Val_unit );
00712 }
00713 
00714 value ml_plstripc( value xspec, value yspec, value xmin, value xmax, value xjump,
00715                    value ymin, value ymax, value xlpos, value ylpos, value y_ascl,
00716                    value acc, value colbox, value collab, value colline, value styline,
00717                    value legline, value labx, value laby, value labtop )
00718 {
00719     // Function parameters
00720     CAMLparam5( xspec, yspec, xmin, xmax, xjump );
00721     CAMLxparam5( ymin, ymax, xlpos, ylpos, y_ascl );
00722     CAMLxparam5( acc, colbox, collab, colline, styline );
00723     CAMLxparam4( legline, labx, laby, labtop );
00724     // Line attribute array copies
00725     int       colline_copy[4];
00726     int       styline_copy[4];
00727     const char* legend_copy[4];
00728     int       i;
00729     for ( i = 0; i < 4; i++ )
00730     {
00731         colline_copy[i] = Int_val( Field( colline, i ) );
00732         styline_copy[i] = Int_val( Field( styline, i ) );
00733         legend_copy[i]  = String_val( Field( legline, i ) );
00734     }
00735     // The returned value
00736     int id;
00737     plstripc( &id, String_val( xspec ), String_val( yspec ),
00738         Double_val( xmin ), Double_val( xmax ),
00739         Double_val( xjump ), Double_val( ymin ), Double_val( ymax ),
00740         Double_val( xlpos ), Double_val( ylpos ), Bool_val( y_ascl ),
00741         Bool_val( acc ), Int_val( colbox ), Int_val( collab ),
00742         colline_copy, styline_copy, legend_copy,
00743         String_val( labx ), String_val( laby ), String_val( labtop ) );
00744     // Make me do something!
00745     CAMLreturn( Val_int( id ) );
00746 }
00747 
00748 value ml_plstripc_byte( value* argv, int argn )
00749 {
00750     return ml_plstripc( argv[0], argv[1], argv[2], argv[3], argv[4],
00751         argv[5], argv[6], argv[7], argv[8], argv[9],
00752         argv[10], argv[11], argv[12], argv[13], argv[14],
00753         argv[15], argv[16], argv[17], argv[18] );
00754 }
00755 
00756 int translate_legend_option( int legend_option )
00757 {
00758     int translated_option;
00759     switch ( legend_option )
00760     {
00761     case 0: translated_option  = PL_LEGEND_NONE; break;
00762     case 1: translated_option  = PL_LEGEND_COLOR_BOX; break;
00763     case 2: translated_option  = PL_LEGEND_LINE; break;
00764     case 3: translated_option  = PL_LEGEND_SYMBOL; break;
00765     case 4: translated_option  = PL_LEGEND_TEXT_LEFT; break;
00766     case 5: translated_option  = PL_LEGEND_BACKGROUND; break;
00767     case 6: translated_option  = PL_LEGEND_BOUNDING_BOX; break;
00768     case 7: translated_option  = PL_LEGEND_ROW_MAJOR; break;
00769     default: translated_option = -1;
00770     }
00771     return translated_option;
00772 }
00773 
00774 int translate_colorbar_option( int colorbar_option )
00775 {
00776     int translated_option;
00777     switch ( colorbar_option )
00778     {
00779     case 0: translated_option  = PL_COLORBAR_LABEL_LEFT; break;
00780     case 1: translated_option  = PL_COLORBAR_LABEL_RIGHT; break;
00781     case 2: translated_option  = PL_COLORBAR_LABEL_TOP; break;
00782     case 3: translated_option  = PL_COLORBAR_LABEL_BOTTOM; break;
00783     case 4: translated_option  = PL_COLORBAR_IMAGE; break;
00784     case 5: translated_option  = PL_COLORBAR_SHADE; break;
00785     case 6: translated_option  = PL_COLORBAR_GRADIENT; break;
00786     case 7: translated_option  = PL_COLORBAR_CAP_NONE; break;
00787     case 8: translated_option  = PL_COLORBAR_CAP_LOW; break;
00788     case 9: translated_option  = PL_COLORBAR_CAP_HIGH; break;
00789     case 10: translated_option = PL_COLORBAR_SHADE_LABEL; break;
00790     case 11: translated_option = PL_COLORBAR_ORIENT_RIGHT; break;
00791     case 12: translated_option = PL_COLORBAR_ORIENT_TOP; break;
00792     case 13: translated_option = PL_COLORBAR_ORIENT_LEFT; break;
00793     case 14: translated_option = PL_COLORBAR_ORIENT_BOTTOM; break;
00794     case 15: translated_option = PL_COLORBAR_BACKGROUND; break;
00795     case 16: translated_option = PL_COLORBAR_BOUNDING_BOX; break;
00796     default: translated_option = -1;
00797     }
00798     return translated_option;
00799 }
00800 
00801 int translate_position_option( int position_option )
00802 {
00803     int translated_option;
00804     switch ( position_option )
00805     {
00806     case 0: translated_option  = PL_POSITION_LEFT; break;
00807     case 1: translated_option  = PL_POSITION_RIGHT; break;
00808     case 2: translated_option  = PL_POSITION_TOP; break;
00809     case 3: translated_option  = PL_POSITION_BOTTOM; break;
00810     case 4: translated_option  = PL_POSITION_INSIDE; break;
00811     case 5: translated_option  = PL_POSITION_OUTSIDE; break;
00812     case 6: translated_option  = PL_POSITION_VIEWPORT; break;
00813     case 7: translated_option  = PL_POSITION_SUBPAGE; break;
00814     default: translated_option = -1;
00815     }
00816     return translated_option;
00817 }
00818 
00819 value ml_pllegend( value opt, value position, value x, value y, value plot_width,
00820                    value bg_color,
00821                    value bb_color, value bb_style,
00822                    value nrow, value ncolumn,
00823                    value opt_array,
00824                    value text_offset, value text_scale, value text_spacing,
00825                    value text_justification, value text_colors, value text,
00826                    value box_colors, value box_patterns, value box_scales,
00827                    value box_line_widths,
00828                    value line_colors, value line_styles, value line_widths,
00829                    value symbol_colors, value symbol_scales,
00830                    value symbol_numbers, value symbols )
00831 {
00832     CAMLparam5( position, opt, x, y, plot_width );
00833     CAMLxparam5( bg_color, bb_color, bb_style, nrow, ncolumn );
00834     CAMLxparam5( opt_array, text_offset, text_scale, text_spacing, text_justification );
00835     CAMLxparam5( text_colors, text, box_colors, box_patterns, box_scales );
00836     CAMLxparam5( box_line_widths, line_colors, line_styles, line_widths, symbol_colors );
00837     CAMLxparam3( symbol_scales, symbol_numbers, symbols );
00838     CAMLlocal1( result );
00839     result = caml_alloc( 2, 0 );
00840 
00841     // Counter
00842     int i;
00843     // General legend options
00844     int c_position, c_opt;
00845     // Number of legend entries
00846     int n_legend;
00847     n_legend = Wosize_val( opt_array );
00848     // Options for each legend entry
00849     int c_opt_array[n_legend];
00850 
00851     // Assume that the dimensions all line up on the OCaml side, so we don't
00852     // need to do any further dimension checks.
00853 
00854     // Define and initialize all of the C arrays to pass in to pllegend
00855     INIT_STRING_ARRAY( text )
00856     INIT_INT_ARRAY( text_colors )
00857     INIT_INT_ARRAY( box_colors )
00858     INIT_INT_ARRAY( box_patterns )
00859     INIT_INT_ARRAY( line_colors )
00860     INIT_INT_ARRAY( line_styles )
00861     INIT_INT_ARRAY( symbol_colors )
00862     INIT_INT_ARRAY( symbol_numbers )
00863     INIT_STRING_ARRAY( symbols )
00864 
00865     // Translate the legend configuration options
00866     c_opt      = lor_ml_list( opt, translate_legend_option );
00867     c_position = lor_ml_list( position, translate_position_option );
00868 
00869     for ( i = 0; i < n_legend; i++ )
00870     {
00871         c_opt_array[i] =
00872             lor_ml_list( Field( opt_array, i ), translate_legend_option );
00873     }
00874 
00875     // The returned width and height of the legend
00876     PLFLT width, height;
00877 
00878     pllegend( &width, &height, c_opt, c_position, Double_val( x ), Double_val( y ),
00879         Double_val( plot_width ), Int_val( bg_color ),
00880         Int_val( bb_color ), Int_val( bb_style ),
00881         Int_val( nrow ), Int_val( ncolumn ),
00882         n_legend, c_opt_array,
00883         Double_val( text_offset ), Double_val( text_scale ),
00884         Double_val( text_spacing ),
00885         Double_val( text_justification ),
00886         c_text_colors, c_text,
00887         c_box_colors, c_box_patterns, (double *) box_scales,
00888         (double *) box_line_widths,
00889         c_line_colors, c_line_styles, (double *) line_widths,
00890         c_symbol_colors, (double *) symbol_scales, c_symbol_numbers,
00891         c_symbols );
00892 
00893     // Return a tuple with the legend's size
00894     Store_field( result, 0, caml_copy_double( width ) );
00895     Store_field( result, 1, caml_copy_double( height ) );
00896 
00897     CAMLreturn( result );
00898 }
00899 
00900 value ml_pllegend_byte( value* argv, int argn )
00901 {
00902     return ml_pllegend( argv[0], argv[1], argv[2], argv[3], argv[4],
00903         argv[5], argv[6], argv[7], argv[8], argv[9],
00904         argv[10], argv[11], argv[12], argv[13], argv[14],
00905         argv[15], argv[16], argv[17], argv[18], argv[19],
00906         argv[20], argv[21], argv[22], argv[23], argv[24],
00907         argv[25], argv[26], argv[27] );
00908 }
00909 
00910 value ml_plcolorbar( value opt, value position, value x, value y,
00911                      value x_length, value y_length,
00912                      value bg_color, value bb_color, value bb_style,
00913                      value low_cap_color, value high_cap_color,
00914                      value cont_color, value cont_width,
00915                      value label_opts, value label,
00916                      value axis_opts,
00917                      value ticks, value sub_ticks,
00918                      value values )
00919 {
00920     CAMLparam5( opt, position, x, y, x_length );
00921     CAMLxparam5( y_length, bg_color, bb_color, bb_style, low_cap_color );
00922     CAMLxparam5( high_cap_color, cont_color, cont_width, label_opts, label );
00923     CAMLxparam4( axis_opts, ticks, sub_ticks, values );
00924     CAMLlocal1( result );
00925     result = caml_alloc( 2, 0 );
00926 
00927     // Counter
00928     int i;
00929     // General colorbar options
00930     int c_opt, c_position;
00931     // Number of labels
00932     int n_labels;
00933     n_labels = Wosize_val( label_opts );
00934     // Number of axes and value ranges
00935     int n_axes;
00936     n_axes = Wosize_val( axis_opts );
00937 
00938     // Translate configuration options
00939     c_opt      = lor_ml_list( opt, translate_colorbar_option );
00940     c_position = lor_ml_list( position, translate_position_option );
00941 
00942     // Assume that the dimensions all line up on the OCaml side, so we don't
00943     // need to do any further dimension checks.
00944 
00945     // Define and initialize all of the C arrays to pass into plcolorbar
00946     INIT_STRING_ARRAY( label )
00947     INIT_STRING_ARRAY( axis_opts )
00948     INIT_INT_ARRAY( sub_ticks );
00949 
00950     // Label options
00951     int c_label_opts[ n_labels ];
00952     for ( i = 0; i < n_labels; i++ )
00953     {
00954         c_label_opts[i] = lor_ml_list( Field( label_opts, i ), translate_colorbar_option );
00955     }
00956 
00957     // Copy the axis/range values
00958     double **c_values;
00959     int    n_values[ n_axes ];
00960     c_values = malloc( n_axes * sizeof ( double * ) );
00961     // TODO: Add allocation failure check
00962     for ( i = 0; i < n_axes; i++ )
00963     {
00964         c_values[i] = (double *) Field( values, i );
00965         n_values[i] = Wosize_val( Field( values, i ) ) / Double_wosize;
00966     }
00967 
00968     // Return values
00969     PLFLT width, height;
00970 
00971     plcolorbar( &width, &height,
00972         c_opt, c_position, Double_val( x ), Double_val( y ),
00973         Double_val( x_length ), Double_val( y_length ),
00974         Int_val( bg_color ), Int_val( bb_color ), Int_val( bb_style ),
00975         Double_val( low_cap_color ), Double_val( high_cap_color ),
00976         Int_val( cont_color ), Double_val( cont_width ),
00977         n_labels, c_label_opts, c_label,
00978         n_axes, c_axis_opts,
00979         (double *) ticks, c_sub_ticks,
00980         n_values, (const PLFLT * const *) c_values );
00981 
00982     // Return a tuple with the colorbar's size
00983     Store_field( result, 0, caml_copy_double( width ) );
00984     Store_field( result, 1, caml_copy_double( height ) );
00985 
00986     CAMLreturn( result );
00987 }
00988 
00989 value ml_plcolorbar_byte( value *argv, int argn )
00990 {
00991     return ml_plcolorbar( argv[0], argv[1], argv[2], argv[3], argv[4],
00992         argv[5], argv[6], argv[7], argv[8], argv[9],
00993         argv[10], argv[11], argv[12], argv[13], argv[14],
00994         argv[15], argv[16], argv[17], argv[18] );
00995 }
00996 
00997 // pltr* function implementations
00998 void ml_pltr0( double x, double y, double* tx, double* ty )
00999 {
01000     pltr0( x, y, tx, ty, NULL );
01001 }
01002 
01003 value ml_pltr1( value xg, value yg, value x, value y )
01004 {
01005     CAMLparam4( xg, yg, x, y );
01006     CAMLlocal1( tx_ty );
01007     tx_ty = caml_alloc( 2, 0 );
01008     double  tx;
01009     double  ty;
01010     PLcGrid grid;
01011     grid.xg = (double *) xg;
01012     grid.yg = (double *) yg;
01013     grid.nx = Wosize_val( xg ) / Double_wosize;
01014     grid.ny = Wosize_val( yg ) / Double_wosize;
01015     pltr1( Double_val( x ), Double_val( y ), &tx, &ty, ( PLPointer ) & grid );
01016 
01017     // Allocate a tuple and return it with the results
01018     Store_field( tx_ty, 0, caml_copy_double( tx ) );
01019     Store_field( tx_ty, 1, caml_copy_double( ty ) );
01020     CAMLreturn( tx_ty );
01021 }
01022 
01023 value ml_pltr2( value xg, value yg, value x, value y )
01024 {
01025     CAMLparam4( xg, yg, x, y );
01026     CAMLlocal1( tx_ty );
01027     tx_ty = caml_alloc( 2, 0 );
01028     double   ** c_xg;
01029     double   ** c_yg;
01030     int      i;
01031     int      length1;
01032     int      length2;
01033     PLcGrid2 grid;
01034     double   tx;
01035     double   ty;
01036 
01037     // TODO: As of now, you will probably get a segfault of the xg and yg
01038     // dimensions don't match up properly.
01039     // Build the grid.
01040     // Length of "outer" array
01041     length1 = Wosize_val( xg );
01042     // Length of the "inner" arrays
01043     length2 = Wosize_val( Field( xg, 0 ) ) / Double_wosize;
01044     c_xg    = malloc( length1 * sizeof ( double* ) );
01045     for ( i = 0; i < length1; i++ )
01046     {
01047         c_xg[i] = (double *) Field( xg, i );
01048     }
01049     c_yg = malloc( length1 * sizeof ( double* ) );
01050     for ( i = 0; i < length1; i++ )
01051     {
01052         c_yg[i] = (double *) Field( yg, i );
01053     }
01054     grid.xg = c_xg;
01055     grid.yg = c_yg;
01056     grid.nx = length1;
01057     grid.ny = length2;
01058 
01059     pltr2( Double_val( x ), Double_val( y ), &tx, &ty, ( PLPointer ) & grid );
01060 
01061     // Clean up
01062     free( c_xg );
01063     free( c_yg );
01064 
01065     // Allocate a tuple and return it with the results
01066     Store_field( tx_ty, 0, caml_copy_double( tx ) );
01067     Store_field( tx_ty, 1, caml_copy_double( ty ) );
01068     CAMLreturn( tx_ty );
01069 }
01070 
01071 // XXX Non-core functions follow XXX
01072 //*
01073 // The following functions are here for (my?) convenience.  As far as I can
01074 // tell, they are not defined in the core PLplot library.
01075 //
01076 
01077 // Get the current color map 0 color index
01078 int plg_current_col0( void )
01079 {
01080     return plsc->icol0;
01081 }
01082 
01083 // Get the current color map 1 color index
01084 PLFLT plg_current_col1( void )
01085 {
01086     return plsc->icol1;
01087 }
01088 
01089 // Get the current pen width. TODO: Remove this, as I think this information
01090 // can be retrieved from another proper PLplot function.
01091 PLFLT plgwidth( void )
01092 {
01093     return plsc->width;
01094 }
01095 
01096 // Get the current character (text) height in mm.  TODO: Remove this, as I
01097 // think this information can be retrieved from another proper PLplot
01098 // function
01099 PLFLT plgchrht( void )
01100 {
01101     return plsc->chrht;
01102 }
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Defines