• Main Page
  • Namespaces
  • Classes
  • Files
  • File List
  • File Members

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, PLINT sh_width,
00414                  PLINT min_color, PLINT min_width,
00415                  PLINT max_color, PLINT 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, PLINT fill_width,
00453                   PLINT cont_color, PLINT 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 // void
00502 // c_plmap( void (*mapform)(PLINT, PLFLT *, PLFLT *), const char *type,
00503 //       PLFLT minlong, PLFLT maxlong, PLFLT minlat, PLFLT maxlat );
00504 //
00505 void ml_plmap( const char *type,
00506                PLFLT minlong, PLFLT maxlong, PLFLT minlat, PLFLT maxlat )
00507 {
00508     c_plmap( get_ml_mapform_func(),
00509         type, minlong, maxlong, minlat, maxlat );
00510 }
00511 
00512 //
00513 // void
00514 // c_plmeridians( void (*mapform)(PLINT, PLFLT *, PLFLT *),
00515 //             PLFLT dlong, PLFLT dlat,
00516 //             PLFLT minlong, PLFLT maxlong, PLFLT minlat, PLFLT maxlat );
00517 //
00518 void ml_plmeridians( PLFLT dlong, PLFLT dlat,
00519                      PLFLT minlong, PLFLT maxlong, PLFLT minlat, PLFLT maxlat )
00520 {
00521     c_plmeridians( get_ml_mapform_func(),
00522         dlong, dlat, minlong, maxlong, minlat, maxlat );
00523 }
00524 
00525 //
00526 // void
00527 // c_plgriddata(PLFLT *x, PLFLT *y, PLFLT *z, PLINT npts,
00528 //  PLFLT *xg, PLINT nptsx, PLFLT *yg, PLINT nptsy,
00529 //  PLFLT **zg, PLINT type, PLFLT data);
00530 //
00531 // This one is currently wrapped by hand, as I am not sure how to get camlidl
00532 // to allocate zg in a way that makes plgriddata happy and doesn't require the
00533 // user to pre-allocate the space.
00534 value ml_plgriddata( value x, value y, value z,
00535                      value xg, value yg,
00536                      value type, value data )
00537 {
00538     CAMLparam5( x, y, z, xg, yg );
00539     CAMLxparam2( type, data );
00540 
00541     // zg holds the OCaml float array array.
00542     // y_ml_array is a temporary structure which will be used to form each
00543     // float array making up zg.
00544     CAMLlocal2( zg, y_ml_array );
00545 
00546     PLFLT **zg_local;
00547 
00548     int   npts, nptsx, nptsy;
00549     int   i, j;
00550 
00551     // Check to make sure x, y and z are all the same length.
00552     npts = Wosize_val( x ) / Double_wosize;
00553     if ( ( Wosize_val( y ) / Double_wosize != Wosize_val( z ) / Double_wosize ) ||
00554          ( Wosize_val( y ) / Double_wosize != npts ) ||
00555          ( Wosize_val( z ) / Double_wosize != npts )
00556          )
00557     {
00558         caml_failwith( "ml_plgriddata: x, y, z must all have the same dimensions" );
00559     }
00560 
00561     nptsx = Wosize_val( xg ) / Double_wosize;
00562     nptsy = Wosize_val( yg ) / Double_wosize;
00563 
00564     // Allocate the 2D grid in a way that will make PLplot happy
00565     plAlloc2dGrid( &zg_local, nptsx, nptsy );
00566 
00567     // Using "type + 1" because "type" is passed in as a variant type, so
00568     // the indexing starts from 0 rather than 1.
00569     c_plgriddata( (double *) x, (double *) y, (double *) z, npts, (double *) xg, nptsx,
00570         (double *) yg, nptsy, zg_local, Int_val( type ) + 1,
00571         Double_val( data ) );
00572 
00573     // Allocate the X-dimension of the to-be-returned OCaml array
00574     zg = caml_alloc( nptsx, 0 );
00575 
00576     for ( i = 0; i < nptsx; i++ )
00577     {
00578         // Allocate each Y-dimension array of the OCaml array
00579         y_ml_array = caml_alloc( nptsy * Double_wosize, Double_array_tag );
00580         for ( j = 0; j < nptsy; j++ )
00581         {
00582             Store_double_field( y_ml_array, j, zg_local[i][j] );
00583         }
00584         caml_modify( &Field( zg, i ), y_ml_array );
00585     }
00586 
00587     // Free the memory used by the C array
00588     plFree2dGrid( zg_local, nptsx, nptsy );
00589 
00590     CAMLreturn( zg );
00591 }
00592 
00593 value ml_plgriddata_bytecode( value* argv, int argn )
00594 {
00595     return ml_plgriddata( argv[0], argv[1], argv[2], argv[3], argv[4],
00596         argv[5], argv[6] );
00597 }
00598 
00599 //
00600 // void
00601 // c_plpoly3(PLINT n, PLFLT *x, PLFLT *y, PLFLT *z, PLBOOL *draw, PLBOOL ifcc);
00602 //
00603 // plpoly3 is wrapped by hand because draw has a length of (n - 1) and camlidl
00604 // does not have a way to indicate this automatically.
00605 void ml_plpoly3( PLINT n, PLFLT *x, PLFLT *y, PLFLT *z, PLINT ndraw, PLBOOL *draw, PLBOOL ifcc )
00606 {
00607     plpoly3( n, x, y, z, draw, ifcc );
00608 }
00609 
00610 // Raise Invalid_argument if the given value is <> 0
00611 void plplot_check_nonzero_result( int result )
00612 {
00613     if ( result != 0 )
00614     {
00615         char exception_message[MAX_EXCEPTION_MESSAGE_LENGTH];
00616         sprintf( exception_message, "Error, return code %d", result );
00617         caml_invalid_argument( exception_message );
00618     }
00619     return;
00620 }
00621 
00622 // Translate the integer version of the OCaml variant to the appropriate
00623 // PLplot constant.
00624 int translate_parse_option( int parse_option )
00625 {
00626     int translated_option;
00627     switch ( parse_option )
00628     {
00629     case 0: translated_option  = PL_PARSE_PARTIAL; break;
00630     case 1: translated_option  = PL_PARSE_FULL; break;
00631     case 2: translated_option  = PL_PARSE_QUIET; break;
00632     case 3: translated_option  = PL_PARSE_NODELETE; break;
00633     case 4: translated_option  = PL_PARSE_SHOWALL; break;
00634     case 5: translated_option  = PL_PARSE_OVERRIDE; break;
00635     case 6: translated_option  = PL_PARSE_NOPROGRAM; break;
00636     case 7: translated_option  = PL_PARSE_NODASH; break;
00637     case 8: translated_option  = PL_PARSE_SKIP; break;
00638     default: translated_option = -1;
00639     }
00640     return translated_option;
00641 }
00642 
00643 // Copy a string array
00644 #define INIT_STRING_ARRAY( o )         \
00645     int o ## _length;                  \
00646     o ## _length = Wosize_val( o );    \
00647     const char *c_ ## o[o ## _length]; \
00648     for ( i = 0; i < o ## _length; i++ ) { c_ ## o[i] = String_val( Field( o, i ) ); }
00649 
00650 // Copy an int array, o, of n element to the C array c
00651 #define INIT_INT_ARRAY( o )         \
00652     int o ## _length;               \
00653     o ## _length = Wosize_val( o ); \
00654     int c_ ## o[o ## _length];      \
00655     for ( i = 0; i < ( o ## _length ); i++ ) { ( c_ ## o )[i] = Int_val( Field( ( o ), i ) ); }
00656 
00657 int lor_ml_list( value list, ML_VARIANT_FUNC variant_f )
00658 {
00659     CAMLparam1( list );
00660     int result;
00661 
00662     result = 0;
00663     while ( list != Val_emptylist )
00664     {
00665         // Accumulate the elements of the list
00666         result = result | variant_f( Int_val( Field( list, 0 ) ) );
00667         // Point to the tail of the list for the next loop
00668         list = Field( list, 1 );
00669     }
00670 
00671     CAMLreturn( result );
00672 }
00673 
00674 value ml_plparseopts( value argv, value parse_method )
00675 {
00676     CAMLparam2( argv, parse_method );
00677     int i;
00678     int result;
00679     int combined_parse_method;
00680     // Make a copy of the command line argument strings
00681     INIT_STRING_ARRAY( argv )
00682 
00683     // OR the elements of the parse_method list together
00684     combined_parse_method = lor_ml_list( parse_method, translate_parse_option );
00685 
00686     result = plparseopts( &argv_length, c_argv, combined_parse_method );
00687     if ( result != 0 )
00688     {
00689         char exception_message[MAX_EXCEPTION_MESSAGE_LENGTH];
00690         sprintf( exception_message, "Invalid arguments in plparseopts, error %d", result );
00691         caml_invalid_argument( exception_message );
00692     }
00693     CAMLreturn( Val_unit );
00694 }
00695 
00696 value ml_plstripc( value xspec, value yspec, value xmin, value xmax, value xjump,
00697                    value ymin, value ymax, value xlpos, value ylpos, value y_ascl,
00698                    value acc, value colbox, value collab, value colline, value styline,
00699                    value legline, value labx, value laby, value labtop )
00700 {
00701     // Function parameters
00702     CAMLparam5( xspec, yspec, xmin, xmax, xjump );
00703     CAMLxparam5( ymin, ymax, xlpos, ylpos, y_ascl );
00704     CAMLxparam5( acc, colbox, collab, colline, styline );
00705     CAMLxparam4( legline, labx, laby, labtop );
00706     // Line attribute array copies
00707     int       colline_copy[4];
00708     int       styline_copy[4];
00709     const char* legend_copy[4];
00710     int       i;
00711     for ( i = 0; i < 4; i++ )
00712     {
00713         colline_copy[i] = Int_val( Field( colline, i ) );
00714         styline_copy[i] = Int_val( Field( styline, i ) );
00715         legend_copy[i]  = String_val( Field( legline, i ) );
00716     }
00717     // The returned value
00718     int id;
00719     plstripc( &id, String_val( xspec ), String_val( yspec ),
00720         Double_val( xmin ), Double_val( xmax ),
00721         Double_val( xjump ), Double_val( ymin ), Double_val( ymax ),
00722         Double_val( xlpos ), Double_val( ylpos ), Bool_val( y_ascl ),
00723         Bool_val( acc ), Int_val( colbox ), Int_val( collab ),
00724         colline_copy, styline_copy, legend_copy,
00725         String_val( labx ), String_val( laby ), String_val( labtop ) );
00726     // Make me do something!
00727     CAMLreturn( Val_int( id ) );
00728 }
00729 
00730 value ml_plstripc_byte( value* argv, int argn )
00731 {
00732     return ml_plstripc( argv[0], argv[1], argv[2], argv[3], argv[4],
00733         argv[5], argv[6], argv[7], argv[8], argv[9],
00734         argv[10], argv[11], argv[12], argv[13], argv[14],
00735         argv[15], argv[16], argv[17], argv[18] );
00736 }
00737 
00738 int translate_legend_option( int legend_option )
00739 {
00740     int translated_option;
00741     switch ( legend_option )
00742     {
00743     case 0: translated_option  = PL_LEGEND_NONE; break;
00744     case 1: translated_option  = PL_LEGEND_COLOR_BOX; break;
00745     case 2: translated_option  = PL_LEGEND_LINE; break;
00746     case 3: translated_option  = PL_LEGEND_SYMBOL; break;
00747     case 4: translated_option  = PL_LEGEND_TEXT_LEFT; break;
00748     case 5: translated_option  = PL_LEGEND_BACKGROUND; break;
00749     case 6: translated_option  = PL_LEGEND_BOUNDING_BOX; break;
00750     case 7: translated_option  = PL_LEGEND_ROW_MAJOR; break;
00751     default: translated_option = -1;
00752     }
00753     return translated_option;
00754 }
00755 
00756 int translate_position_option( int position_option )
00757 {
00758     int translated_option;
00759     switch ( position_option )
00760     {
00761     case 0: translated_option  = PL_POSITION_LEFT; break;
00762     case 1: translated_option  = PL_POSITION_RIGHT; break;
00763     case 2: translated_option  = PL_POSITION_TOP; break;
00764     case 3: translated_option  = PL_POSITION_BOTTOM; break;
00765     case 4: translated_option  = PL_POSITION_INSIDE; break;
00766     case 5: translated_option  = PL_POSITION_OUTSIDE; break;
00767     case 6: translated_option  = PL_POSITION_VIEWPORT; break;
00768     case 7: translated_option  = PL_POSITION_SUBPAGE; break;
00769     default: translated_option = -1;
00770     }
00771     return translated_option;
00772 }
00773 
00774 value ml_pllegend( value opt, value position, value x, value y, value plot_width,
00775                    value bg_color,
00776                    value bb_color, value bb_style,
00777                    value nrow, value ncolumn,
00778                    value opt_array,
00779                    value text_offset, value text_scale, value text_spacing,
00780                    value text_justification, value text_colors, value text,
00781                    value box_colors, value box_patterns, value box_scales,
00782                    value box_line_widths,
00783                    value line_colors, value line_styles, value line_widths,
00784                    value symbol_colors, value symbol_scales,
00785                    value symbol_numbers, value symbols )
00786 {
00787     CAMLparam5( position, opt, x, y, plot_width );
00788     CAMLxparam5( bg_color, bb_color, bb_style, nrow, ncolumn );
00789     CAMLxparam5( opt_array, text_offset, text_scale, text_spacing, text_justification );
00790     CAMLxparam5( text_colors, text, box_colors, box_patterns, box_scales );
00791     CAMLxparam5( box_line_widths, line_colors, line_styles, line_widths, symbol_colors );
00792     CAMLxparam3( symbol_scales, symbol_numbers, symbols );
00793     CAMLlocal1( result );
00794     result = caml_alloc( 2, 0 );
00795 
00796     // Counter
00797     int i;
00798     // General legend options
00799     int c_position, c_opt;
00800     // Number of legend entries
00801     int n_legend;
00802     n_legend = Wosize_val( opt_array );
00803     // Options for each legend entry
00804     int c_opt_array[n_legend];
00805 
00806     // Assume that the dimensions all line up on the OCaml side, so we don't
00807     // need to do any further dimension checks.
00808 
00809     // Define and initialize all of the C arrays to pass in to pllegend
00810     INIT_STRING_ARRAY( text )
00811     INIT_INT_ARRAY( text_colors )
00812     INIT_INT_ARRAY( box_colors )
00813     INIT_INT_ARRAY( box_patterns )
00814     INIT_INT_ARRAY( box_line_widths )
00815     INIT_INT_ARRAY( line_colors )
00816     INIT_INT_ARRAY( line_styles )
00817     INIT_INT_ARRAY( line_widths )
00818     INIT_INT_ARRAY( symbol_colors )
00819     INIT_INT_ARRAY( symbol_numbers )
00820     INIT_STRING_ARRAY( symbols )
00821 
00822     // Translate the legend configuration options
00823     c_opt      = lor_ml_list( opt, translate_legend_option );
00824     c_position = lor_ml_list( position, translate_position_option );
00825 
00826     for ( i = 0; i < n_legend; i++ )
00827     {
00828         c_opt_array[i] =
00829             lor_ml_list( Field( opt_array, i ), translate_legend_option );
00830     }
00831 
00832     // The returned width and height of the legend
00833     PLFLT width, height;
00834 
00835     pllegend( &width, &height, c_opt, c_position, Double_val( x ), Double_val( y ),
00836         Double_val( plot_width ), Int_val( bg_color ),
00837         Int_val( bb_color ), Int_val( bb_style ),
00838         Int_val( nrow ), Int_val( ncolumn ),
00839         n_legend, c_opt_array,
00840         Double_val( text_offset ), Double_val( text_scale ),
00841         Double_val( text_spacing ),
00842         Double_val( text_justification ),
00843         c_text_colors, c_text,
00844         c_box_colors, c_box_patterns, (double *) box_scales,
00845         c_box_line_widths,
00846         c_line_colors, c_line_styles, c_line_widths,
00847         c_symbol_colors, (double *) symbol_scales, c_symbol_numbers,
00848         c_symbols );
00849 
00850     // Return a tuple with the legend's size
00851     Store_field( result, 0, caml_copy_double( width ) );
00852     Store_field( result, 1, caml_copy_double( height ) );
00853 
00854     CAMLreturn( result );
00855 }
00856 
00857 value ml_pllegend_byte( value* argv, int argn )
00858 {
00859     return ml_pllegend( argv[0], argv[1], argv[2], argv[3], argv[4],
00860         argv[5], argv[6], argv[7], argv[8], argv[9],
00861         argv[10], argv[11], argv[12], argv[13], argv[14],
00862         argv[15], argv[16], argv[17], argv[18], argv[19],
00863         argv[20], argv[21], argv[22], argv[23], argv[24],
00864         argv[25], argv[26], argv[27] );
00865 }
00866 
00867 // pltr* function implementations
00868 void ml_pltr0( double x, double y, double* tx, double* ty )
00869 {
00870     pltr0( x, y, tx, ty, NULL );
00871 }
00872 
00873 value ml_pltr1( value xg, value yg, value x, value y )
00874 {
00875     CAMLparam4( xg, yg, x, y );
00876     CAMLlocal1( tx_ty );
00877     tx_ty = caml_alloc( 2, 0 );
00878     double  tx;
00879     double  ty;
00880     PLcGrid grid;
00881     grid.xg = (double *) xg;
00882     grid.yg = (double *) yg;
00883     grid.nx = Wosize_val( xg ) / Double_wosize;
00884     grid.ny = Wosize_val( yg ) / Double_wosize;
00885     pltr1( Double_val( x ), Double_val( y ), &tx, &ty, ( PLPointer ) & grid );
00886 
00887     // Allocate a tuple and return it with the results
00888     Store_field( tx_ty, 0, caml_copy_double( tx ) );
00889     Store_field( tx_ty, 1, caml_copy_double( ty ) );
00890     CAMLreturn( tx_ty );
00891 }
00892 
00893 value ml_pltr2( value xg, value yg, value x, value y )
00894 {
00895     CAMLparam4( xg, yg, x, y );
00896     CAMLlocal1( tx_ty );
00897     tx_ty = caml_alloc( 2, 0 );
00898     double   ** c_xg;
00899     double   ** c_yg;
00900     int      i;
00901     int      length1;
00902     int      length2;
00903     PLcGrid2 grid;
00904     double   tx;
00905     double   ty;
00906 
00907     // TODO: As of now, you will probably get a segfault of the xg and yg
00908     // dimensions don't match up properly.
00909     // Build the grid.
00910     // Length of "outer" array
00911     length1 = Wosize_val( xg );
00912     // Length of the "inner" arrays
00913     length2 = Wosize_val( Field( xg, 0 ) ) / Double_wosize;
00914     c_xg    = malloc( length1 * sizeof ( double* ) );
00915     for ( i = 0; i < length1; i++ )
00916     {
00917         c_xg[i] = (double *) Field( xg, i );
00918     }
00919     c_yg = malloc( length1 * sizeof ( double* ) );
00920     for ( i = 0; i < length1; i++ )
00921     {
00922         c_yg[i] = (double *) Field( yg, i );
00923     }
00924     grid.xg = c_xg;
00925     grid.yg = c_yg;
00926     grid.nx = length1;
00927     grid.ny = length2;
00928 
00929     pltr2( Double_val( x ), Double_val( y ), &tx, &ty, ( PLPointer ) & grid );
00930 
00931     // Clean up
00932     free( c_xg );
00933     free( c_yg );
00934 
00935     // Allocate a tuple and return it with the results
00936     Store_field( tx_ty, 0, caml_copy_double( tx ) );
00937     Store_field( tx_ty, 1, caml_copy_double( ty ) );
00938     CAMLreturn( tx_ty );
00939 }
00940 
00941 // XXX Non-core functions follow XXX
00942 //*
00943 // The following functions are here for (my?) convenience.  As far as I can
00944 // tell, they are not defined in the core PLplot library.
00945 //
00946 
00947 // Get the current color map 0 color index
00948 int plg_current_col0( void )
00949 {
00950     return plsc->icol0;
00951 }
00952 
00953 // Get the current color map 1 color index
00954 float plg_current_col1( void )
00955 {
00956     return plsc->icol1;
00957 }
00958 
00959 // Get the current pen width. TODO: Remove this, as I think this information
00960 // can be retrieved from another proper PLplot function.
00961 int plgwid( void )
00962 {
00963     return plsc->width;
00964 }
00965 
00966 // Get the current character (text) height in mm.  TODO: Remove this, as I
00967 // think this information can be retrieved from another proper PLplot
00968 // function
00969 float plgchrht( void )
00970 {
00971     return plsc->chrht;
00972 }

Generated on Wed Oct 12 2011 20:42:22 for PLplot by  doxygen 1.7.1